Bert Freudenberg uploaded a new version of TrueType to project The Trunk:
http://source.squeak.org/trunk/TrueType-bf.29.mcz
==================== Summary ====================
Name: TrueType-bf.29
Author: bf
Time: 8 December 2014, 2:15:45.524 am
UUID: 87a9ae42-b3df-43c6-9ded-a51e5af8ef3a
Ancestors: TrueType-nice.28
Restore timestamps lost in assignment conversion.
=============== Diff against TrueType-nice.28 ===============
Item was changed:
----- Method: TTCFont>>lineGrid (in category 'accessing') -----
lineGrid
"Answer the relative space between lines"
^ self ascent + self descent!
1
0
Bert Freudenberg uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-bf.70.mcz
==================== Summary ====================
Name: ToolsTests-bf.70
Author: bf
Time: 8 December 2014, 2:14:44.962 am
UUID: b5b69749-b461-4a51-80c4-24ff602e5202
Ancestors: ToolsTests-nice.69
Restore timestamps lost in assignment conversion.
=============== Diff against ToolsTests-nice.69 ===============
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') -----
testModalFileSelector
| window fileList2 |
window := FileList2 morphicViewFileSelector.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') -----
testModalFileSelectorForSuffixes
| window fileList2 |
window := FileList2 morphicViewFileSelectorForSuffixes: nil.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') -----
testModalFolderSelector
| window fileList2 |
window := FileList2 morphicViewFolderSelector.
fileList2 := window model.
window openInWorld: self currentWorld extent: 300@400.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') -----
testModalFolderSelectorForProjectLoad
| window fileList2 w |
window := FileList2
morphicViewProjectLoader2InWorld: self currentWorld
reallyLoad: false.
fileList2 := window valueOfProperty: #FileList.
w := self currentWorld.
window position: w topLeft + (w extent - window extent // 2).
window openInWorld: w.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
1
0
Bert Freudenberg uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-bf.70.mcz
==================== Summary ====================
Name: ToolsTests-bf.70
Author: bf
Time: 8 December 2014, 2:14:44.962 am
UUID: b5b69749-b461-4a51-80c4-24ff602e5202
Ancestors: ToolsTests-nice.69
Restore timestamps lost in assignment conversion.
=============== Diff against ToolsTests-nice.69 ===============
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') -----
testModalFileSelector
| window fileList2 |
window := FileList2 morphicViewFileSelector.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') -----
testModalFileSelectorForSuffixes
| window fileList2 |
window := FileList2 morphicViewFileSelectorForSuffixes: nil.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') -----
testModalFolderSelector
| window fileList2 |
window := FileList2 morphicViewFolderSelector.
fileList2 := window model.
window openInWorld: self currentWorld extent: 300@400.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') -----
testModalFolderSelectorForProjectLoad
| window fileList2 w |
window := FileList2
morphicViewProjectLoader2InWorld: self currentWorld
reallyLoad: false.
fileList2 := window valueOfProperty: #FileList.
w := self currentWorld.
window position: w topLeft + (w extent - window extent // 2).
window openInWorld: w.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
1
0
Bert Freudenberg uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-bf.70.mcz
==================== Summary ====================
Name: ToolsTests-bf.70
Author: bf
Time: 8 December 2014, 2:14:44.962 am
UUID: b5b69749-b461-4a51-80c4-24ff602e5202
Ancestors: ToolsTests-nice.69
Restore timestamps lost in assignment conversion.
=============== Diff against ToolsTests-nice.69 ===============
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') -----
testModalFileSelector
| window fileList2 |
window := FileList2 morphicViewFileSelector.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') -----
testModalFileSelectorForSuffixes
| window fileList2 |
window := FileList2 morphicViewFileSelectorForSuffixes: nil.
window openCenteredInWorld.
fileList2 := window valueOfProperty: #fileListModel.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedFile isNil.
fileList2 okHit.
self deny: fileList2 getSelectedFile isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') -----
testModalFolderSelector
| window fileList2 |
window := FileList2 morphicViewFolderSelector.
fileList2 := window model.
window openInWorld: self currentWorld extent: 300@400.
fileList2 fileListIndex: 1.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
Item was changed:
----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') -----
testModalFolderSelectorForProjectLoad
| window fileList2 w |
window := FileList2
morphicViewProjectLoader2InWorld: self currentWorld
reallyLoad: false.
fileList2 := window valueOfProperty: #FileList.
w := self currentWorld.
window position: w topLeft + (w extent - window extent // 2).
window openInWorld: w.
window delete.
self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
fileList2 okHit.
self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
!
1
0
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(a)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@0 corner: 0.3(a)0.5).
window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0.3@0 corner: 1.0(a)0.5).
window addMorph: (PluggableListMorph on: inspector list: #msgList
selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
frame: (0(a)0.5 corner: 0.3(a)1.0).
window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
readSelection: nil menu: #msgPaneMenu:shifted:)
frame: (0.3(a)0.5 corner: 1.0(a)1.0).
window setUpdatablePanesFrom: #(fieldList msgList).
window position: 16@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.
!
1
0
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(a)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@0 corner: 0.3(a)0.5).
window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0.3@0 corner: 1.0(a)0.5).
window addMorph: (PluggableListMorph on: inspector list: #msgList
selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
frame: (0(a)0.5 corner: 0.3(a)1.0).
window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
readSelection: nil menu: #msgPaneMenu:shifted:)
frame: (0.3(a)0.5 corner: 1.0(a)1.0).
window setUpdatablePanesFrom: #(fieldList msgList).
window position: 16@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.
!
1
0
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(a)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@0 corner: 0.3(a)0.5).
window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0.3@0 corner: 1.0(a)0.5).
window addMorph: (PluggableListMorph on: inspector list: #msgList
selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
frame: (0(a)0.5 corner: 0.3(a)1.0).
window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
readSelection: nil menu: #msgPaneMenu:shifted:)
frame: (0.3(a)0.5 corner: 1.0(a)1.0).
window setUpdatablePanesFrom: #(fieldList msgList).
window position: 16@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.
!
1
0
Bert Freudenberg uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-bf.47.mcz
==================== Summary ====================
Name: Protocols-bf.47
Author: bf
Time: 8 December 2014, 1:58:54.292 am
UUID: 0ef36fb5-8126-4473-9db7-10c526491c7d
Ancestors: Protocols-nice.46
Restore timestamps lost in assignment conversion.
=============== Diff against Protocols-nice.46 ===============
Item was changed:
----- Method: Behavior>>implementsVocabulary: (in category '*Protocols') -----
implementsVocabulary: aVocabulary
"Answer whether instances of the receiver respond to the messages in aVocabulary."
(aVocabulary isKindOf: FullVocabulary orOf: ScreenedVocabulary) ifTrue: [^ true].
^ self fullyImplementsVocabulary: aVocabulary!
Item was changed:
----- Method: ButtonPhaseType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
self vocabularyName: #ButtonPhase.
symbols := #(buttonDown whilePressed buttonUp)!
Item was changed:
----- Method: CodeHolder>>spawnFullProtocol (in category '*Protocols-Tools') -----
spawnFullProtocol
"Create and schedule a new protocol browser on the currently selected class or meta."
| aClassOrMetaclass |
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openFullProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: CodeHolder>>spawnProtocol (in category '*Protocols-Tools') -----
spawnProtocol
| aClassOrMetaclass |
"Create and schedule a new protocol browser on the currently selected class or meta."
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openSubProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: ElementCategory>>categoryName: (in category 'category name') -----
categoryName: aName
"Set the category name"
categoryName := aName!
Item was changed:
----- Method: ElementCategory>>clear (in category 'initialization') -----
clear
"Clear the receiber's keysInOrder and elementDictionary"
keysInOrder := OrderedCollection new.
elementDictionary := IdentityDictionary new!
Item was changed:
----- Method: ElementCategory>>copyFrom: (in category 'copying') -----
copyFrom: donor
"Copy the receiver's contents from the donor"
keysInOrder := donor keysInOrder.
elementDictionary := donor copyOfElementDictionary!
Item was changed:
----- Method: FullVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods which are in the given category, on behalf of anObject"
| classToUse |
classToUse := aClass ifNil: [anObject class].
^ classToUse allMethodsInCategory: categoryName!
Item was changed:
----- Method: FullVocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'category list') -----
categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass
"Answer the category list for the given object, considering only code implemented in mostGeneric and lower (or higher, depending on which way you're facing"
| classToUse |
classToUse := anObject ifNil: [aClass] ifNotNil: [anObject class].
^ mostGenericClass == classToUse
ifTrue:
[mostGenericClass organization categories]
ifFalse:
[classToUse allMethodCategoriesIntegratedThrough: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class, only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[aClass includesBehavior: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')
Vocabulary initialize
"
super initialize.
vocabularyName := #Object.
self documentation: '"Object" is all-encompassing vocabulary that embraces all methods understood by an object'.
self rigAFewCategories!
Item was changed:
----- Method: Lexicon>>adjustWindowTitle (in category 'window title') -----
adjustWindowTitle
"Set the title of the receiver's window, if any, to reflect the current choices"
| aWindow aLabel catName |
(catName := self selectedCategoryName) ifNil: [^ self].
(aWindow := self containingWindow) ifNil: [^ self].
aLabel := nil.
#( (viewedCategoryName 'Messages already viewed - ')
(allCategoryName 'All messages - ')) do:
[:aPair | catName = (self categoryWithNameSpecifiedBy: aPair first) ifTrue: [aLabel := aPair second]].
aLabel ifNil:
[aLabel := catName = self class queryCategoryName
ifTrue:
[self queryCharacterization, ' - ']
ifFalse:
['Vocabulary of ']].
aWindow setLabel: aLabel, (self targetObject ifNil: [targetClass]) nameForViewer!
Item was changed:
----- Method: Lexicon>>annotation (in category 'basic operation') -----
annotation
"Provide a line of annotation material for a middle pane."
| aCategoryName |
self selectedMessageName ifNotNil: [^ super annotation].
(aCategoryName := self selectedCategoryName) ifNil:
[^ self hasSearchPane
ifTrue:
['type a message name or fragment in the top pane and hit RETURN or ENTER']
ifFalse:
['' "currentVocabulary documentation"]].
(aCategoryName = self class queryCategoryName) ifTrue:
[^ self queryCharacterization].
#(
(allCategoryName 'Shows all methods, whatever other category they belong to')
(viewedCategoryName 'Methods visited recently. Use "-" button to remove a method from this category.')
(queryCategoryName 'Query results'))
do:
[:pair | (self categoryWithNameSpecifiedBy: pair first) = aCategoryName ifTrue: [^ pair second]].
^ currentVocabulary categoryCommentFor: aCategoryName!
Item was changed:
----- Method: Lexicon>>categoryDefiningSelector: (in category 'category list') -----
categoryDefiningSelector: aSelector
"Answer a category in which aSelector occurs"
| categoryNames |
categoryNames := categoryList copyWithoutAll: #('-- all --').
^ currentVocabulary categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: self targetObject ofClass: targetClass!
Item was changed:
----- Method: Lexicon>>categoryList (in category 'category list') -----
categoryList
"Answer the category list for the protcol, creating it if necessary, and prepending the -- all -- category, and appending the other special categories for search results, etc."
| specialCategoryNames |
categoryList ifNil:
[specialCategoryNames := #(queryCategoryName viewedCategoryName "searchCategoryName sendersCategoryName changedCategoryName activeCategoryName") collect:
[:sym | self class perform: sym].
categoryList :=
(currentVocabulary categoryListForInstance: self targetObject ofClass: targetClass limitClass: limitClass),
specialCategoryNames,
(Array with: self class allCategoryName)].
^ categoryList!
Item was changed:
----- Method: Lexicon>>categoryListIndex (in category 'category list') -----
categoryListIndex
"Answer the index of the currently-selected item in in the category list"
^ categoryListIndex ifNil: [categoryListIndex := 1]!
Item was changed:
----- Method: Lexicon>>categoryListIndex: (in category 'category list') -----
categoryListIndex: anIndex
"Set the category list index as indicated"
| categoryName aList found existingSelector |
existingSelector := self selectedMessageName.
categoryListIndex := anIndex.
anIndex > 0
ifTrue:
[categoryName := categoryList at: anIndex]
ifFalse:
[contents := nil].
self changed: #categoryListIndex.
found := false.
#( (viewedCategoryName selectorsVisited)
(queryCategoryName selectorsRetrieved)) do:
[:pair |
categoryName = (self class perform: pair first)
ifTrue:
[aList := self perform: pair second.
found := true]].
found ifFalse:
[aList := currentVocabulary allMethodsInCategory: categoryName forInstance: self targetObject ofClass: targetClass].
categoryName = self class queryCategoryName ifFalse: [autoSelectString := nil].
self initListFrom: aList highlighting: targetClass.
messageListIndex := 0.
self changed: #messageList.
contents := nil.
self contentsChanged.
self selectWithinCurrentCategoryIfPossible: existingSelector.
self adjustWindowTitle!
Item was changed:
----- Method: Lexicon>>chooseLimitClass (in category 'limit class') -----
chooseLimitClass
"Put up a menu allowing the user to choose the most generic class to show"
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
targetClass withAllSuperclasses do:
[:aClass |
aClass == ProtoObject
ifTrue:
[aMenu addLine].
aMenu add: aClass name selector: #setLimitClass: argument: aClass.
aClass == limitClass ifTrue:
[aMenu lastItem color: Color red].
aClass == targetClass ifTrue: [aMenu addLine]].
aMenu addTitle: 'Show only methods
implemented at or above...'. "heh heh -- somebody please find nice wording here!!"
aMenu popUpInWorld: self currentWorld!
Item was changed:
----- Method: Lexicon>>currentQueryParameter (in category 'within-tool queries') -----
currentQueryParameter
"Answer the current query parameter"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>customButtonSpecs (in category 'control buttons') -----
customButtonSpecs
"Answer a triplet defining buttons, in the format:
button label
selector to send
help message"
| aa |
aa := contentsSymbol == #tiles ifTrue: [{ "Consult Ted Kaehler regarding this bit"
{'tiles'. #tilesMenu. 'tiles for assignment and constants'. true}.
{'vars'. #varTilesMenu. 'tiles for instance variables and a new temporary'. true}
}] ifFalse: [#()]. "true in 4th place means act on mouseDown"
^ aa, #(
('follow' seeAlso 'view a method I implement that is called by this method')
('find' obtainNewSearchString 'find methods by name search')
('sent...' setSendersSearch 'view the methods I implement that send a given message')
('<' navigateToPreviousMethod 'view the previous active method')
('>' navigateToNextMethod 'view the next active method')
('-' removeFromSelectorsVisited 'remove this method from my active list'))!
Item was changed:
----- Method: Lexicon>>displaySelector: (in category 'basic operation') -----
displaySelector: aSelector
"Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category"
| detectedItem messageIndex |
self chooseCategory: (self categoryDefiningSelector: aSelector).
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ Beeper beep].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex!
Item was changed:
----- Method: Lexicon>>initialLimitClass (in category 'limit class') -----
initialLimitClass
"Choose a plausible initial vlaue for the limit class, and answer it"
| oneTooFar |
limitClass := targetClass.
(#('ProtoObject' 'Object' 'Behavior' 'ClassDescription' 'Class' 'ProtoObject class' 'Object class') includes: targetClass name asString) ifTrue: [^ targetClass].
oneTooFar := (targetClass isKindOf: Metaclass)
ifTrue:
["use the fifth back from the superclass chain for Metaclasses, which is the immediate subclass of ProtoObject class. Print <ProtoObject class allSuperclasses> to count them yourself."
targetClass allSuperclasses at: (targetClass allSuperclasses size - 5)]
ifFalse:
[targetClass allSuperclasses at: targetClass allSuperclasses size].
[limitClass superclass ~~ oneTooFar]
whileTrue: [limitClass := limitClass superclass].
^ limitClass!
Item was changed:
----- Method: Lexicon>>lastSearchString (in category 'search') -----
lastSearchString
"Answer the last search string, initializing it to an empty string if it has not been initialized yet"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>lastSearchString: (in category 'search') -----
lastSearchString: aString
"Make a note of the last string searched for in the receiver"
currentQueryParameter := aString asString.
currentQuery := #selectorName.
autoSelectString := aString.
self setMethodListFromSearchString.
^ true!
Item was changed:
----- Method: Lexicon>>lastSendersSearchSelector (in category 'search') -----
lastSendersSearchSelector
"Answer the last senders search selector, initializing it to a default value if it does not already have a value"
^ currentQueryParameter ifNil: [currentQueryParameter := #flag:]!
Item was changed:
----- Method: Lexicon>>limitClass: (in category 'limit class') -----
limitClass: aClass
"Set the most generic class to show as indicated"
limitClass := aClass!
Item was changed:
----- Method: Lexicon>>limitClassString (in category 'limit class') -----
limitClassString
"Answer a string representing the current choice of most-generic-class-to-show"
| most |
(most := self limitClass) == ProtoObject
ifTrue: [^ 'All'].
most == targetClass
ifTrue: [^ most name].
^ 'Only through ', most name!
Item was changed:
----- Method: Lexicon>>messageListIndex: (in category 'basic operation') -----
messageListIndex: anIndex
"Set the message list index as indicated, and update the history list if appropriate"
| newSelector current |
current := self selectedMessageName.
super messageListIndex: anIndex.
anIndex = 0 ifTrue: [
self editSelection: #newMessage.
self contentsChanged].
(newSelector := self selectedMessageName) ifNotNil:
[self updateSelectorsVisitedfrom: current to: newSelector]!
Item was changed:
----- Method: Lexicon>>methodListFromSearchString: (in category 'search') -----
methodListFromSearchString: fragment
"Answer a method list of methods whose selectors match the given fragment"
| aList searchFor |
currentQueryParameter := fragment.
currentQuery := #selectorName.
autoSelectString := fragment.
searchFor := fragment asString asLowercase withBlanksTrimmed.
aList := targetClass allSelectors select:
[:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
searchFor size > 0 ifTrue:
[aList := aList select:
[:aSelector | aSelector includesSubstring: searchFor caseSensitive: false]].
^ aList asSortedArray
!
Item was changed:
----- Method: Lexicon>>methodsWithInitials: (in category 'within-tool queries') -----
methodsWithInitials: initials
"Return a list of selectors representing methods whose timestamps have the given initials and which are in the protocol of this object and within the range dictated by my limitClass."
| classToUse |
classToUse := self targetObject ifNotNil: [self targetObject class] ifNil: [targetClass]. "In support of lightweight uniclasses"
^ targetClass allSelectors select:
[:aSelector | (currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: classToUse limitClass: limitClass) and:
[Utilities doesMethod: aSelector forClass: classToUse bearInitials: initials]].
!
Item was changed:
----- Method: Lexicon>>newCategoryPane (in category 'category list') -----
newCategoryPane
"Formulate a category pane for insertion into the receiver's pane list"
| aListMorph |
aListMorph := PluggableListMorph on: self list: #categoryList
selected: #categoryListIndex changeSelected: #categoryListIndex:
menu: #categoryListMenu:shifted:
keystroke: #categoryListKey:from:.
aListMorph setNameTo: 'categoryList'.
aListMorph menuTitleSelector: #categoryListMenuTitle.
^ aListMorph!
Item was changed:
----- Method: Lexicon>>preserveSelectorIfPossibleSurrounding: (in category 'transition') -----
preserveSelectorIfPossibleSurrounding: aBlock
"Make a note of the currently-selected method; perform aBlock and then attempt to reestablish that same method as the selected one in the new circumstances"
| aClass aSelector |
aClass := self selectedClassOrMetaClass.
aSelector := self selectedMessageName.
aBlock value.
self hasSearchPane
ifTrue:
[self setMethodListFromSearchString]
ifFalse:
[self maybeReselectClass: aClass selector: aSelector]!
Item was changed:
----- Method: Lexicon>>reformulateCategoryList (in category 'category list') -----
reformulateCategoryList
"Reformulate the category list"
categoryList := nil.
self categoryListIndex: 0.
self changed: #categoryList.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>removeFromSelectorsVisited (in category 'history') -----
removeFromSelectorsVisited
"Remove the currently-selected method from the active set"
| aSelector |
(aSelector := self selectedMessageName) ifNil: [^ self].
self removeFromSelectorsVisited: aSelector.
self chooseCategory: self class viewedCategoryName!
Item was changed:
----- Method: Lexicon>>removeMessage (in category 'menu commands') -----
removeMessage
"Remove the selected message from the system."
messageListIndex = 0 ifTrue: [^ self].
self okToChange ifFalse: [^ self].
super removeMessage.
"my #reformulateList method, called from the super #removeMethod method, will however try to preserve the selection, so we take pains to clobber it by the below..."
messageListIndex := 0.
self changed: #messageList.
self changed: #messageListIndex.
contents := nil.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>retainMethodSelectionWhileSwitchingToCategory: (in category 'transition') -----
retainMethodSelectionWhileSwitchingToCategory: aCategoryName
"retain method selection while switching the category-pane selection to show the category of the given name"
| aSelectedName |
aSelectedName := self selectedMessageName.
self categoryListIndex: (categoryList indexOf: aCategoryName ifAbsent: [^ self]).
aSelectedName ifNotNil: [self selectWithinCurrentCategory: aSelectedName]
!
Item was changed:
----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') -----
selectSelectorItsNaturalCategory: aSelector
"Make aSelector be the current selection of the receiver, with the category being its home category."
| cat catIndex detectedItem |
cat := self categoryOfSelector: aSelector.
catIndex := categoryList indexOf: cat ifAbsent:
["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category"
1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') -----
selectWithinCurrentCategory: aSelector
"If aSelector is one of the selectors seen in the current category, select it"
| detectedItem |
detectedItem := self messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') -----
selectWithinCurrentCategoryIfPossible: aSelector
"If the receiver's message list contains aSelector, navigate right to it without changing categories"
| detectedItem messageIndex |
aSelector ifNil: [^ self].
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>selectorsMatching (in category 'search') -----
selectorsMatching
"Anwer a list of selectors in the receiver that match the current search string"
| fragment aList |
fragment := self lastSearchString asLowercase.
aList := targetClass allSelectors select:
[:aSelector | (aSelector includesSubstring: fragment caseSensitive: false) and:
[currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]].
^ aList asSortedArray!
Item was changed:
----- Method: Lexicon>>selectorsVisited (in category 'history') -----
selectorsVisited
"Answer the list of selectors visited in this tool"
^ selectorsVisited ifNil: [selectorsVisited := OrderedCollection new]!
Item was changed:
----- Method: Lexicon>>setLocalClassVarRefs (in category 'within-tool queries') -----
setLocalClassVarRefs
"Put up a list of the class variables in the viewed object, and when the user selects one, let the query results category show all the references to that class variable."
| aName |
(aName := targetClass theNonMetaClass chooseClassVarName) ifNil: [^ self].
currentQuery := #classVarRefs.
currentQueryParameter := aName.
self showQueryResultsCategory!
Item was changed:
----- Method: Lexicon>>setToShowSelector: (in category 'selection') -----
setToShowSelector: aSelector
"Set up the receiver so that it will show the given selector"
| catName catIndex detectedItem messageIndex aList |
catName := (aList := currentVocabulary categoriesContaining: aSelector forClass: targetClass) size > 0
ifTrue:
[aList first]
ifFalse:
[self class allCategoryName].
catIndex := categoryList indexOf: catName ifAbsent: [1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem upTo: $ ) asString asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>showCategoriesPane (in category 'category list') -----
showCategoriesPane
"Show the categories pane instead of the search pane"
| aPane |
(aPane := self searchPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newCategoryPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>showHomeCategory (in category 'menu commands') -----
showHomeCategory
"Continue to show the current selector, but show it within the context of its primary category"
| aSelector |
(aSelector := self selectedMessageName) ifNotNil:
[self preserveSelectorIfPossibleSurrounding:
[self setToShowSelector: aSelector]]!
Item was changed:
----- Method: Lexicon>>showMethodsInCurrentChangeSet (in category 'within-tool queries') -----
showMethodsInCurrentChangeSet
"Set the current query to be for methods in the current change set"
currentQuery := #currentChangeSet.
autoSelectString := nil.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).!
Item was changed:
----- Method: Lexicon>>showMethodsWithInitials: (in category 'within-tool queries') -----
showMethodsWithInitials: initials
"Make the current query be for methods stamped with the given initials"
currentQuery := #methodsWithInitials.
currentQueryParameter := initials.
self showQueryResultsCategory.
autoSelectString := nil.
self changed: #messageList.
self adjustWindowTitle
!
Item was changed:
----- Method: Lexicon>>showQueryResultsCategory (in category 'within-tool queries') -----
showQueryResultsCategory
"Point the receiver at the query-results category and set the search string accordingly"
autoSelectString := self currentQueryParameter.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).
self messageListIndex: 0!
Item was changed:
----- Method: Lexicon>>showSearchPane (in category 'search') -----
showSearchPane
"Given that the receiver is showing the categories pane, replace that with a search pane. Though there is a residual UI for obtaining this variant, it is obscure and the integrity of the protocol-category-browser when there is no categories pane is not necessarily assured at the moment."
| aPane |
(aPane := self categoriesPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newSearchPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>useVocabulary: (in category 'vocabulary') -----
useVocabulary: aVocabulary
"Set up the receiver to use the given vocabulary"
currentVocabulary := aVocabulary!
Item was changed:
----- Method: MethodCall>>evaluate (in category 'evaluation') -----
evaluate
"Evaluate the receiver, and if value has changed, signal value-changed"
| result |
result := arguments isEmptyOrNil
ifTrue: [self receiver perform: selector]
ifFalse: [self receiver perform: selector withArguments: arguments asArray].
timeStamp := Time dateAndTimeNow.
result ~= lastValue ifTrue:
[lastValue := result.
self changed: #value]
!
Item was changed:
----- Method: MethodCall>>methodInterface (in category 'method interface') -----
methodInterface
"Answer the receiver's methodInterface, conjuring one up on the spot (and remembering) if not present"
^ methodInterface ifNil:
[methodInterface := self ephemeralMethodInterface]!
Item was changed:
----- Method: MethodCall>>methodInterface: (in category 'method interface') -----
methodInterface: anInterface
"Set my methodInterface"
methodInterface := anInterface!
Item was changed:
----- Method: MethodCall>>receiver:methodInterface: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface
"Initialize me to have the given receiver and methodInterface"
| aResultType |
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := aMethodInterface defaultArguments.
self flag: #noteToTed.
"the below can't really survive, I know. The intent is that if the method has a declared result type, we want the preferred readout type to be able to handle the initial #lastValue even if the MethodCall has not been evaluated yet; thus we'd rather have a boolean value such as true rather than a nil here if we're showing a boolean readout such as a checkbox, and likewise for color-valued and numeric-valued readouts etc, "
(aResultType := methodInterface resultType) ~~ #unknown ifTrue:
[lastValue := (Vocabulary vocabularyForType: aResultType) initialValueForASlotFor: aReceiver] !
Item was changed:
----- Method: MethodCall>>receiver:methodInterface:initialArguments: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface initialArguments: initialArguments
"Set up a method-call for the given receiver, method-interface, and initial arguments"
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := initialArguments ifNotNil: [initialArguments asArray]
!
Item was changed:
----- Method: MethodCall>>setArgumentNamed:toValue: (in category 'argument access') -----
setArgumentNamed: aName toValue: aValue
"Set the argument of the given name to the given value"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
anIndex > 0
ifTrue:
[arguments at: anIndex put: aValue]
ifFalse:
[self error: 'argument missing'].
self changed: #argumentValue!
Item was changed:
----- Method: MethodCall>>valueOfArgumentNamed: (in category 'initialization') -----
valueOfArgumentNamed: aName
"Answer the value of the given arguement variable"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
^ anIndex > 0
ifTrue:
[arguments at: anIndex]
ifFalse:
[self error: 'variable not found']!
Item was changed:
----- Method: MethodInterface>>argumentVariables (in category 'initialization') -----
argumentVariables
"Answer the list of argumentVariables of the interface"
^ argumentVariables ifNil: [argumentVariables := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>argumentVariables: (in category 'initialization') -----
argumentVariables: variableList
"Set the argument variables"
argumentVariables := variableList!
Item was changed:
----- Method: MethodInterface>>attributeKeywords (in category 'attribute keywords') -----
attributeKeywords
"Answer a list of attribute keywords associated with the receiver"
^ attributeKeywords ifNil: [attributeKeywords := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>conjuredUpFor:class: (in category 'initialization') -----
conjuredUpFor: aSelector class: aClass
"Initialize the receiver to have the given selector, obtaining whatever info one can from aClass. This basically covers the situation where no formal definition has been made."
| parts |
self initializeFor: aSelector.
self wording: aSelector.
receiverType := #unknown.
parts := aClass formalHeaderPartsFor: aSelector.
argumentVariables := (1 to: selector numArgs) collect:
[:anIndex | Variable new name: (parts at: (4 * anIndex)) type: #Object].
parts last isEmptyOrNil ifFalse: [self documentation: parts last].
!
Item was changed:
----- Method: MethodInterface>>defaultStatus: (in category 'status') -----
defaultStatus: aStatus
"Set the receiver's defaultStatus as indicated"
defaultStatus := aStatus!
Item was changed:
----- Method: MethodInterface>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver"
super initialize.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal.
argumentVariables := OrderedCollection new
!
Item was changed:
----- Method: MethodInterface>>initializeFor: (in category 'initialization') -----
initializeFor: aSelector
"Initialize the receiver to have the given selector"
selector := aSelector.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal
!
Item was changed:
----- Method: MethodInterface>>initializeSetterFromEToySlotSpec: (in category 'initialization') -----
initializeSetterFromEToySlotSpec: tuple
"tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to represent the getter of this item"
selector := tuple ninth.
self
wording: ('set ', tuple second);
helpMessage: ('setter for', tuple third).
receiverType := #Player.
argumentVariables := Array with: (Variable new variableType: tuple fourth)
!
Item was changed:
----- Method: MethodInterface>>receiverType (in category 'access') -----
receiverType
"Answer the receiver type"
^ receiverType ifNil: [receiverType := #unknown]!
Item was changed:
----- Method: MethodInterface>>receiverType: (in category 'initialization') -----
receiverType: aType
"set the receiver type. Whether the receiverType earns its keep here is not yet well understood. At the moment, this is unsent"
receiverType := aType!
Item was changed:
----- Method: MethodInterface>>resultType: (in category 'initialization') -----
resultType: aType
"Set the receiver's resultSpecification to be a ResultType of the given type"
resultSpecification := ResultSpecification new.
resultSpecification resultType: aType!
Item was changed:
----- Method: MethodInterface>>selector:type:setter: (in category 'attribute keywords') -----
selector: aSelector type: aType setter: aSetter
"Set the receiver's fields as indicated. Values of nil or #none for the result type and the setter indicate that there is none"
selector := aSelector.
(MethodInterface isNullMarker: aType) ifFalse:
[resultSpecification := ResultSpecification new.
resultSpecification resultType: aType.
(MethodInterface isNullMarker: aSetter) ifFalse:
[resultSpecification companionSetterSelector: aSetter]]!
Item was changed:
----- Method: MethodInterface>>typeForArgumentNumber: (in category 'access') -----
typeForArgumentNumber: anArgumentNumber
"Answer the data type for the given argument number"
| aVariable |
aVariable := self argumentVariables at: anArgumentNumber.
^ aVariable variableType!
Item was changed:
----- Method: ObjectWithDocumentation>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
authoringStamp := Utilities changeStampPerSe
!
Item was changed:
----- Method: ObjectWithDocumentation>>legacyHelpMessage (in category 'accessing') -----
legacyHelpMessage
"If I have a help message stashed in my legacy naturalTranslations slot, answer its translated rendition, else answer nil. If I *do* come across a legacy help message, transfer it to my properties dictionary."
| untranslated |
naturalLanguageTranslations isEmptyOrNil "only in legacy (pre-3.8) projects"
ifTrue: [^ nil].
untranslated := naturalLanguageTranslations first helpMessage ifNil: [^ nil].
self propertyAt: #helpMessage put: untranslated.
naturalLanguageTranslations removeFirst.
naturalLanguageTranslations isEmpty ifTrue: [naturalLanguageTranslations := nil].
^ untranslated translated!
Item was changed:
----- Method: ProtocolBrowser>>setClassAndSelectorIn: (in category 'private') -----
setClassAndSelectorIn: csBlock
"Decode strings of the form <selectorName> (<className> [class])"
| i classAndSelString selString sel |
sel := self selection ifNil: [^ csBlock value: nil value: nil].
(sel isKindOf: MethodReference) ifTrue: [
sel setClassAndSelectorIn: csBlock
] ifFalse: [
selString := sel asString.
i := selString indexOf: $(.
"Rearrange to <className> [class] <selectorName> , and use MessageSet"
classAndSelString := (selString copyFrom: i + 1 to: selString size - 1) , ' ' ,
(selString copyFrom: 1 to: i - 1) withoutTrailingBlanks.
MessageSet parse: classAndSelString toClassAndSelector: csBlock.
].
!
Item was changed:
----- Method: ResultSpecification>>companionSetterSelector: (in category 'companion setter') -----
companionSetterSelector: aSetterSelector
"Set the receiver's companionSetterSelector as indicated"
companionSetterSelector := aSetterSelector!
Item was changed:
----- Method: ResultSpecification>>refetchFrequency: (in category 'refetch') -----
refetchFrequency: aFrequency
"Set the refetch frequency"
refetchFrequency := aFrequency!
Item was changed:
----- Method: ResultSpecification>>resultType: (in category 'result type') -----
resultType: aType
"Set the receiver's resultType as specified"
type := aType!
Item was changed:
----- Method: ScreenedVocabulary>>categoryScreeningBlock: (in category 'initialization') -----
categoryScreeningBlock: aBlock
"Set the receiver's categoryScreeningBlock to the block provided"
categoryScreeningBlock := aBlock!
Item was changed:
----- Method: ScreenedVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #Public.
self documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'!
Item was changed:
----- Method: ScreenedVocabulary>>methodScreeningBlock: (in category 'initialization') -----
methodScreeningBlock: aBlock
"Set the receiver's methodScreeningBlock to the block provided"
methodScreeningBlock := aBlock!
Item was changed:
----- Method: SymbolListType>>symbols: (in category 'tiles') -----
symbols: symbolList
"Set the receiver's list of symbols as indicated"
symbols := symbolList!
Item was changed:
----- Method: UnknownType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unknown!
Item was changed:
----- Method: Variable>>name:type: (in category 'name') -----
name: aName type: aType
"Set the variable's name and type as indicated"
variableName := aName.
variableType := aType!
Item was changed:
----- Method: Variable>>sample (in category 'value') -----
sample
"The closest we can come to an object for our type"
| ty clsName |
self defaultValue ifNotNil: [^ self defaultValue].
ty := self variableType.
"How translate a type like #player into a class?"
clsName := ty asString.
clsName at: 1 put: (clsName first asUppercase).
clsName := clsName asSymbol.
(Smalltalk includesKey: clsName) ifFalse: [self error: 'What type is this?'. ^ 5].
^ (Smalltalk at: clsName) initializedInstance!
Item was changed:
----- Method: Variable>>variableType: (in category 'type') -----
variableType: aType
"Set the receiver's variable type as requested"
variableType := aType!
Item was changed:
----- Method: Vocabulary class>>allStandardVocabularies (in category 'standard vocabulary access') -----
allStandardVocabularies
"Answer a list of the currently-defined vocabularies in my AllStandardVocabularies list"
"Vocabulary allStandardVocabularies"
^AllStandardVocabularies ifNil: [AllStandardVocabularies := IdentityDictionary new].
!
Item was changed:
----- Method: Vocabulary class>>newPublicVocabulary (in category 'universal vocabularies') -----
newPublicVocabulary
| aVocabulary |
"Answer a public vocabulary"
aVocabulary := ScreenedVocabulary new.
aVocabulary vocabularyName: #Public.
aVocabulary documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'.
aVocabulary categoryScreeningBlock: [:aCategoryName | (aCategoryName beginsWith: 'private') not].
aVocabulary methodScreeningBlock: [:aSelector |
((aSelector beginsWith: 'private') or: [aSelector beginsWith: 'pvt']) not].
^ aVocabulary
!
Item was changed:
----- Method: Vocabulary class>>newQuadVocabulary (in category 'testing and demo') -----
newQuadVocabulary
"Answer a Quad vocabulary -- something to mess with, to illustrate and explore ideas. Applies to Quadrangles only."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Quad.
aVocabulary documentation: 'A highly restricted test vocabulary that can be used with Quadrangle objects'.
aVocabulary initializeFromTable: #(
(borderColor borderColor: () Color (basic color) 'The color of the border' unused updating)
(borderWidth borderWidth: () Number (basic geometry) 'The width of the border' unused updating)
(insideColor insideColor: () Color (basic color) 'The color of the quadrangle' unused updating)
(display none () none (basic display) 'Display the quadrangle directly on the screen')
(width none () Number (geometry) 'The width of the object' unused updating)
(left setLeft: () Number (geometry) 'The left edge' unused updating)
(right setRight: () Number (geometry) 'The right edge' unused updating)
(width setWidth: () Number (geometry) 'The width of the object' unused updating)
(height setHeight: () Number (geometry) 'The height of the object' unused updating)
(hasPositiveExtent none () Boolean (tests) 'Whether the corner is to the lower-right of the origin' unused updating)
(isTall none () Boolean (tests) 'Whether the height is greater than the width' unused updating)).
^ aVocabulary
"Vocabulary initialize"
"Quadrangle exampleInViewer"!
Item was changed:
----- Method: Vocabulary class>>newTestVocabulary (in category 'testing and demo') -----
newTestVocabulary
"Answer a Test vocabulary -- something to mess with, to illustrate and explore ideas."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Test.
aVocabulary documentation: 'An illustrative vocabulary for testing'.
aVocabulary initializeFromTable: #(
(isKindOf: none ((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass')
(class none none Class (#'class membership' wimpy) 'answer the the class to which the receiver belongs')
(respondsTo: none ((aSelector Symbol)) Boolean (#'class membership') 'answer whether the receiver responds to the given selector')
(as: none ((aClass Class)) Object (conversion) 'answer the receiver converted to be a member of aClass')).
^ aVocabulary
"
#((#'class membership' 'Whether an object can respond to a given message, etc.' (isKindOf: class respondsTo:))
(conversion 'Messages to convert from one kind of object to another' (as: asString))
(copying 'Messages for making copies of objects' (copy copyFrom:))
(equality 'Testing whether two objects are equal' ( = ~= == ~~))
(dependents 'Support for dependency notification' (addDependent: removeDependent: release))) do:
[:item |
aMethodCategory := ElementCategory new categoryName: item first.
aMethodCategory documentation: item second.
item third do:
[:aSelector |
aMethodInterface := MethodInterface new initializeFor: aSelector.
aVocabulary atKey: aSelector putMethodInterface: aMethodInterface.
aMethodCategory elementAt: aSelector put: aMethodInterface].
aVocabulary addCategory: aMethodCategory]."
!
Item was changed:
----- Method: Vocabulary class>>vocabularyForClass: (in category 'type vocabularies') -----
vocabularyForClass: aClass
"Answer the standard vocabulary for that class. Create it if not present and init message exists. Answer nil if none exists and no init message present."
| initMsgName newTypeVocab |
(self allStandardVocabularies includesKey: aClass name)
ifTrue: [^self allStandardVocabularies at: aClass name].
initMsgName := ('new', aClass name, 'Vocabulary') asSymbol.
^(self respondsTo: initMsgName)
ifTrue: [
newTypeVocab := self perform: initMsgName.
self addStandardVocabulary: newTypeVocab.
newTypeVocab]
ifFalse: [nil]!
Item was changed:
----- Method: Vocabulary class>>vocabularyForType: (in category 'type vocabularies') -----
vocabularyForType: aType
"Answer a vocabulary appropriate to the given type, which is normally going to be a symbol such as #Number or #Color. Answer the Unknown vocabulary as a fall-back"
| ucSym |
(aType isKindOf: Vocabulary) ifTrue: [^ aType].
ucSym := aType capitalized asSymbol.
^self allStandardVocabularies at: ucSym ifAbsent: [self vocabularyNamed: #unknown]!
Item was changed:
----- Method: Vocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'queries') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods in the etoy interface which are in the given category, on behalf of aClass and possibly anObject. Note that there is no limitClass at play here."
| aCategory |
categoryName ifNil: [^ OrderedCollection new].
categoryName = self allCategoryName ifTrue:
[^ methodInterfaces collect: [:anInterface | anInterface selector]].
aCategory := categories detect: [:cat | cat categoryName == categoryName asSymbol] ifNone: [^ OrderedCollection new].
^ aCategory elementsInOrder collect: [:anElement | anElement selector] thenSelect:
[:aSelector | aClass canUnderstand: aSelector]!
Item was changed:
----- Method: Vocabulary>>categoryWordingAt: (in category 'queries') -----
categoryWordingAt: aSymbol
"Answer the wording for the category at the given symbol"
| result |
result := self categoryAt: aSymbol.
^result
ifNotNil: [result wording]
ifNil: [aSymbol]!
Item was changed:
----- Method: Vocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class (and instance, if provided), only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
(methodInterfaces includesKey: aSelector) ifFalse: [^ false].
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[(aClass includesBehavior: mostGenericClass) and:
[(self someCategoryThatIncludes: aSelector) notNil]]
!
Item was changed:
----- Method: Vocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new!
Item was changed:
----- Method: Vocabulary>>initializeFor: (in category 'initialization') -----
initializeFor: anObject
"Initialize the receiver to bear a vocabulary suitable for anObject"
object := anObject.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new.
self documentation: 'A vocabulary that has not yet been documented'.
!
Item was changed:
----- Method: Vocabulary>>renameCategoryFrom:to: (in category 'initialization') -----
renameCategoryFrom: oldName to: newName
"Rename the category currently known by oldName to be newName. No senders at present but once a UI is establshed for renaming categories, this will be useful."
| aCategory |
(aCategory := self categoryAt: oldName) ifNil: [^ self].
aCategory categoryName: newName!
Item was changed:
----- Method: Vocabulary>>vocabularyName: (in category 'initialization') -----
vocabularyName: aName
"Set the name of the vocabulary as indicated"
vocabularyName := aName!
1
0
Bert Freudenberg uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-bf.47.mcz
==================== Summary ====================
Name: Protocols-bf.47
Author: bf
Time: 8 December 2014, 1:58:54.292 am
UUID: 0ef36fb5-8126-4473-9db7-10c526491c7d
Ancestors: Protocols-nice.46
Restore timestamps lost in assignment conversion.
=============== Diff against Protocols-nice.46 ===============
Item was changed:
----- Method: Behavior>>implementsVocabulary: (in category '*Protocols') -----
implementsVocabulary: aVocabulary
"Answer whether instances of the receiver respond to the messages in aVocabulary."
(aVocabulary isKindOf: FullVocabulary orOf: ScreenedVocabulary) ifTrue: [^ true].
^ self fullyImplementsVocabulary: aVocabulary!
Item was changed:
----- Method: ButtonPhaseType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
self vocabularyName: #ButtonPhase.
symbols := #(buttonDown whilePressed buttonUp)!
Item was changed:
----- Method: CodeHolder>>spawnFullProtocol (in category '*Protocols-Tools') -----
spawnFullProtocol
"Create and schedule a new protocol browser on the currently selected class or meta."
| aClassOrMetaclass |
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openFullProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: CodeHolder>>spawnProtocol (in category '*Protocols-Tools') -----
spawnProtocol
| aClassOrMetaclass |
"Create and schedule a new protocol browser on the currently selected class or meta."
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openSubProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: ElementCategory>>categoryName: (in category 'category name') -----
categoryName: aName
"Set the category name"
categoryName := aName!
Item was changed:
----- Method: ElementCategory>>clear (in category 'initialization') -----
clear
"Clear the receiber's keysInOrder and elementDictionary"
keysInOrder := OrderedCollection new.
elementDictionary := IdentityDictionary new!
Item was changed:
----- Method: ElementCategory>>copyFrom: (in category 'copying') -----
copyFrom: donor
"Copy the receiver's contents from the donor"
keysInOrder := donor keysInOrder.
elementDictionary := donor copyOfElementDictionary!
Item was changed:
----- Method: FullVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods which are in the given category, on behalf of anObject"
| classToUse |
classToUse := aClass ifNil: [anObject class].
^ classToUse allMethodsInCategory: categoryName!
Item was changed:
----- Method: FullVocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'category list') -----
categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass
"Answer the category list for the given object, considering only code implemented in mostGeneric and lower (or higher, depending on which way you're facing"
| classToUse |
classToUse := anObject ifNil: [aClass] ifNotNil: [anObject class].
^ mostGenericClass == classToUse
ifTrue:
[mostGenericClass organization categories]
ifFalse:
[classToUse allMethodCategoriesIntegratedThrough: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class, only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[aClass includesBehavior: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')
Vocabulary initialize
"
super initialize.
vocabularyName := #Object.
self documentation: '"Object" is all-encompassing vocabulary that embraces all methods understood by an object'.
self rigAFewCategories!
Item was changed:
----- Method: Lexicon>>adjustWindowTitle (in category 'window title') -----
adjustWindowTitle
"Set the title of the receiver's window, if any, to reflect the current choices"
| aWindow aLabel catName |
(catName := self selectedCategoryName) ifNil: [^ self].
(aWindow := self containingWindow) ifNil: [^ self].
aLabel := nil.
#( (viewedCategoryName 'Messages already viewed - ')
(allCategoryName 'All messages - ')) do:
[:aPair | catName = (self categoryWithNameSpecifiedBy: aPair first) ifTrue: [aLabel := aPair second]].
aLabel ifNil:
[aLabel := catName = self class queryCategoryName
ifTrue:
[self queryCharacterization, ' - ']
ifFalse:
['Vocabulary of ']].
aWindow setLabel: aLabel, (self targetObject ifNil: [targetClass]) nameForViewer!
Item was changed:
----- Method: Lexicon>>annotation (in category 'basic operation') -----
annotation
"Provide a line of annotation material for a middle pane."
| aCategoryName |
self selectedMessageName ifNotNil: [^ super annotation].
(aCategoryName := self selectedCategoryName) ifNil:
[^ self hasSearchPane
ifTrue:
['type a message name or fragment in the top pane and hit RETURN or ENTER']
ifFalse:
['' "currentVocabulary documentation"]].
(aCategoryName = self class queryCategoryName) ifTrue:
[^ self queryCharacterization].
#(
(allCategoryName 'Shows all methods, whatever other category they belong to')
(viewedCategoryName 'Methods visited recently. Use "-" button to remove a method from this category.')
(queryCategoryName 'Query results'))
do:
[:pair | (self categoryWithNameSpecifiedBy: pair first) = aCategoryName ifTrue: [^ pair second]].
^ currentVocabulary categoryCommentFor: aCategoryName!
Item was changed:
----- Method: Lexicon>>categoryDefiningSelector: (in category 'category list') -----
categoryDefiningSelector: aSelector
"Answer a category in which aSelector occurs"
| categoryNames |
categoryNames := categoryList copyWithoutAll: #('-- all --').
^ currentVocabulary categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: self targetObject ofClass: targetClass!
Item was changed:
----- Method: Lexicon>>categoryList (in category 'category list') -----
categoryList
"Answer the category list for the protcol, creating it if necessary, and prepending the -- all -- category, and appending the other special categories for search results, etc."
| specialCategoryNames |
categoryList ifNil:
[specialCategoryNames := #(queryCategoryName viewedCategoryName "searchCategoryName sendersCategoryName changedCategoryName activeCategoryName") collect:
[:sym | self class perform: sym].
categoryList :=
(currentVocabulary categoryListForInstance: self targetObject ofClass: targetClass limitClass: limitClass),
specialCategoryNames,
(Array with: self class allCategoryName)].
^ categoryList!
Item was changed:
----- Method: Lexicon>>categoryListIndex (in category 'category list') -----
categoryListIndex
"Answer the index of the currently-selected item in in the category list"
^ categoryListIndex ifNil: [categoryListIndex := 1]!
Item was changed:
----- Method: Lexicon>>categoryListIndex: (in category 'category list') -----
categoryListIndex: anIndex
"Set the category list index as indicated"
| categoryName aList found existingSelector |
existingSelector := self selectedMessageName.
categoryListIndex := anIndex.
anIndex > 0
ifTrue:
[categoryName := categoryList at: anIndex]
ifFalse:
[contents := nil].
self changed: #categoryListIndex.
found := false.
#( (viewedCategoryName selectorsVisited)
(queryCategoryName selectorsRetrieved)) do:
[:pair |
categoryName = (self class perform: pair first)
ifTrue:
[aList := self perform: pair second.
found := true]].
found ifFalse:
[aList := currentVocabulary allMethodsInCategory: categoryName forInstance: self targetObject ofClass: targetClass].
categoryName = self class queryCategoryName ifFalse: [autoSelectString := nil].
self initListFrom: aList highlighting: targetClass.
messageListIndex := 0.
self changed: #messageList.
contents := nil.
self contentsChanged.
self selectWithinCurrentCategoryIfPossible: existingSelector.
self adjustWindowTitle!
Item was changed:
----- Method: Lexicon>>chooseLimitClass (in category 'limit class') -----
chooseLimitClass
"Put up a menu allowing the user to choose the most generic class to show"
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
targetClass withAllSuperclasses do:
[:aClass |
aClass == ProtoObject
ifTrue:
[aMenu addLine].
aMenu add: aClass name selector: #setLimitClass: argument: aClass.
aClass == limitClass ifTrue:
[aMenu lastItem color: Color red].
aClass == targetClass ifTrue: [aMenu addLine]].
aMenu addTitle: 'Show only methods
implemented at or above...'. "heh heh -- somebody please find nice wording here!!"
aMenu popUpInWorld: self currentWorld!
Item was changed:
----- Method: Lexicon>>currentQueryParameter (in category 'within-tool queries') -----
currentQueryParameter
"Answer the current query parameter"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>customButtonSpecs (in category 'control buttons') -----
customButtonSpecs
"Answer a triplet defining buttons, in the format:
button label
selector to send
help message"
| aa |
aa := contentsSymbol == #tiles ifTrue: [{ "Consult Ted Kaehler regarding this bit"
{'tiles'. #tilesMenu. 'tiles for assignment and constants'. true}.
{'vars'. #varTilesMenu. 'tiles for instance variables and a new temporary'. true}
}] ifFalse: [#()]. "true in 4th place means act on mouseDown"
^ aa, #(
('follow' seeAlso 'view a method I implement that is called by this method')
('find' obtainNewSearchString 'find methods by name search')
('sent...' setSendersSearch 'view the methods I implement that send a given message')
('<' navigateToPreviousMethod 'view the previous active method')
('>' navigateToNextMethod 'view the next active method')
('-' removeFromSelectorsVisited 'remove this method from my active list'))!
Item was changed:
----- Method: Lexicon>>displaySelector: (in category 'basic operation') -----
displaySelector: aSelector
"Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category"
| detectedItem messageIndex |
self chooseCategory: (self categoryDefiningSelector: aSelector).
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ Beeper beep].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex!
Item was changed:
----- Method: Lexicon>>initialLimitClass (in category 'limit class') -----
initialLimitClass
"Choose a plausible initial vlaue for the limit class, and answer it"
| oneTooFar |
limitClass := targetClass.
(#('ProtoObject' 'Object' 'Behavior' 'ClassDescription' 'Class' 'ProtoObject class' 'Object class') includes: targetClass name asString) ifTrue: [^ targetClass].
oneTooFar := (targetClass isKindOf: Metaclass)
ifTrue:
["use the fifth back from the superclass chain for Metaclasses, which is the immediate subclass of ProtoObject class. Print <ProtoObject class allSuperclasses> to count them yourself."
targetClass allSuperclasses at: (targetClass allSuperclasses size - 5)]
ifFalse:
[targetClass allSuperclasses at: targetClass allSuperclasses size].
[limitClass superclass ~~ oneTooFar]
whileTrue: [limitClass := limitClass superclass].
^ limitClass!
Item was changed:
----- Method: Lexicon>>lastSearchString (in category 'search') -----
lastSearchString
"Answer the last search string, initializing it to an empty string if it has not been initialized yet"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>lastSearchString: (in category 'search') -----
lastSearchString: aString
"Make a note of the last string searched for in the receiver"
currentQueryParameter := aString asString.
currentQuery := #selectorName.
autoSelectString := aString.
self setMethodListFromSearchString.
^ true!
Item was changed:
----- Method: Lexicon>>lastSendersSearchSelector (in category 'search') -----
lastSendersSearchSelector
"Answer the last senders search selector, initializing it to a default value if it does not already have a value"
^ currentQueryParameter ifNil: [currentQueryParameter := #flag:]!
Item was changed:
----- Method: Lexicon>>limitClass: (in category 'limit class') -----
limitClass: aClass
"Set the most generic class to show as indicated"
limitClass := aClass!
Item was changed:
----- Method: Lexicon>>limitClassString (in category 'limit class') -----
limitClassString
"Answer a string representing the current choice of most-generic-class-to-show"
| most |
(most := self limitClass) == ProtoObject
ifTrue: [^ 'All'].
most == targetClass
ifTrue: [^ most name].
^ 'Only through ', most name!
Item was changed:
----- Method: Lexicon>>messageListIndex: (in category 'basic operation') -----
messageListIndex: anIndex
"Set the message list index as indicated, and update the history list if appropriate"
| newSelector current |
current := self selectedMessageName.
super messageListIndex: anIndex.
anIndex = 0 ifTrue: [
self editSelection: #newMessage.
self contentsChanged].
(newSelector := self selectedMessageName) ifNotNil:
[self updateSelectorsVisitedfrom: current to: newSelector]!
Item was changed:
----- Method: Lexicon>>methodListFromSearchString: (in category 'search') -----
methodListFromSearchString: fragment
"Answer a method list of methods whose selectors match the given fragment"
| aList searchFor |
currentQueryParameter := fragment.
currentQuery := #selectorName.
autoSelectString := fragment.
searchFor := fragment asString asLowercase withBlanksTrimmed.
aList := targetClass allSelectors select:
[:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
searchFor size > 0 ifTrue:
[aList := aList select:
[:aSelector | aSelector includesSubstring: searchFor caseSensitive: false]].
^ aList asSortedArray
!
Item was changed:
----- Method: Lexicon>>methodsWithInitials: (in category 'within-tool queries') -----
methodsWithInitials: initials
"Return a list of selectors representing methods whose timestamps have the given initials and which are in the protocol of this object and within the range dictated by my limitClass."
| classToUse |
classToUse := self targetObject ifNotNil: [self targetObject class] ifNil: [targetClass]. "In support of lightweight uniclasses"
^ targetClass allSelectors select:
[:aSelector | (currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: classToUse limitClass: limitClass) and:
[Utilities doesMethod: aSelector forClass: classToUse bearInitials: initials]].
!
Item was changed:
----- Method: Lexicon>>newCategoryPane (in category 'category list') -----
newCategoryPane
"Formulate a category pane for insertion into the receiver's pane list"
| aListMorph |
aListMorph := PluggableListMorph on: self list: #categoryList
selected: #categoryListIndex changeSelected: #categoryListIndex:
menu: #categoryListMenu:shifted:
keystroke: #categoryListKey:from:.
aListMorph setNameTo: 'categoryList'.
aListMorph menuTitleSelector: #categoryListMenuTitle.
^ aListMorph!
Item was changed:
----- Method: Lexicon>>preserveSelectorIfPossibleSurrounding: (in category 'transition') -----
preserveSelectorIfPossibleSurrounding: aBlock
"Make a note of the currently-selected method; perform aBlock and then attempt to reestablish that same method as the selected one in the new circumstances"
| aClass aSelector |
aClass := self selectedClassOrMetaClass.
aSelector := self selectedMessageName.
aBlock value.
self hasSearchPane
ifTrue:
[self setMethodListFromSearchString]
ifFalse:
[self maybeReselectClass: aClass selector: aSelector]!
Item was changed:
----- Method: Lexicon>>reformulateCategoryList (in category 'category list') -----
reformulateCategoryList
"Reformulate the category list"
categoryList := nil.
self categoryListIndex: 0.
self changed: #categoryList.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>removeFromSelectorsVisited (in category 'history') -----
removeFromSelectorsVisited
"Remove the currently-selected method from the active set"
| aSelector |
(aSelector := self selectedMessageName) ifNil: [^ self].
self removeFromSelectorsVisited: aSelector.
self chooseCategory: self class viewedCategoryName!
Item was changed:
----- Method: Lexicon>>removeMessage (in category 'menu commands') -----
removeMessage
"Remove the selected message from the system."
messageListIndex = 0 ifTrue: [^ self].
self okToChange ifFalse: [^ self].
super removeMessage.
"my #reformulateList method, called from the super #removeMethod method, will however try to preserve the selection, so we take pains to clobber it by the below..."
messageListIndex := 0.
self changed: #messageList.
self changed: #messageListIndex.
contents := nil.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>retainMethodSelectionWhileSwitchingToCategory: (in category 'transition') -----
retainMethodSelectionWhileSwitchingToCategory: aCategoryName
"retain method selection while switching the category-pane selection to show the category of the given name"
| aSelectedName |
aSelectedName := self selectedMessageName.
self categoryListIndex: (categoryList indexOf: aCategoryName ifAbsent: [^ self]).
aSelectedName ifNotNil: [self selectWithinCurrentCategory: aSelectedName]
!
Item was changed:
----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') -----
selectSelectorItsNaturalCategory: aSelector
"Make aSelector be the current selection of the receiver, with the category being its home category."
| cat catIndex detectedItem |
cat := self categoryOfSelector: aSelector.
catIndex := categoryList indexOf: cat ifAbsent:
["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category"
1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') -----
selectWithinCurrentCategory: aSelector
"If aSelector is one of the selectors seen in the current category, select it"
| detectedItem |
detectedItem := self messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') -----
selectWithinCurrentCategoryIfPossible: aSelector
"If the receiver's message list contains aSelector, navigate right to it without changing categories"
| detectedItem messageIndex |
aSelector ifNil: [^ self].
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>selectorsMatching (in category 'search') -----
selectorsMatching
"Anwer a list of selectors in the receiver that match the current search string"
| fragment aList |
fragment := self lastSearchString asLowercase.
aList := targetClass allSelectors select:
[:aSelector | (aSelector includesSubstring: fragment caseSensitive: false) and:
[currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]].
^ aList asSortedArray!
Item was changed:
----- Method: Lexicon>>selectorsVisited (in category 'history') -----
selectorsVisited
"Answer the list of selectors visited in this tool"
^ selectorsVisited ifNil: [selectorsVisited := OrderedCollection new]!
Item was changed:
----- Method: Lexicon>>setLocalClassVarRefs (in category 'within-tool queries') -----
setLocalClassVarRefs
"Put up a list of the class variables in the viewed object, and when the user selects one, let the query results category show all the references to that class variable."
| aName |
(aName := targetClass theNonMetaClass chooseClassVarName) ifNil: [^ self].
currentQuery := #classVarRefs.
currentQueryParameter := aName.
self showQueryResultsCategory!
Item was changed:
----- Method: Lexicon>>setToShowSelector: (in category 'selection') -----
setToShowSelector: aSelector
"Set up the receiver so that it will show the given selector"
| catName catIndex detectedItem messageIndex aList |
catName := (aList := currentVocabulary categoriesContaining: aSelector forClass: targetClass) size > 0
ifTrue:
[aList first]
ifFalse:
[self class allCategoryName].
catIndex := categoryList indexOf: catName ifAbsent: [1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem upTo: $ ) asString asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>showCategoriesPane (in category 'category list') -----
showCategoriesPane
"Show the categories pane instead of the search pane"
| aPane |
(aPane := self searchPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newCategoryPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>showHomeCategory (in category 'menu commands') -----
showHomeCategory
"Continue to show the current selector, but show it within the context of its primary category"
| aSelector |
(aSelector := self selectedMessageName) ifNotNil:
[self preserveSelectorIfPossibleSurrounding:
[self setToShowSelector: aSelector]]!
Item was changed:
----- Method: Lexicon>>showMethodsInCurrentChangeSet (in category 'within-tool queries') -----
showMethodsInCurrentChangeSet
"Set the current query to be for methods in the current change set"
currentQuery := #currentChangeSet.
autoSelectString := nil.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).!
Item was changed:
----- Method: Lexicon>>showMethodsWithInitials: (in category 'within-tool queries') -----
showMethodsWithInitials: initials
"Make the current query be for methods stamped with the given initials"
currentQuery := #methodsWithInitials.
currentQueryParameter := initials.
self showQueryResultsCategory.
autoSelectString := nil.
self changed: #messageList.
self adjustWindowTitle
!
Item was changed:
----- Method: Lexicon>>showQueryResultsCategory (in category 'within-tool queries') -----
showQueryResultsCategory
"Point the receiver at the query-results category and set the search string accordingly"
autoSelectString := self currentQueryParameter.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).
self messageListIndex: 0!
Item was changed:
----- Method: Lexicon>>showSearchPane (in category 'search') -----
showSearchPane
"Given that the receiver is showing the categories pane, replace that with a search pane. Though there is a residual UI for obtaining this variant, it is obscure and the integrity of the protocol-category-browser when there is no categories pane is not necessarily assured at the moment."
| aPane |
(aPane := self categoriesPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newSearchPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>useVocabulary: (in category 'vocabulary') -----
useVocabulary: aVocabulary
"Set up the receiver to use the given vocabulary"
currentVocabulary := aVocabulary!
Item was changed:
----- Method: MethodCall>>evaluate (in category 'evaluation') -----
evaluate
"Evaluate the receiver, and if value has changed, signal value-changed"
| result |
result := arguments isEmptyOrNil
ifTrue: [self receiver perform: selector]
ifFalse: [self receiver perform: selector withArguments: arguments asArray].
timeStamp := Time dateAndTimeNow.
result ~= lastValue ifTrue:
[lastValue := result.
self changed: #value]
!
Item was changed:
----- Method: MethodCall>>methodInterface (in category 'method interface') -----
methodInterface
"Answer the receiver's methodInterface, conjuring one up on the spot (and remembering) if not present"
^ methodInterface ifNil:
[methodInterface := self ephemeralMethodInterface]!
Item was changed:
----- Method: MethodCall>>methodInterface: (in category 'method interface') -----
methodInterface: anInterface
"Set my methodInterface"
methodInterface := anInterface!
Item was changed:
----- Method: MethodCall>>receiver:methodInterface: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface
"Initialize me to have the given receiver and methodInterface"
| aResultType |
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := aMethodInterface defaultArguments.
self flag: #noteToTed.
"the below can't really survive, I know. The intent is that if the method has a declared result type, we want the preferred readout type to be able to handle the initial #lastValue even if the MethodCall has not been evaluated yet; thus we'd rather have a boolean value such as true rather than a nil here if we're showing a boolean readout such as a checkbox, and likewise for color-valued and numeric-valued readouts etc, "
(aResultType := methodInterface resultType) ~~ #unknown ifTrue:
[lastValue := (Vocabulary vocabularyForType: aResultType) initialValueForASlotFor: aReceiver] !
Item was changed:
----- Method: MethodCall>>receiver:methodInterface:initialArguments: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface initialArguments: initialArguments
"Set up a method-call for the given receiver, method-interface, and initial arguments"
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := initialArguments ifNotNil: [initialArguments asArray]
!
Item was changed:
----- Method: MethodCall>>setArgumentNamed:toValue: (in category 'argument access') -----
setArgumentNamed: aName toValue: aValue
"Set the argument of the given name to the given value"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
anIndex > 0
ifTrue:
[arguments at: anIndex put: aValue]
ifFalse:
[self error: 'argument missing'].
self changed: #argumentValue!
Item was changed:
----- Method: MethodCall>>valueOfArgumentNamed: (in category 'initialization') -----
valueOfArgumentNamed: aName
"Answer the value of the given arguement variable"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
^ anIndex > 0
ifTrue:
[arguments at: anIndex]
ifFalse:
[self error: 'variable not found']!
Item was changed:
----- Method: MethodInterface>>argumentVariables (in category 'initialization') -----
argumentVariables
"Answer the list of argumentVariables of the interface"
^ argumentVariables ifNil: [argumentVariables := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>argumentVariables: (in category 'initialization') -----
argumentVariables: variableList
"Set the argument variables"
argumentVariables := variableList!
Item was changed:
----- Method: MethodInterface>>attributeKeywords (in category 'attribute keywords') -----
attributeKeywords
"Answer a list of attribute keywords associated with the receiver"
^ attributeKeywords ifNil: [attributeKeywords := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>conjuredUpFor:class: (in category 'initialization') -----
conjuredUpFor: aSelector class: aClass
"Initialize the receiver to have the given selector, obtaining whatever info one can from aClass. This basically covers the situation where no formal definition has been made."
| parts |
self initializeFor: aSelector.
self wording: aSelector.
receiverType := #unknown.
parts := aClass formalHeaderPartsFor: aSelector.
argumentVariables := (1 to: selector numArgs) collect:
[:anIndex | Variable new name: (parts at: (4 * anIndex)) type: #Object].
parts last isEmptyOrNil ifFalse: [self documentation: parts last].
!
Item was changed:
----- Method: MethodInterface>>defaultStatus: (in category 'status') -----
defaultStatus: aStatus
"Set the receiver's defaultStatus as indicated"
defaultStatus := aStatus!
Item was changed:
----- Method: MethodInterface>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver"
super initialize.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal.
argumentVariables := OrderedCollection new
!
Item was changed:
----- Method: MethodInterface>>initializeFor: (in category 'initialization') -----
initializeFor: aSelector
"Initialize the receiver to have the given selector"
selector := aSelector.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal
!
Item was changed:
----- Method: MethodInterface>>initializeSetterFromEToySlotSpec: (in category 'initialization') -----
initializeSetterFromEToySlotSpec: tuple
"tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to represent the getter of this item"
selector := tuple ninth.
self
wording: ('set ', tuple second);
helpMessage: ('setter for', tuple third).
receiverType := #Player.
argumentVariables := Array with: (Variable new variableType: tuple fourth)
!
Item was changed:
----- Method: MethodInterface>>receiverType (in category 'access') -----
receiverType
"Answer the receiver type"
^ receiverType ifNil: [receiverType := #unknown]!
Item was changed:
----- Method: MethodInterface>>receiverType: (in category 'initialization') -----
receiverType: aType
"set the receiver type. Whether the receiverType earns its keep here is not yet well understood. At the moment, this is unsent"
receiverType := aType!
Item was changed:
----- Method: MethodInterface>>resultType: (in category 'initialization') -----
resultType: aType
"Set the receiver's resultSpecification to be a ResultType of the given type"
resultSpecification := ResultSpecification new.
resultSpecification resultType: aType!
Item was changed:
----- Method: MethodInterface>>selector:type:setter: (in category 'attribute keywords') -----
selector: aSelector type: aType setter: aSetter
"Set the receiver's fields as indicated. Values of nil or #none for the result type and the setter indicate that there is none"
selector := aSelector.
(MethodInterface isNullMarker: aType) ifFalse:
[resultSpecification := ResultSpecification new.
resultSpecification resultType: aType.
(MethodInterface isNullMarker: aSetter) ifFalse:
[resultSpecification companionSetterSelector: aSetter]]!
Item was changed:
----- Method: MethodInterface>>typeForArgumentNumber: (in category 'access') -----
typeForArgumentNumber: anArgumentNumber
"Answer the data type for the given argument number"
| aVariable |
aVariable := self argumentVariables at: anArgumentNumber.
^ aVariable variableType!
Item was changed:
----- Method: ObjectWithDocumentation>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
authoringStamp := Utilities changeStampPerSe
!
Item was changed:
----- Method: ObjectWithDocumentation>>legacyHelpMessage (in category 'accessing') -----
legacyHelpMessage
"If I have a help message stashed in my legacy naturalTranslations slot, answer its translated rendition, else answer nil. If I *do* come across a legacy help message, transfer it to my properties dictionary."
| untranslated |
naturalLanguageTranslations isEmptyOrNil "only in legacy (pre-3.8) projects"
ifTrue: [^ nil].
untranslated := naturalLanguageTranslations first helpMessage ifNil: [^ nil].
self propertyAt: #helpMessage put: untranslated.
naturalLanguageTranslations removeFirst.
naturalLanguageTranslations isEmpty ifTrue: [naturalLanguageTranslations := nil].
^ untranslated translated!
Item was changed:
----- Method: ProtocolBrowser>>setClassAndSelectorIn: (in category 'private') -----
setClassAndSelectorIn: csBlock
"Decode strings of the form <selectorName> (<className> [class])"
| i classAndSelString selString sel |
sel := self selection ifNil: [^ csBlock value: nil value: nil].
(sel isKindOf: MethodReference) ifTrue: [
sel setClassAndSelectorIn: csBlock
] ifFalse: [
selString := sel asString.
i := selString indexOf: $(.
"Rearrange to <className> [class] <selectorName> , and use MessageSet"
classAndSelString := (selString copyFrom: i + 1 to: selString size - 1) , ' ' ,
(selString copyFrom: 1 to: i - 1) withoutTrailingBlanks.
MessageSet parse: classAndSelString toClassAndSelector: csBlock.
].
!
Item was changed:
----- Method: ResultSpecification>>companionSetterSelector: (in category 'companion setter') -----
companionSetterSelector: aSetterSelector
"Set the receiver's companionSetterSelector as indicated"
companionSetterSelector := aSetterSelector!
Item was changed:
----- Method: ResultSpecification>>refetchFrequency: (in category 'refetch') -----
refetchFrequency: aFrequency
"Set the refetch frequency"
refetchFrequency := aFrequency!
Item was changed:
----- Method: ResultSpecification>>resultType: (in category 'result type') -----
resultType: aType
"Set the receiver's resultType as specified"
type := aType!
Item was changed:
----- Method: ScreenedVocabulary>>categoryScreeningBlock: (in category 'initialization') -----
categoryScreeningBlock: aBlock
"Set the receiver's categoryScreeningBlock to the block provided"
categoryScreeningBlock := aBlock!
Item was changed:
----- Method: ScreenedVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #Public.
self documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'!
Item was changed:
----- Method: ScreenedVocabulary>>methodScreeningBlock: (in category 'initialization') -----
methodScreeningBlock: aBlock
"Set the receiver's methodScreeningBlock to the block provided"
methodScreeningBlock := aBlock!
Item was changed:
----- Method: SymbolListType>>symbols: (in category 'tiles') -----
symbols: symbolList
"Set the receiver's list of symbols as indicated"
symbols := symbolList!
Item was changed:
----- Method: UnknownType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unknown!
Item was changed:
----- Method: Variable>>name:type: (in category 'name') -----
name: aName type: aType
"Set the variable's name and type as indicated"
variableName := aName.
variableType := aType!
Item was changed:
----- Method: Variable>>sample (in category 'value') -----
sample
"The closest we can come to an object for our type"
| ty clsName |
self defaultValue ifNotNil: [^ self defaultValue].
ty := self variableType.
"How translate a type like #player into a class?"
clsName := ty asString.
clsName at: 1 put: (clsName first asUppercase).
clsName := clsName asSymbol.
(Smalltalk includesKey: clsName) ifFalse: [self error: 'What type is this?'. ^ 5].
^ (Smalltalk at: clsName) initializedInstance!
Item was changed:
----- Method: Variable>>variableType: (in category 'type') -----
variableType: aType
"Set the receiver's variable type as requested"
variableType := aType!
Item was changed:
----- Method: Vocabulary class>>allStandardVocabularies (in category 'standard vocabulary access') -----
allStandardVocabularies
"Answer a list of the currently-defined vocabularies in my AllStandardVocabularies list"
"Vocabulary allStandardVocabularies"
^AllStandardVocabularies ifNil: [AllStandardVocabularies := IdentityDictionary new].
!
Item was changed:
----- Method: Vocabulary class>>newPublicVocabulary (in category 'universal vocabularies') -----
newPublicVocabulary
| aVocabulary |
"Answer a public vocabulary"
aVocabulary := ScreenedVocabulary new.
aVocabulary vocabularyName: #Public.
aVocabulary documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'.
aVocabulary categoryScreeningBlock: [:aCategoryName | (aCategoryName beginsWith: 'private') not].
aVocabulary methodScreeningBlock: [:aSelector |
((aSelector beginsWith: 'private') or: [aSelector beginsWith: 'pvt']) not].
^ aVocabulary
!
Item was changed:
----- Method: Vocabulary class>>newQuadVocabulary (in category 'testing and demo') -----
newQuadVocabulary
"Answer a Quad vocabulary -- something to mess with, to illustrate and explore ideas. Applies to Quadrangles only."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Quad.
aVocabulary documentation: 'A highly restricted test vocabulary that can be used with Quadrangle objects'.
aVocabulary initializeFromTable: #(
(borderColor borderColor: () Color (basic color) 'The color of the border' unused updating)
(borderWidth borderWidth: () Number (basic geometry) 'The width of the border' unused updating)
(insideColor insideColor: () Color (basic color) 'The color of the quadrangle' unused updating)
(display none () none (basic display) 'Display the quadrangle directly on the screen')
(width none () Number (geometry) 'The width of the object' unused updating)
(left setLeft: () Number (geometry) 'The left edge' unused updating)
(right setRight: () Number (geometry) 'The right edge' unused updating)
(width setWidth: () Number (geometry) 'The width of the object' unused updating)
(height setHeight: () Number (geometry) 'The height of the object' unused updating)
(hasPositiveExtent none () Boolean (tests) 'Whether the corner is to the lower-right of the origin' unused updating)
(isTall none () Boolean (tests) 'Whether the height is greater than the width' unused updating)).
^ aVocabulary
"Vocabulary initialize"
"Quadrangle exampleInViewer"!
Item was changed:
----- Method: Vocabulary class>>newTestVocabulary (in category 'testing and demo') -----
newTestVocabulary
"Answer a Test vocabulary -- something to mess with, to illustrate and explore ideas."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Test.
aVocabulary documentation: 'An illustrative vocabulary for testing'.
aVocabulary initializeFromTable: #(
(isKindOf: none ((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass')
(class none none Class (#'class membership' wimpy) 'answer the the class to which the receiver belongs')
(respondsTo: none ((aSelector Symbol)) Boolean (#'class membership') 'answer whether the receiver responds to the given selector')
(as: none ((aClass Class)) Object (conversion) 'answer the receiver converted to be a member of aClass')).
^ aVocabulary
"
#((#'class membership' 'Whether an object can respond to a given message, etc.' (isKindOf: class respondsTo:))
(conversion 'Messages to convert from one kind of object to another' (as: asString))
(copying 'Messages for making copies of objects' (copy copyFrom:))
(equality 'Testing whether two objects are equal' ( = ~= == ~~))
(dependents 'Support for dependency notification' (addDependent: removeDependent: release))) do:
[:item |
aMethodCategory := ElementCategory new categoryName: item first.
aMethodCategory documentation: item second.
item third do:
[:aSelector |
aMethodInterface := MethodInterface new initializeFor: aSelector.
aVocabulary atKey: aSelector putMethodInterface: aMethodInterface.
aMethodCategory elementAt: aSelector put: aMethodInterface].
aVocabulary addCategory: aMethodCategory]."
!
Item was changed:
----- Method: Vocabulary class>>vocabularyForClass: (in category 'type vocabularies') -----
vocabularyForClass: aClass
"Answer the standard vocabulary for that class. Create it if not present and init message exists. Answer nil if none exists and no init message present."
| initMsgName newTypeVocab |
(self allStandardVocabularies includesKey: aClass name)
ifTrue: [^self allStandardVocabularies at: aClass name].
initMsgName := ('new', aClass name, 'Vocabulary') asSymbol.
^(self respondsTo: initMsgName)
ifTrue: [
newTypeVocab := self perform: initMsgName.
self addStandardVocabulary: newTypeVocab.
newTypeVocab]
ifFalse: [nil]!
Item was changed:
----- Method: Vocabulary class>>vocabularyForType: (in category 'type vocabularies') -----
vocabularyForType: aType
"Answer a vocabulary appropriate to the given type, which is normally going to be a symbol such as #Number or #Color. Answer the Unknown vocabulary as a fall-back"
| ucSym |
(aType isKindOf: Vocabulary) ifTrue: [^ aType].
ucSym := aType capitalized asSymbol.
^self allStandardVocabularies at: ucSym ifAbsent: [self vocabularyNamed: #unknown]!
Item was changed:
----- Method: Vocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'queries') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods in the etoy interface which are in the given category, on behalf of aClass and possibly anObject. Note that there is no limitClass at play here."
| aCategory |
categoryName ifNil: [^ OrderedCollection new].
categoryName = self allCategoryName ifTrue:
[^ methodInterfaces collect: [:anInterface | anInterface selector]].
aCategory := categories detect: [:cat | cat categoryName == categoryName asSymbol] ifNone: [^ OrderedCollection new].
^ aCategory elementsInOrder collect: [:anElement | anElement selector] thenSelect:
[:aSelector | aClass canUnderstand: aSelector]!
Item was changed:
----- Method: Vocabulary>>categoryWordingAt: (in category 'queries') -----
categoryWordingAt: aSymbol
"Answer the wording for the category at the given symbol"
| result |
result := self categoryAt: aSymbol.
^result
ifNotNil: [result wording]
ifNil: [aSymbol]!
Item was changed:
----- Method: Vocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class (and instance, if provided), only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
(methodInterfaces includesKey: aSelector) ifFalse: [^ false].
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[(aClass includesBehavior: mostGenericClass) and:
[(self someCategoryThatIncludes: aSelector) notNil]]
!
Item was changed:
----- Method: Vocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new!
Item was changed:
----- Method: Vocabulary>>initializeFor: (in category 'initialization') -----
initializeFor: anObject
"Initialize the receiver to bear a vocabulary suitable for anObject"
object := anObject.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new.
self documentation: 'A vocabulary that has not yet been documented'.
!
Item was changed:
----- Method: Vocabulary>>renameCategoryFrom:to: (in category 'initialization') -----
renameCategoryFrom: oldName to: newName
"Rename the category currently known by oldName to be newName. No senders at present but once a UI is establshed for renaming categories, this will be useful."
| aCategory |
(aCategory := self categoryAt: oldName) ifNil: [^ self].
aCategory categoryName: newName!
Item was changed:
----- Method: Vocabulary>>vocabularyName: (in category 'initialization') -----
vocabularyName: aName
"Set the name of the vocabulary as indicated"
vocabularyName := aName!
1
0
Bert Freudenberg uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-bf.47.mcz
==================== Summary ====================
Name: Protocols-bf.47
Author: bf
Time: 8 December 2014, 1:58:54.292 am
UUID: 0ef36fb5-8126-4473-9db7-10c526491c7d
Ancestors: Protocols-nice.46
Restore timestamps lost in assignment conversion.
=============== Diff against Protocols-nice.46 ===============
Item was changed:
----- Method: Behavior>>implementsVocabulary: (in category '*Protocols') -----
implementsVocabulary: aVocabulary
"Answer whether instances of the receiver respond to the messages in aVocabulary."
(aVocabulary isKindOf: FullVocabulary orOf: ScreenedVocabulary) ifTrue: [^ true].
^ self fullyImplementsVocabulary: aVocabulary!
Item was changed:
----- Method: ButtonPhaseType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
self vocabularyName: #ButtonPhase.
symbols := #(buttonDown whilePressed buttonUp)!
Item was changed:
----- Method: CodeHolder>>spawnFullProtocol (in category '*Protocols-Tools') -----
spawnFullProtocol
"Create and schedule a new protocol browser on the currently selected class or meta."
| aClassOrMetaclass |
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openFullProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: CodeHolder>>spawnProtocol (in category '*Protocols-Tools') -----
spawnProtocol
| aClassOrMetaclass |
"Create and schedule a new protocol browser on the currently selected class or meta."
(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
[ProtocolBrowser openSubProtocolForClass: aClassOrMetaclass]!
Item was changed:
----- Method: ElementCategory>>categoryName: (in category 'category name') -----
categoryName: aName
"Set the category name"
categoryName := aName!
Item was changed:
----- Method: ElementCategory>>clear (in category 'initialization') -----
clear
"Clear the receiber's keysInOrder and elementDictionary"
keysInOrder := OrderedCollection new.
elementDictionary := IdentityDictionary new!
Item was changed:
----- Method: ElementCategory>>copyFrom: (in category 'copying') -----
copyFrom: donor
"Copy the receiver's contents from the donor"
keysInOrder := donor keysInOrder.
elementDictionary := donor copyOfElementDictionary!
Item was changed:
----- Method: FullVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods which are in the given category, on behalf of anObject"
| classToUse |
classToUse := aClass ifNil: [anObject class].
^ classToUse allMethodsInCategory: categoryName!
Item was changed:
----- Method: FullVocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'category list') -----
categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass
"Answer the category list for the given object, considering only code implemented in mostGeneric and lower (or higher, depending on which way you're facing"
| classToUse |
classToUse := anObject ifNil: [aClass] ifNotNil: [anObject class].
^ mostGenericClass == classToUse
ifTrue:
[mostGenericClass organization categories]
ifFalse:
[classToUse allMethodCategoriesIntegratedThrough: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class, only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[aClass includesBehavior: mostGenericClass]!
Item was changed:
----- Method: FullVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')
Vocabulary initialize
"
super initialize.
vocabularyName := #Object.
self documentation: '"Object" is all-encompassing vocabulary that embraces all methods understood by an object'.
self rigAFewCategories!
Item was changed:
----- Method: Lexicon>>adjustWindowTitle (in category 'window title') -----
adjustWindowTitle
"Set the title of the receiver's window, if any, to reflect the current choices"
| aWindow aLabel catName |
(catName := self selectedCategoryName) ifNil: [^ self].
(aWindow := self containingWindow) ifNil: [^ self].
aLabel := nil.
#( (viewedCategoryName 'Messages already viewed - ')
(allCategoryName 'All messages - ')) do:
[:aPair | catName = (self categoryWithNameSpecifiedBy: aPair first) ifTrue: [aLabel := aPair second]].
aLabel ifNil:
[aLabel := catName = self class queryCategoryName
ifTrue:
[self queryCharacterization, ' - ']
ifFalse:
['Vocabulary of ']].
aWindow setLabel: aLabel, (self targetObject ifNil: [targetClass]) nameForViewer!
Item was changed:
----- Method: Lexicon>>annotation (in category 'basic operation') -----
annotation
"Provide a line of annotation material for a middle pane."
| aCategoryName |
self selectedMessageName ifNotNil: [^ super annotation].
(aCategoryName := self selectedCategoryName) ifNil:
[^ self hasSearchPane
ifTrue:
['type a message name or fragment in the top pane and hit RETURN or ENTER']
ifFalse:
['' "currentVocabulary documentation"]].
(aCategoryName = self class queryCategoryName) ifTrue:
[^ self queryCharacterization].
#(
(allCategoryName 'Shows all methods, whatever other category they belong to')
(viewedCategoryName 'Methods visited recently. Use "-" button to remove a method from this category.')
(queryCategoryName 'Query results'))
do:
[:pair | (self categoryWithNameSpecifiedBy: pair first) = aCategoryName ifTrue: [^ pair second]].
^ currentVocabulary categoryCommentFor: aCategoryName!
Item was changed:
----- Method: Lexicon>>categoryDefiningSelector: (in category 'category list') -----
categoryDefiningSelector: aSelector
"Answer a category in which aSelector occurs"
| categoryNames |
categoryNames := categoryList copyWithoutAll: #('-- all --').
^ currentVocabulary categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: self targetObject ofClass: targetClass!
Item was changed:
----- Method: Lexicon>>categoryList (in category 'category list') -----
categoryList
"Answer the category list for the protcol, creating it if necessary, and prepending the -- all -- category, and appending the other special categories for search results, etc."
| specialCategoryNames |
categoryList ifNil:
[specialCategoryNames := #(queryCategoryName viewedCategoryName "searchCategoryName sendersCategoryName changedCategoryName activeCategoryName") collect:
[:sym | self class perform: sym].
categoryList :=
(currentVocabulary categoryListForInstance: self targetObject ofClass: targetClass limitClass: limitClass),
specialCategoryNames,
(Array with: self class allCategoryName)].
^ categoryList!
Item was changed:
----- Method: Lexicon>>categoryListIndex (in category 'category list') -----
categoryListIndex
"Answer the index of the currently-selected item in in the category list"
^ categoryListIndex ifNil: [categoryListIndex := 1]!
Item was changed:
----- Method: Lexicon>>categoryListIndex: (in category 'category list') -----
categoryListIndex: anIndex
"Set the category list index as indicated"
| categoryName aList found existingSelector |
existingSelector := self selectedMessageName.
categoryListIndex := anIndex.
anIndex > 0
ifTrue:
[categoryName := categoryList at: anIndex]
ifFalse:
[contents := nil].
self changed: #categoryListIndex.
found := false.
#( (viewedCategoryName selectorsVisited)
(queryCategoryName selectorsRetrieved)) do:
[:pair |
categoryName = (self class perform: pair first)
ifTrue:
[aList := self perform: pair second.
found := true]].
found ifFalse:
[aList := currentVocabulary allMethodsInCategory: categoryName forInstance: self targetObject ofClass: targetClass].
categoryName = self class queryCategoryName ifFalse: [autoSelectString := nil].
self initListFrom: aList highlighting: targetClass.
messageListIndex := 0.
self changed: #messageList.
contents := nil.
self contentsChanged.
self selectWithinCurrentCategoryIfPossible: existingSelector.
self adjustWindowTitle!
Item was changed:
----- Method: Lexicon>>chooseLimitClass (in category 'limit class') -----
chooseLimitClass
"Put up a menu allowing the user to choose the most generic class to show"
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
targetClass withAllSuperclasses do:
[:aClass |
aClass == ProtoObject
ifTrue:
[aMenu addLine].
aMenu add: aClass name selector: #setLimitClass: argument: aClass.
aClass == limitClass ifTrue:
[aMenu lastItem color: Color red].
aClass == targetClass ifTrue: [aMenu addLine]].
aMenu addTitle: 'Show only methods
implemented at or above...'. "heh heh -- somebody please find nice wording here!!"
aMenu popUpInWorld: self currentWorld!
Item was changed:
----- Method: Lexicon>>currentQueryParameter (in category 'within-tool queries') -----
currentQueryParameter
"Answer the current query parameter"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>customButtonSpecs (in category 'control buttons') -----
customButtonSpecs
"Answer a triplet defining buttons, in the format:
button label
selector to send
help message"
| aa |
aa := contentsSymbol == #tiles ifTrue: [{ "Consult Ted Kaehler regarding this bit"
{'tiles'. #tilesMenu. 'tiles for assignment and constants'. true}.
{'vars'. #varTilesMenu. 'tiles for instance variables and a new temporary'. true}
}] ifFalse: [#()]. "true in 4th place means act on mouseDown"
^ aa, #(
('follow' seeAlso 'view a method I implement that is called by this method')
('find' obtainNewSearchString 'find methods by name search')
('sent...' setSendersSearch 'view the methods I implement that send a given message')
('<' navigateToPreviousMethod 'view the previous active method')
('>' navigateToNextMethod 'view the next active method')
('-' removeFromSelectorsVisited 'remove this method from my active list'))!
Item was changed:
----- Method: Lexicon>>displaySelector: (in category 'basic operation') -----
displaySelector: aSelector
"Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category"
| detectedItem messageIndex |
self chooseCategory: (self categoryDefiningSelector: aSelector).
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ Beeper beep].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex!
Item was changed:
----- Method: Lexicon>>initialLimitClass (in category 'limit class') -----
initialLimitClass
"Choose a plausible initial vlaue for the limit class, and answer it"
| oneTooFar |
limitClass := targetClass.
(#('ProtoObject' 'Object' 'Behavior' 'ClassDescription' 'Class' 'ProtoObject class' 'Object class') includes: targetClass name asString) ifTrue: [^ targetClass].
oneTooFar := (targetClass isKindOf: Metaclass)
ifTrue:
["use the fifth back from the superclass chain for Metaclasses, which is the immediate subclass of ProtoObject class. Print <ProtoObject class allSuperclasses> to count them yourself."
targetClass allSuperclasses at: (targetClass allSuperclasses size - 5)]
ifFalse:
[targetClass allSuperclasses at: targetClass allSuperclasses size].
[limitClass superclass ~~ oneTooFar]
whileTrue: [limitClass := limitClass superclass].
^ limitClass!
Item was changed:
----- Method: Lexicon>>lastSearchString (in category 'search') -----
lastSearchString
"Answer the last search string, initializing it to an empty string if it has not been initialized yet"
^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!
Item was changed:
----- Method: Lexicon>>lastSearchString: (in category 'search') -----
lastSearchString: aString
"Make a note of the last string searched for in the receiver"
currentQueryParameter := aString asString.
currentQuery := #selectorName.
autoSelectString := aString.
self setMethodListFromSearchString.
^ true!
Item was changed:
----- Method: Lexicon>>lastSendersSearchSelector (in category 'search') -----
lastSendersSearchSelector
"Answer the last senders search selector, initializing it to a default value if it does not already have a value"
^ currentQueryParameter ifNil: [currentQueryParameter := #flag:]!
Item was changed:
----- Method: Lexicon>>limitClass: (in category 'limit class') -----
limitClass: aClass
"Set the most generic class to show as indicated"
limitClass := aClass!
Item was changed:
----- Method: Lexicon>>limitClassString (in category 'limit class') -----
limitClassString
"Answer a string representing the current choice of most-generic-class-to-show"
| most |
(most := self limitClass) == ProtoObject
ifTrue: [^ 'All'].
most == targetClass
ifTrue: [^ most name].
^ 'Only through ', most name!
Item was changed:
----- Method: Lexicon>>messageListIndex: (in category 'basic operation') -----
messageListIndex: anIndex
"Set the message list index as indicated, and update the history list if appropriate"
| newSelector current |
current := self selectedMessageName.
super messageListIndex: anIndex.
anIndex = 0 ifTrue: [
self editSelection: #newMessage.
self contentsChanged].
(newSelector := self selectedMessageName) ifNotNil:
[self updateSelectorsVisitedfrom: current to: newSelector]!
Item was changed:
----- Method: Lexicon>>methodListFromSearchString: (in category 'search') -----
methodListFromSearchString: fragment
"Answer a method list of methods whose selectors match the given fragment"
| aList searchFor |
currentQueryParameter := fragment.
currentQuery := #selectorName.
autoSelectString := fragment.
searchFor := fragment asString asLowercase withBlanksTrimmed.
aList := targetClass allSelectors select:
[:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
searchFor size > 0 ifTrue:
[aList := aList select:
[:aSelector | aSelector includesSubstring: searchFor caseSensitive: false]].
^ aList asSortedArray
!
Item was changed:
----- Method: Lexicon>>methodsWithInitials: (in category 'within-tool queries') -----
methodsWithInitials: initials
"Return a list of selectors representing methods whose timestamps have the given initials and which are in the protocol of this object and within the range dictated by my limitClass."
| classToUse |
classToUse := self targetObject ifNotNil: [self targetObject class] ifNil: [targetClass]. "In support of lightweight uniclasses"
^ targetClass allSelectors select:
[:aSelector | (currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: classToUse limitClass: limitClass) and:
[Utilities doesMethod: aSelector forClass: classToUse bearInitials: initials]].
!
Item was changed:
----- Method: Lexicon>>newCategoryPane (in category 'category list') -----
newCategoryPane
"Formulate a category pane for insertion into the receiver's pane list"
| aListMorph |
aListMorph := PluggableListMorph on: self list: #categoryList
selected: #categoryListIndex changeSelected: #categoryListIndex:
menu: #categoryListMenu:shifted:
keystroke: #categoryListKey:from:.
aListMorph setNameTo: 'categoryList'.
aListMorph menuTitleSelector: #categoryListMenuTitle.
^ aListMorph!
Item was changed:
----- Method: Lexicon>>preserveSelectorIfPossibleSurrounding: (in category 'transition') -----
preserveSelectorIfPossibleSurrounding: aBlock
"Make a note of the currently-selected method; perform aBlock and then attempt to reestablish that same method as the selected one in the new circumstances"
| aClass aSelector |
aClass := self selectedClassOrMetaClass.
aSelector := self selectedMessageName.
aBlock value.
self hasSearchPane
ifTrue:
[self setMethodListFromSearchString]
ifFalse:
[self maybeReselectClass: aClass selector: aSelector]!
Item was changed:
----- Method: Lexicon>>reformulateCategoryList (in category 'category list') -----
reformulateCategoryList
"Reformulate the category list"
categoryList := nil.
self categoryListIndex: 0.
self changed: #categoryList.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>removeFromSelectorsVisited (in category 'history') -----
removeFromSelectorsVisited
"Remove the currently-selected method from the active set"
| aSelector |
(aSelector := self selectedMessageName) ifNil: [^ self].
self removeFromSelectorsVisited: aSelector.
self chooseCategory: self class viewedCategoryName!
Item was changed:
----- Method: Lexicon>>removeMessage (in category 'menu commands') -----
removeMessage
"Remove the selected message from the system."
messageListIndex = 0 ifTrue: [^ self].
self okToChange ifFalse: [^ self].
super removeMessage.
"my #reformulateList method, called from the super #removeMethod method, will however try to preserve the selection, so we take pains to clobber it by the below..."
messageListIndex := 0.
self changed: #messageList.
self changed: #messageListIndex.
contents := nil.
self contentsChanged!
Item was changed:
----- Method: Lexicon>>retainMethodSelectionWhileSwitchingToCategory: (in category 'transition') -----
retainMethodSelectionWhileSwitchingToCategory: aCategoryName
"retain method selection while switching the category-pane selection to show the category of the given name"
| aSelectedName |
aSelectedName := self selectedMessageName.
self categoryListIndex: (categoryList indexOf: aCategoryName ifAbsent: [^ self]).
aSelectedName ifNotNil: [self selectWithinCurrentCategory: aSelectedName]
!
Item was changed:
----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') -----
selectSelectorItsNaturalCategory: aSelector
"Make aSelector be the current selection of the receiver, with the category being its home category."
| cat catIndex detectedItem |
cat := self categoryOfSelector: aSelector.
catIndex := categoryList indexOf: cat ifAbsent:
["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category"
1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') -----
selectWithinCurrentCategory: aSelector
"If aSelector is one of the selectors seen in the current category, select it"
| detectedItem |
detectedItem := self messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])!
Item was changed:
----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') -----
selectWithinCurrentCategoryIfPossible: aSelector
"If the receiver's message list contains aSelector, navigate right to it without changing categories"
| detectedItem messageIndex |
aSelector ifNil: [^ self].
detectedItem := messageList detect:
[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>selectorsMatching (in category 'search') -----
selectorsMatching
"Anwer a list of selectors in the receiver that match the current search string"
| fragment aList |
fragment := self lastSearchString asLowercase.
aList := targetClass allSelectors select:
[:aSelector | (aSelector includesSubstring: fragment caseSensitive: false) and:
[currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]].
^ aList asSortedArray!
Item was changed:
----- Method: Lexicon>>selectorsVisited (in category 'history') -----
selectorsVisited
"Answer the list of selectors visited in this tool"
^ selectorsVisited ifNil: [selectorsVisited := OrderedCollection new]!
Item was changed:
----- Method: Lexicon>>setLocalClassVarRefs (in category 'within-tool queries') -----
setLocalClassVarRefs
"Put up a list of the class variables in the viewed object, and when the user selects one, let the query results category show all the references to that class variable."
| aName |
(aName := targetClass theNonMetaClass chooseClassVarName) ifNil: [^ self].
currentQuery := #classVarRefs.
currentQueryParameter := aName.
self showQueryResultsCategory!
Item was changed:
----- Method: Lexicon>>setToShowSelector: (in category 'selection') -----
setToShowSelector: aSelector
"Set up the receiver so that it will show the given selector"
| catName catIndex detectedItem messageIndex aList |
catName := (aList := currentVocabulary categoriesContaining: aSelector forClass: targetClass) size > 0
ifTrue:
[aList first]
ifFalse:
[self class allCategoryName].
catIndex := categoryList indexOf: catName ifAbsent: [1].
self categoryListIndex: catIndex.
detectedItem := messageList detect:
[:anItem | (anItem upTo: $ ) asString asSymbol == aSelector] ifNone: [^ self].
messageIndex := messageList indexOf: detectedItem.
self messageListIndex: messageIndex
!
Item was changed:
----- Method: Lexicon>>showCategoriesPane (in category 'category list') -----
showCategoriesPane
"Show the categories pane instead of the search pane"
| aPane |
(aPane := self searchPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newCategoryPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>showHomeCategory (in category 'menu commands') -----
showHomeCategory
"Continue to show the current selector, but show it within the context of its primary category"
| aSelector |
(aSelector := self selectedMessageName) ifNotNil:
[self preserveSelectorIfPossibleSurrounding:
[self setToShowSelector: aSelector]]!
Item was changed:
----- Method: Lexicon>>showMethodsInCurrentChangeSet (in category 'within-tool queries') -----
showMethodsInCurrentChangeSet
"Set the current query to be for methods in the current change set"
currentQuery := #currentChangeSet.
autoSelectString := nil.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).!
Item was changed:
----- Method: Lexicon>>showMethodsWithInitials: (in category 'within-tool queries') -----
showMethodsWithInitials: initials
"Make the current query be for methods stamped with the given initials"
currentQuery := #methodsWithInitials.
currentQueryParameter := initials.
self showQueryResultsCategory.
autoSelectString := nil.
self changed: #messageList.
self adjustWindowTitle
!
Item was changed:
----- Method: Lexicon>>showQueryResultsCategory (in category 'within-tool queries') -----
showQueryResultsCategory
"Point the receiver at the query-results category and set the search string accordingly"
autoSelectString := self currentQueryParameter.
self categoryListIndex: (categoryList indexOf: self class queryCategoryName).
self messageListIndex: 0!
Item was changed:
----- Method: Lexicon>>showSearchPane (in category 'search') -----
showSearchPane
"Given that the receiver is showing the categories pane, replace that with a search pane. Though there is a residual UI for obtaining this variant, it is obscure and the integrity of the protocol-category-browser when there is no categories pane is not necessarily assured at the moment."
| aPane |
(aPane := self categoriesPane) ifNil: [^ Beeper beep].
self containingWindow replacePane: aPane with: self newSearchPane.
categoryList := nil.
self changed: #categoryList.
self changed: #messageList!
Item was changed:
----- Method: Lexicon>>useVocabulary: (in category 'vocabulary') -----
useVocabulary: aVocabulary
"Set up the receiver to use the given vocabulary"
currentVocabulary := aVocabulary!
Item was changed:
----- Method: MethodCall>>evaluate (in category 'evaluation') -----
evaluate
"Evaluate the receiver, and if value has changed, signal value-changed"
| result |
result := arguments isEmptyOrNil
ifTrue: [self receiver perform: selector]
ifFalse: [self receiver perform: selector withArguments: arguments asArray].
timeStamp := Time dateAndTimeNow.
result ~= lastValue ifTrue:
[lastValue := result.
self changed: #value]
!
Item was changed:
----- Method: MethodCall>>methodInterface (in category 'method interface') -----
methodInterface
"Answer the receiver's methodInterface, conjuring one up on the spot (and remembering) if not present"
^ methodInterface ifNil:
[methodInterface := self ephemeralMethodInterface]!
Item was changed:
----- Method: MethodCall>>methodInterface: (in category 'method interface') -----
methodInterface: anInterface
"Set my methodInterface"
methodInterface := anInterface!
Item was changed:
----- Method: MethodCall>>receiver:methodInterface: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface
"Initialize me to have the given receiver and methodInterface"
| aResultType |
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := aMethodInterface defaultArguments.
self flag: #noteToTed.
"the below can't really survive, I know. The intent is that if the method has a declared result type, we want the preferred readout type to be able to handle the initial #lastValue even if the MethodCall has not been evaluated yet; thus we'd rather have a boolean value such as true rather than a nil here if we're showing a boolean readout such as a checkbox, and likewise for color-valued and numeric-valued readouts etc, "
(aResultType := methodInterface resultType) ~~ #unknown ifTrue:
[lastValue := (Vocabulary vocabularyForType: aResultType) initialValueForASlotFor: aReceiver] !
Item was changed:
----- Method: MethodCall>>receiver:methodInterface:initialArguments: (in category 'initialization') -----
receiver: aReceiver methodInterface: aMethodInterface initialArguments: initialArguments
"Set up a method-call for the given receiver, method-interface, and initial arguments"
receiver := aReceiver.
selector := aMethodInterface selector.
methodInterface := aMethodInterface.
arguments := initialArguments ifNotNil: [initialArguments asArray]
!
Item was changed:
----- Method: MethodCall>>setArgumentNamed:toValue: (in category 'argument access') -----
setArgumentNamed: aName toValue: aValue
"Set the argument of the given name to the given value"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
anIndex > 0
ifTrue:
[arguments at: anIndex put: aValue]
ifFalse:
[self error: 'argument missing'].
self changed: #argumentValue!
Item was changed:
----- Method: MethodCall>>valueOfArgumentNamed: (in category 'initialization') -----
valueOfArgumentNamed: aName
"Answer the value of the given arguement variable"
| anIndex |
anIndex := self methodInterface argumentVariables findFirst:
[:aVariable | aVariable variableName = aName].
^ anIndex > 0
ifTrue:
[arguments at: anIndex]
ifFalse:
[self error: 'variable not found']!
Item was changed:
----- Method: MethodInterface>>argumentVariables (in category 'initialization') -----
argumentVariables
"Answer the list of argumentVariables of the interface"
^ argumentVariables ifNil: [argumentVariables := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>argumentVariables: (in category 'initialization') -----
argumentVariables: variableList
"Set the argument variables"
argumentVariables := variableList!
Item was changed:
----- Method: MethodInterface>>attributeKeywords (in category 'attribute keywords') -----
attributeKeywords
"Answer a list of attribute keywords associated with the receiver"
^ attributeKeywords ifNil: [attributeKeywords := OrderedCollection new]!
Item was changed:
----- Method: MethodInterface>>conjuredUpFor:class: (in category 'initialization') -----
conjuredUpFor: aSelector class: aClass
"Initialize the receiver to have the given selector, obtaining whatever info one can from aClass. This basically covers the situation where no formal definition has been made."
| parts |
self initializeFor: aSelector.
self wording: aSelector.
receiverType := #unknown.
parts := aClass formalHeaderPartsFor: aSelector.
argumentVariables := (1 to: selector numArgs) collect:
[:anIndex | Variable new name: (parts at: (4 * anIndex)) type: #Object].
parts last isEmptyOrNil ifFalse: [self documentation: parts last].
!
Item was changed:
----- Method: MethodInterface>>defaultStatus: (in category 'status') -----
defaultStatus: aStatus
"Set the receiver's defaultStatus as indicated"
defaultStatus := aStatus!
Item was changed:
----- Method: MethodInterface>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver"
super initialize.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal.
argumentVariables := OrderedCollection new
!
Item was changed:
----- Method: MethodInterface>>initializeFor: (in category 'initialization') -----
initializeFor: aSelector
"Initialize the receiver to have the given selector"
selector := aSelector.
attributeKeywords := OrderedCollection new.
defaultStatus := #normal
!
Item was changed:
----- Method: MethodInterface>>initializeSetterFromEToySlotSpec: (in category 'initialization') -----
initializeSetterFromEToySlotSpec: tuple
"tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to represent the getter of this item"
selector := tuple ninth.
self
wording: ('set ', tuple second);
helpMessage: ('setter for', tuple third).
receiverType := #Player.
argumentVariables := Array with: (Variable new variableType: tuple fourth)
!
Item was changed:
----- Method: MethodInterface>>receiverType (in category 'access') -----
receiverType
"Answer the receiver type"
^ receiverType ifNil: [receiverType := #unknown]!
Item was changed:
----- Method: MethodInterface>>receiverType: (in category 'initialization') -----
receiverType: aType
"set the receiver type. Whether the receiverType earns its keep here is not yet well understood. At the moment, this is unsent"
receiverType := aType!
Item was changed:
----- Method: MethodInterface>>resultType: (in category 'initialization') -----
resultType: aType
"Set the receiver's resultSpecification to be a ResultType of the given type"
resultSpecification := ResultSpecification new.
resultSpecification resultType: aType!
Item was changed:
----- Method: MethodInterface>>selector:type:setter: (in category 'attribute keywords') -----
selector: aSelector type: aType setter: aSetter
"Set the receiver's fields as indicated. Values of nil or #none for the result type and the setter indicate that there is none"
selector := aSelector.
(MethodInterface isNullMarker: aType) ifFalse:
[resultSpecification := ResultSpecification new.
resultSpecification resultType: aType.
(MethodInterface isNullMarker: aSetter) ifFalse:
[resultSpecification companionSetterSelector: aSetter]]!
Item was changed:
----- Method: MethodInterface>>typeForArgumentNumber: (in category 'access') -----
typeForArgumentNumber: anArgumentNumber
"Answer the data type for the given argument number"
| aVariable |
aVariable := self argumentVariables at: anArgumentNumber.
^ aVariable variableType!
Item was changed:
----- Method: ObjectWithDocumentation>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
authoringStamp := Utilities changeStampPerSe
!
Item was changed:
----- Method: ObjectWithDocumentation>>legacyHelpMessage (in category 'accessing') -----
legacyHelpMessage
"If I have a help message stashed in my legacy naturalTranslations slot, answer its translated rendition, else answer nil. If I *do* come across a legacy help message, transfer it to my properties dictionary."
| untranslated |
naturalLanguageTranslations isEmptyOrNil "only in legacy (pre-3.8) projects"
ifTrue: [^ nil].
untranslated := naturalLanguageTranslations first helpMessage ifNil: [^ nil].
self propertyAt: #helpMessage put: untranslated.
naturalLanguageTranslations removeFirst.
naturalLanguageTranslations isEmpty ifTrue: [naturalLanguageTranslations := nil].
^ untranslated translated!
Item was changed:
----- Method: ProtocolBrowser>>setClassAndSelectorIn: (in category 'private') -----
setClassAndSelectorIn: csBlock
"Decode strings of the form <selectorName> (<className> [class])"
| i classAndSelString selString sel |
sel := self selection ifNil: [^ csBlock value: nil value: nil].
(sel isKindOf: MethodReference) ifTrue: [
sel setClassAndSelectorIn: csBlock
] ifFalse: [
selString := sel asString.
i := selString indexOf: $(.
"Rearrange to <className> [class] <selectorName> , and use MessageSet"
classAndSelString := (selString copyFrom: i + 1 to: selString size - 1) , ' ' ,
(selString copyFrom: 1 to: i - 1) withoutTrailingBlanks.
MessageSet parse: classAndSelString toClassAndSelector: csBlock.
].
!
Item was changed:
----- Method: ResultSpecification>>companionSetterSelector: (in category 'companion setter') -----
companionSetterSelector: aSetterSelector
"Set the receiver's companionSetterSelector as indicated"
companionSetterSelector := aSetterSelector!
Item was changed:
----- Method: ResultSpecification>>refetchFrequency: (in category 'refetch') -----
refetchFrequency: aFrequency
"Set the refetch frequency"
refetchFrequency := aFrequency!
Item was changed:
----- Method: ResultSpecification>>resultType: (in category 'result type') -----
resultType: aType
"Set the receiver's resultType as specified"
type := aType!
Item was changed:
----- Method: ScreenedVocabulary>>categoryScreeningBlock: (in category 'initialization') -----
categoryScreeningBlock: aBlock
"Set the receiver's categoryScreeningBlock to the block provided"
categoryScreeningBlock := aBlock!
Item was changed:
----- Method: ScreenedVocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #Public.
self documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'!
Item was changed:
----- Method: ScreenedVocabulary>>methodScreeningBlock: (in category 'initialization') -----
methodScreeningBlock: aBlock
"Set the receiver's methodScreeningBlock to the block provided"
methodScreeningBlock := aBlock!
Item was changed:
----- Method: SymbolListType>>symbols: (in category 'tiles') -----
symbols: symbolList
"Set the receiver's list of symbols as indicated"
symbols := symbolList!
Item was changed:
----- Method: UnknownType>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unknown!
Item was changed:
----- Method: Variable>>name:type: (in category 'name') -----
name: aName type: aType
"Set the variable's name and type as indicated"
variableName := aName.
variableType := aType!
Item was changed:
----- Method: Variable>>sample (in category 'value') -----
sample
"The closest we can come to an object for our type"
| ty clsName |
self defaultValue ifNotNil: [^ self defaultValue].
ty := self variableType.
"How translate a type like #player into a class?"
clsName := ty asString.
clsName at: 1 put: (clsName first asUppercase).
clsName := clsName asSymbol.
(Smalltalk includesKey: clsName) ifFalse: [self error: 'What type is this?'. ^ 5].
^ (Smalltalk at: clsName) initializedInstance!
Item was changed:
----- Method: Variable>>variableType: (in category 'type') -----
variableType: aType
"Set the receiver's variable type as requested"
variableType := aType!
Item was changed:
----- Method: Vocabulary class>>allStandardVocabularies (in category 'standard vocabulary access') -----
allStandardVocabularies
"Answer a list of the currently-defined vocabularies in my AllStandardVocabularies list"
"Vocabulary allStandardVocabularies"
^AllStandardVocabularies ifNil: [AllStandardVocabularies := IdentityDictionary new].
!
Item was changed:
----- Method: Vocabulary class>>newPublicVocabulary (in category 'universal vocabularies') -----
newPublicVocabulary
| aVocabulary |
"Answer a public vocabulary"
aVocabulary := ScreenedVocabulary new.
aVocabulary vocabularyName: #Public.
aVocabulary documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'.
aVocabulary categoryScreeningBlock: [:aCategoryName | (aCategoryName beginsWith: 'private') not].
aVocabulary methodScreeningBlock: [:aSelector |
((aSelector beginsWith: 'private') or: [aSelector beginsWith: 'pvt']) not].
^ aVocabulary
!
Item was changed:
----- Method: Vocabulary class>>newQuadVocabulary (in category 'testing and demo') -----
newQuadVocabulary
"Answer a Quad vocabulary -- something to mess with, to illustrate and explore ideas. Applies to Quadrangles only."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Quad.
aVocabulary documentation: 'A highly restricted test vocabulary that can be used with Quadrangle objects'.
aVocabulary initializeFromTable: #(
(borderColor borderColor: () Color (basic color) 'The color of the border' unused updating)
(borderWidth borderWidth: () Number (basic geometry) 'The width of the border' unused updating)
(insideColor insideColor: () Color (basic color) 'The color of the quadrangle' unused updating)
(display none () none (basic display) 'Display the quadrangle directly on the screen')
(width none () Number (geometry) 'The width of the object' unused updating)
(left setLeft: () Number (geometry) 'The left edge' unused updating)
(right setRight: () Number (geometry) 'The right edge' unused updating)
(width setWidth: () Number (geometry) 'The width of the object' unused updating)
(height setHeight: () Number (geometry) 'The height of the object' unused updating)
(hasPositiveExtent none () Boolean (tests) 'Whether the corner is to the lower-right of the origin' unused updating)
(isTall none () Boolean (tests) 'Whether the height is greater than the width' unused updating)).
^ aVocabulary
"Vocabulary initialize"
"Quadrangle exampleInViewer"!
Item was changed:
----- Method: Vocabulary class>>newTestVocabulary (in category 'testing and demo') -----
newTestVocabulary
"Answer a Test vocabulary -- something to mess with, to illustrate and explore ideas."
| aVocabulary |
aVocabulary := Vocabulary new vocabularyName: #Test.
aVocabulary documentation: 'An illustrative vocabulary for testing'.
aVocabulary initializeFromTable: #(
(isKindOf: none ((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass')
(class none none Class (#'class membership' wimpy) 'answer the the class to which the receiver belongs')
(respondsTo: none ((aSelector Symbol)) Boolean (#'class membership') 'answer whether the receiver responds to the given selector')
(as: none ((aClass Class)) Object (conversion) 'answer the receiver converted to be a member of aClass')).
^ aVocabulary
"
#((#'class membership' 'Whether an object can respond to a given message, etc.' (isKindOf: class respondsTo:))
(conversion 'Messages to convert from one kind of object to another' (as: asString))
(copying 'Messages for making copies of objects' (copy copyFrom:))
(equality 'Testing whether two objects are equal' ( = ~= == ~~))
(dependents 'Support for dependency notification' (addDependent: removeDependent: release))) do:
[:item |
aMethodCategory := ElementCategory new categoryName: item first.
aMethodCategory documentation: item second.
item third do:
[:aSelector |
aMethodInterface := MethodInterface new initializeFor: aSelector.
aVocabulary atKey: aSelector putMethodInterface: aMethodInterface.
aMethodCategory elementAt: aSelector put: aMethodInterface].
aVocabulary addCategory: aMethodCategory]."
!
Item was changed:
----- Method: Vocabulary class>>vocabularyForClass: (in category 'type vocabularies') -----
vocabularyForClass: aClass
"Answer the standard vocabulary for that class. Create it if not present and init message exists. Answer nil if none exists and no init message present."
| initMsgName newTypeVocab |
(self allStandardVocabularies includesKey: aClass name)
ifTrue: [^self allStandardVocabularies at: aClass name].
initMsgName := ('new', aClass name, 'Vocabulary') asSymbol.
^(self respondsTo: initMsgName)
ifTrue: [
newTypeVocab := self perform: initMsgName.
self addStandardVocabulary: newTypeVocab.
newTypeVocab]
ifFalse: [nil]!
Item was changed:
----- Method: Vocabulary class>>vocabularyForType: (in category 'type vocabularies') -----
vocabularyForType: aType
"Answer a vocabulary appropriate to the given type, which is normally going to be a symbol such as #Number or #Color. Answer the Unknown vocabulary as a fall-back"
| ucSym |
(aType isKindOf: Vocabulary) ifTrue: [^ aType].
ucSym := aType capitalized asSymbol.
^self allStandardVocabularies at: ucSym ifAbsent: [self vocabularyNamed: #unknown]!
Item was changed:
----- Method: Vocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'queries') -----
allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
"Answer a list of all methods in the etoy interface which are in the given category, on behalf of aClass and possibly anObject. Note that there is no limitClass at play here."
| aCategory |
categoryName ifNil: [^ OrderedCollection new].
categoryName = self allCategoryName ifTrue:
[^ methodInterfaces collect: [:anInterface | anInterface selector]].
aCategory := categories detect: [:cat | cat categoryName == categoryName asSymbol] ifNone: [^ OrderedCollection new].
^ aCategory elementsInOrder collect: [:anElement | anElement selector] thenSelect:
[:aSelector | aClass canUnderstand: aSelector]!
Item was changed:
----- Method: Vocabulary>>categoryWordingAt: (in category 'queries') -----
categoryWordingAt: aSymbol
"Answer the wording for the category at the given symbol"
| result |
result := self categoryAt: aSymbol.
^result
ifNotNil: [result wording]
ifNil: [aSymbol]!
Item was changed:
----- Method: Vocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
"Answer whether the vocabulary includes the given selector for the given class (and instance, if provided), only considering method implementations in mostGenericClass and lower"
| classToUse aClass |
(methodInterfaces includesKey: aSelector) ifFalse: [^ false].
classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
^ (aClass := classToUse whichClassIncludesSelector: aSelector)
ifNil:
[false]
ifNotNil:
[(aClass includesBehavior: mostGenericClass) and:
[(self someCategoryThatIncludes: aSelector) notNil]]
!
Item was changed:
----- Method: Vocabulary>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
super initialize.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new!
Item was changed:
----- Method: Vocabulary>>initializeFor: (in category 'initialization') -----
initializeFor: anObject
"Initialize the receiver to bear a vocabulary suitable for anObject"
object := anObject.
vocabularyName := #unnamed.
categories := OrderedCollection new.
methodInterfaces := IdentityDictionary new.
self documentation: 'A vocabulary that has not yet been documented'.
!
Item was changed:
----- Method: Vocabulary>>renameCategoryFrom:to: (in category 'initialization') -----
renameCategoryFrom: oldName to: newName
"Rename the category currently known by oldName to be newName. No senders at present but once a UI is establshed for renaming categories, this will be useful."
| aCategory |
(aCategory := self categoryAt: oldName) ifNil: [^ self].
aCategory categoryName: newName!
Item was changed:
----- Method: Vocabulary>>vocabularyName: (in category 'initialization') -----
vocabularyName: aName
"Set the name of the vocabulary as indicated"
vocabularyName := aName!
1
0