[Pkg] The Trunk: Tools-nice.151.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Dec 27 02:34:49 UTC 2009
Nicolas Cellier uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-nice.151.mcz
==================== Summary ====================
Name: Tools-nice.151
Author: nice
Time: 27 December 2009, 3:34:27 am
UUID: a4e5ff96-0f2c-4d7e-bca4-cc86fce42a0b
Ancestors: Tools-nice.150
Cosmetic: move or remove a few temps inside closures
=============== Diff against Tools-nice.150 ===============
Item was changed:
----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
buildNotifierWith: builder label: label message: messageString
+ | windowSpec listSpec textSpec panelSpec quads |
- | windowSpec listSpec textSpec panelSpec buttonSpec quads |
windowSpec := builder pluggableWindowSpec new.
windowSpec model: self.
windowSpec extent: 450 @ 156. "nice and wide to show plenty of the error msg"
windowSpec label: label.
windowSpec children: OrderedCollection new.
panelSpec := builder pluggablePanelSpec new.
panelSpec children: OrderedCollection new.
quads := self preDebugButtonQuads.
(self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
quads := quads copyWith:
{ 'Create'. #createMethod. #magenta. 'create the missing method' }
].
+ quads do:[:spec| | buttonSpec |
- quads do:[:spec|
buttonSpec := builder pluggableButtonSpec new.
buttonSpec model: self.
buttonSpec label: spec first.
buttonSpec action: spec second.
buttonSpec help: spec fourth.
panelSpec children add: buttonSpec.
].
panelSpec layout: #horizontal. "buttons"
panelSpec frame: (0 at 0 corner: 1 at 0.2).
windowSpec children add: panelSpec.
Preferences eToyFriendly | messageString notNil ifFalse:[
listSpec := builder pluggableListSpec new.
listSpec
model: self;
list: #contextStackList;
getIndex: #contextStackIndex;
setIndex: #debugAt:;
frame: (0 at 0.2 corner: 1 at 1).
windowSpec children add: listSpec.
] ifTrue:[
message := messageString.
textSpec := builder pluggableTextSpec new.
textSpec
model: self;
getText: #preDebugMessageString;
setText: nil;
selection: nil;
menu: #debugProceedMenu:;
frame: (0 at 0.2corner: 1 at 1).
windowSpec children add: textSpec.
].
^windowSpec!
Item was changed:
----- Method: ArchiveViewer>>createButtonBar (in category 'initialization') -----
createButtonBar
+ | bar narrowFont registeredFonts |
- | bar button narrowFont registeredFonts |
registeredFonts := OrderedCollection new.
TextStyle knownTextStylesWithoutDefault do:
[:st | (TextStyle named: st) fonts do: [:f | registeredFonts addLast: f]].
narrowFont := registeredFonts detectMin:
[:ea | ea widthOfString: 'Contents' from: 1 to: 8].
bar := AlignmentMorph newRow.
bar
color: self defaultBackgroundColor;
rubberBandCells: false;
vResizing: #shrinkWrap;
cellInset: 6 @ 0.
#(#('New\Archive' #canCreateNewArchive #createNewArchive 'Create a new, empty archive and discard this one') #('Load\Archive' #canOpenNewArchive #openNewArchive 'Open another archive and discard this one') #('Save\Archive As' #canSaveArchive #saveArchive 'Save this archive under a new name') #('Extract\All' #canExtractAll #extractAll 'Extract all this archive''s members into a directory') #('Add\File' #canAddMember #addMember 'Add a file to this archive') #('Add from\Clipboard' #canAddMember #addMemberFromClipboard 'Add the contents of the clipboard as a new file') #('Add\Directory' #canAddMember #addDirectory 'Add the entire contents of a directory, with all of its subdirectories') #('Extract\Member As' #canExtractMember #extractMember 'Extract the selected member to a file') #('Delete\Member' #canDeleteMember #deleteMember 'Remove the selected member from this archive') #('Rename\Member' #canRenameMember #renameMember 'Rename the selected member') #('View All\Contents' #canViewAllContents #changeViewAllContents 'Toggle the view of all the selected member''s contents'))
do:
[:arr |
+ | buttonLabel button |
- | buttonLabel |
buttonLabel := (TextMorph new)
string: arr first withCRs
fontName: narrowFont familyName
size: narrowFont pointSize
wrap: false;
hResizing: #shrinkWrap;
lock;
yourself.
(button := PluggableButtonMorph
on: self
getState: arr second
action: arr third)
vResizing: #shrinkWrap;
hResizing: #spaceFill;
onColor: self buttonOnColor offColor: self buttonOffColor;
label: buttonLabel;
setBalloonText: arr fourth.
bar addMorphBack: button.
buttonLabel composeToBounds].
^bar!
Item was changed:
----- Method: MessageSet>>filterToMessagesInSourcesFile (in category 'filtering') -----
filterToMessagesInSourcesFile
"Filter down only to messages whose source code resides in the .sources file."
+
+ self filterFrom: [:aClass :aSelector | | cm |
- | cm |
- self filterFrom: [:aClass :aSelector |
(aClass notNil and: [aSelector notNil]) and:
[(self class isPseudoSelector: aSelector) not and:
[(cm := aClass compiledMethodAt: aSelector ifAbsent: [nil]) notNil and:
[cm fileIndex == 1]]]]!
Item was changed:
----- Method: MessageSet>>filterToNotCurrentAuthor (in category 'filtering') -----
filterToNotCurrentAuthor
"Filter down only to messages not stamped with my initials"
+ | myInitials |
- | myInitials aMethod aTimeStamp |
(myInitials := Utilities authorInitialsPerSe) ifNil: [^ self inform: 'No author initials set in this image'].
self filterFrom:
+ [:aClass :aSelector | | aTimeStamp aMethod |
- [:aClass :aSelector |
(aClass notNil and: [aSelector notNil]) and:
[aMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil].
aMethod notNil and:
[(aTimeStamp := Utilities timeStampForMethod: aMethod) isNil or:
[(aTimeStamp beginsWith: myInitials) not]]]]!
Item was changed:
----- Method: ChangeList>>removeOlderMethodVersions (in category 'menu actions') -----
removeOlderMethodVersions
"Remove older versions of entries from the receiver."
+ | newChangeList newList found |
- | newChangeList newList found str |
newChangeList := OrderedCollection new.
newList := OrderedCollection new.
found := OrderedCollection new.
changeList reverseWith: list do:
+ [:chRec :strNstamp | | str | str := strNstamp copyUpTo: $;.
- [:chRec :strNstamp | str := strNstamp copyUpTo: $;.
(found includes: str)
ifFalse:
[found add: str.
newChangeList add: chRec.
newList add: strNstamp]].
newChangeList size < changeList size
ifTrue:
[changeList := newChangeList reversed.
list := newList reversed.
listIndex := 0.
listSelections := Array new: list size withAll: false].
self changed: #list!
Item was changed:
----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | tRect sRect columnScanner columnLeft |
- | tRect sRect columnRect columnScanner columnData columnLeft |
tRect := self toggleRectangle.
sRect := bounds withLeft: tRect right + 4.
self drawToggleOn: aCanvas in: tRect.
icon isNil ifFalse:[
aCanvas
translucentImage: icon
at: sRect left @ (self top + (self height - icon height // 2)).
sRect := sRect left: sRect left + icon width + 2.
].
(container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [
sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2.
aCanvas drawString: contents asString in: sRect font: self fontToUse color: color.
] ifFalse: [
columnLeft := sRect left.
columnScanner := ReadStream on: contents asString.
+ container columns do: [ :width | | columnRect columnData |
- container columns do: [ :width |
columnRect := columnLeft @ sRect top extent: width @ sRect height.
columnData := columnScanner upTo: Character tab.
columnData isEmpty ifFalse: [
aCanvas drawString: columnData in: columnRect font: self fontToUse color: color
.
].
columnLeft := columnRect right + 5.
].
]
!
Item was changed:
----- Method: FileContentsBrowser class>>browseCompressedCodeStream: (in category 'instance creation') -----
browseCompressedCodeStream: aStandardFileStream
"Browse the selected file in fileIn format."
+ | unzipped |
+ [ | zipped |zipped := GZipReadStream on: aStandardFileStream.
- | zipped unzipped |
- [zipped := GZipReadStream on: aStandardFileStream.
unzipped := MultiByteBinaryOrTextStream with: zipped contents asString]
ensure: [aStandardFileStream close].
unzipped reset.
self browseStream: unzipped named: aStandardFileStream name!
Item was changed:
----- Method: Lexicon>>selectorsSendingSelectedSelector (in category 'senders') -----
selectorsSendingSelectedSelector
"Assumes lastSendersSearchSelector is already set"
+ | selectorSet |
- | selectorSet sel cl |
autoSelectString := (self lastSendersSearchSelector upTo: $:) asString.
selectorSet := Set new.
(self systemNavigation allCallsOn: self lastSendersSearchSelector)
+ do: [:anItem | | sel cl |
- do: [:anItem |
sel := anItem methodSymbol.
cl := anItem actualClass.
((currentVocabulary
includesSelector: sel
forInstance: self targetObject
ofClass: targetClass
limitClass: limitClass)
and: [targetClass includesBehavior: cl])
ifTrue: [selectorSet add: sel]].
^ selectorSet asSortedArray!
Item was changed:
----- Method: MessageSet>>selectedMessage (in category 'contents') -----
selectedMessage
"Answer the source method for the currently selected message."
+
+ self setClassAndSelectorIn: [:class :selector | | source |
- | source |
- self setClassAndSelectorIn: [:class :selector |
class ifNil: [^ 'Class vanished'].
selector first isUppercase ifTrue:
[selector == #Comment ifTrue:
[currentCompiledMethod := class organization commentRemoteStr.
^ class comment].
selector == #Definition ifTrue:
[^ class definitionST80].
selector == #Hierarchy ifTrue: [^ class printHierarchy]].
source := class sourceMethodAt: selector ifAbsent:
[currentCompiledMethod := nil.
^ 'Missing'].
self showingDecompile ifTrue: [^ self decompiledSourceIntoContents].
currentCompiledMethod := class compiledMethodAt: selector ifAbsent: [nil].
self showingDocumentation ifTrue: [^ self commentContents].
source := self sourceStringPrettifiedAndDiffed.
^ source asText makeSelectorBoldIn: class]!
Item was changed:
----- Method: VersionsBrowser>>versionFrom: (in category 'menu') -----
versionFrom: secsSince1901
+
- | strings vTime |
"Return changeRecord of the version in effect at that time. Accept in the VersionsBrowser does not use this code."
+ changeList do: [:cngRec | | vTime strings |
- changeList do: [:cngRec |
(strings := cngRec stamp findTokens: ' ') size > 2 ifTrue: [
vTime := strings second asDate asSeconds +
strings third asTime asSeconds.
vTime <= secsSince1901 ifTrue: ["this one"
^ cngRec == changeList first ifTrue: [nil] ifFalse: [cngRec]]]].
"was not defined that early. Don't delete the method."
^ changeList last "earliest one may be OK" !
Item was changed:
----- Method: SelectorBrowser>>quickList (in category 'as yet unclassified') -----
quickList
"Compute the selectors for the single example of receiver and args, in the very top pane"
+ | data result resultArray dataStrings mf dataObjects aa statements |
- | data result resultArray newExp dataStrings mf dataObjects aa statements |
data := contents asString.
"delete t
railing period. This should be fixed in the Parser!!"
[data last isSeparator] whileTrue: [data := data allButLast].
data last = $. ifTrue: [data := data allButLast]. "Eval"
mf := MethodFinder new.
data := mf cleanInputs: data. "remove common mistakes"
dataObjects := Compiler evaluate: '{', data, '}'. "#( data1 data2 result )"
statements := (Compiler new parse: 'zort ' , data in: Object notifying: nil)
body statements select: [:each | (each isKindOf: ReturnNode) not].
dataStrings := statements collect:
[:node | String streamContents:
[:strm | (node isMessage) ifTrue: [strm nextPut: $(].
node shortPrintOn: strm.
(node isMessage) ifTrue: [strm nextPut: $)].]].
dataObjects size < 2 ifTrue: [self inform: 'If you are giving an example of receiver, \args, and result, please put periods between the parts.\Otherwise just type one selector fragment' withCRs. ^#()].
dataObjects := Array with: dataObjects allButLast with: dataObjects last. "#( (data1
data2) result )"
result := mf load: dataObjects; findMessage.
(result first beginsWith: 'no single method') ifFalse: [
aa := self testObjects: dataObjects strings: dataStrings.
dataObjects := aa second. dataStrings := aa third].
resultArray := self listFromResult: result.
resultArray isEmpty ifTrue: [self inform: result first].
dataStrings size = (dataObjects first size + 1) ifTrue:
+ [resultArray := resultArray collect: [:expression | | newExp |
- [resultArray := resultArray collect: [:expression |
newExp := expression.
dataObjects first withIndexDo: [:lit :i |
newExp := newExp copyReplaceAll: 'data', i printString
with: (dataStrings at: i)].
newExp, ' --> ', dataStrings last]].
^ resultArray!
Item was changed:
----- Method: ChangeList>>selectNewMethods (in category 'menu actions') -----
selectNewMethods
"Selects all method definitions for which there is no counterpart method in the current image"
+
- | change class |
Cursor read showWhile:
+ [ | change class |1 to: changeList size do:
- [1 to: changeList size do:
[:i | change := changeList at: i.
listSelections at: i put:
((change type = #method and:
[((class := change methodClass) isNil) or:
[(class includesSelector: change methodSelector) not]]))]].
self changed: #allSelections!
Item was changed:
----- Method: ChangeList class>>browseCompressedChangesFile: (in category 'fileIn/Out') -----
browseCompressedChangesFile: fullName
"Browse the selected file in fileIn format."
+ | unzipped stream |
- | zipped unzipped stream |
fullName ifNil: [^Beeper beep].
stream := FileStream readOnlyFileNamed: fullName.
+ [ | zipped |stream converter: Latin1TextConverter new.
- [stream converter: Latin1TextConverter new.
zipped := GZipReadStream on: stream.
unzipped := zipped contents asString]
ensure: [stream close].
stream := (MultiByteBinaryOrTextStream with: unzipped) reset.
ChangeList browseStream: stream!
Item was changed:
----- Method: ChangeList>>selectAllConflicts (in category 'menu actions') -----
selectAllConflicts
"Selects all method definitions in the receiver which are also in any existing change set in the system. This makes no statement about whether the content of the methods differ, only whether there is a change represented."
+
- | aClass aChange |
Cursor read showWhile:
+ [ | aClass aChange |1 to: changeList size do:
- [1 to: changeList size do:
[:i | aChange := changeList at: i.
listSelections at: i put:
(aChange type = #method
and: [(aClass := aChange methodClass) notNil
and: [ChangesOrganizer doesAnyChangeSetHaveClass: aClass andSelector: aChange methodSelector]])]].
self changed: #allSelections!
Item was changed:
----- Method: Lexicon>>buildCustomButtonsWith: (in category 'toolbuilder') -----
buildCustomButtonsWith: builder
"This method if very similar to StringHolder>>buildOptionalButtonsWith:.
Refactor and pass in button specs?"
+ | panelSpec |
- | panelSpec buttonSpec |
panelSpec := builder pluggablePanelSpec new.
panelSpec children: OrderedCollection new.
+ self customButtonSpecs do: [:spec | | buttonSpec |
- self customButtonSpecs do: [:spec |
buttonSpec := builder pluggableActionButtonSpec new.
buttonSpec model: self.
buttonSpec label: spec first.
buttonSpec action: spec second.
spec size > 2 ifTrue: [buttonSpec help: spec third].
panelSpec children add: buttonSpec.
].
panelSpec layout: #horizontal. "buttons"
self addSpecialButtonsTo: panelSpec with: builder.
^panelSpec!
Item was changed:
----- Method: MessageSet>>sortByDate (in category 'message list') -----
sortByDate
"Sort the message-list by date of time-stamp"
+ | assocs inOrder |
- | assocs aCompiledMethod aDate inOrder |
assocs := messageList collect:
+ [:aRef | | aDate aCompiledMethod |
- [:aRef |
aDate := aRef methodSymbol == #Comment
ifTrue:
[aRef actualClass organization dateCommentLastSubmitted]
ifFalse:
[aCompiledMethod := aRef actualClass compiledMethodAt: aRef methodSymbol ifAbsent: [nil].
aCompiledMethod ifNotNil: [aCompiledMethod dateMethodLastSubmitted]].
aRef -> (aDate ifNil: [Date fromString: '01/01/1996'])]. "The dawn of Squeak history"
inOrder := assocs asSortedCollection:
[:a :b | a value < b value].
messageList := inOrder asArray collect: [:assoc | assoc key].
self changed: #messageList!
Item was changed:
----- Method: ChangeList>>selectConflicts: (in category 'menu actions') -----
selectConflicts: changeSetOrList
"Selects all method definitions for which there is ALSO an entry in the specified changeSet or changList"
+ | systemChanges |
- | change class systemChanges |
Cursor read showWhile:
+ [ | change class |(changeSetOrList isKindOf: ChangeSet) ifTrue: [
- [(changeSetOrList isKindOf: ChangeSet) ifTrue: [
1 to: changeList size do:
[:i | change := changeList at: i.
listSelections at: i put:
(change type = #method
and: [(class := change methodClass) notNil
and: [(changeSetOrList atSelector: change methodSelector
class: class) ~~ #none]])]]
ifFalse: ["a ChangeList"
1 to: changeList size do:
[:i | change := changeList at: i.
listSelections at: i put:
(change type = #method
and: [(class := change methodClass) notNil
and: [changeSetOrList list includes: (list at: i)]])]]
].
self changed: #allSelections!
Item was changed:
----- Method: MessageSet>>filterToMessagesInChangesFile (in category 'filtering') -----
filterToMessagesInChangesFile
"Filter down only to messages whose source code risides in the Changes file. This allows one to ignore long-standing methods that live in the .sources file."
+
- | cm |
self filterFrom:
+ [:aClass :aSelector | | cm |
- [:aClass :aSelector |
aClass notNil and: [aSelector notNil and:
[(self class isPseudoSelector: aSelector) not and:
[(cm := aClass compiledMethodAt: aSelector ifAbsent: [nil]) notNil and:
[cm fileIndex ~~ 1]]]]]!
Item was changed:
----- Method: MessageSet>>filterToNotSendersOf (in category 'filtering') -----
filterToNotSendersOf
"Filter the receiver's list down to only those items which do not send a given selector"
+ | aFragment inputWithBlanksTrimmed |
- | aFragment inputWithBlanksTrimmed aMethod |
aFragment := UIManager default request: 'type selector:' initialAnswer: ''.
aFragment isEmptyOrNil ifTrue: [^ self].
inputWithBlanksTrimmed := aFragment withBlanksTrimmed.
Symbol hasInterned: inputWithBlanksTrimmed ifTrue:
[:aSymbol |
self filterFrom:
+ [:aClass :aSelector | | aMethod |
- [:aClass :aSelector |
(aMethod := aClass compiledMethodAt: aSelector) isNil or:
[(aMethod hasLiteralThorough: aSymbol) not]]]!
Item was changed:
----- Method: ClassCommentVersionsBrowser class>>browseCommentOf: (in category 'instance creation') -----
browseCommentOf: class
- | changeList |
Cursor read showWhile:
+ [| changeList |
+ changeList := self new scanVersionsOf: class.
- [changeList := self new scanVersionsOf: class.
changeList ifNil: [^ self inform: 'No versions available'].
self open: changeList name: 'Recent versions of ',class name,'''s comments' multiSelect: false ]
!
Item was changed:
----- Method: Lexicon>>initListFrom:highlighting: (in category 'initialization') -----
initListFrom: selectorCollection highlighting: aClass
"Make up the messageList with items from aClass in boldface. Provide a final filtering in that only selectors whose implementations fall within my limitClass will be shown."
+
- | defClass item |
messageList := OrderedCollection new.
selectorCollection do:
+ [:selector | | item defClass | defClass := aClass whichClassIncludesSelector: selector.
- [:selector | defClass := aClass whichClassIncludesSelector: selector.
(defClass notNil and: [defClass includesBehavior: self limitClass]) ifTrue:
[item := selector, ' (' , defClass name , ')'.
item := item asText.
defClass == aClass ifTrue: [item allBold].
"(self isThereAnOverrideOf: selector) ifTrue: [item addAttribute: TextEmphasis struckOut]."
"The above has a germ of a good idea but could be very slow"
messageList add: item]]!
Item was changed:
----- Method: SelectorBrowser>>testObjects:strings: (in category 'as yet unclassified') -----
testObjects: dataObjects strings: dataStrings
+ | dataObjs dataStrs selectors classes didUnmodifiedAnswer |
- | dataObjs dataStrs selectors classes didUnmodifiedAnswer answerMod do ds result ddo dds |
"Try to make substitutions in the user's inputs and search for the selector again.
1 no change to answer.
2 answer Array -> OrderedCollection.
2 answer Character -> String
4 answer Symbol or String of len 1 -> Character
For each of these, try straight, and try converting args:
Character -> String
Symbol or String of len 1 -> Character
Return array with result, dataObjects, dataStrings. Don't ever do a find on the same set of data twice."
dataObjs := dataObjects. dataStrs := dataStrings.
selectors := {#asString. #first. #asOrderedCollection}.
classes := {Character. String. Array}.
didUnmodifiedAnswer := false.
+ selectors withIndexDo: [:ansSel :ansInd | | ds do result answerMod | "Modify the answer object"
- selectors withIndexDo: [:ansSel :ansInd | "Modify the answer object"
answerMod := false.
do := dataObjs copyTwoLevel. ds := dataStrs copy.
(dataObjs last isKindOf: (classes at: ansInd)) ifTrue: [
((ansSel ~~ #first) or: [dataObjs last size = 1]) ifTrue: [
do at: do size put: (do last perform: ansSel). "asString"
ds at: ds size put: ds last, ' ', ansSel.
result := MethodFinder new load: do; findMessage.
(result first beginsWith: 'no single method') ifFalse: [
"found a selector!!"
^ Array with: result first with: do with: ds].
answerMod := true]].
+ selectors allButLast withIndexDo: [:argSel :argInd | | ddo dds | "Modify an argument object"
- selectors allButLast withIndexDo: [:argSel :argInd | "Modify an argument object"
"for args, no reason to do Array -> OrderedCollection. Identical protocol."
didUnmodifiedAnswer not | answerMod ifTrue: [
ddo := do copyTwoLevel. dds := ds copy.
dataObjs first withIndexDo: [:arg :ind |
(arg isKindOf: (classes at: argInd)) ifTrue: [
((argSel ~~ #first) or: [arg size = 1]) ifTrue: [
ddo first at: ind put: ((ddo first at: ind) perform: argSel). "asString"
dds at: ind put: (dds at: ind), ' ', argSel.
result := MethodFinder new load: ddo; findMessage.
(result first beginsWith: 'no single method') ifFalse: [
"found a selector!!"
^ Array with: result first with: ddo with: dds] .
didUnmodifiedAnswer not & answerMod not ifTrue: [
didUnmodifiedAnswer := true].
]]]]].
].
^ Array with: 'no single method does that function' with: dataObjs with: dataStrs!
Item was changed:
----- Method: ChangeList>>scanFile:from:to: (in category 'scanning') -----
scanFile: aFile from: startPosition to: stopPosition
+
- | itemPosition item prevChar |
file := aFile.
changeList := OrderedCollection new.
list := OrderedCollection new.
listIndex := 0.
file position: startPosition.
'Scanning ', aFile localName, '...'
displayProgressAt: Sensor cursorPoint
from: startPosition to: stopPosition
+ during: [:bar | | prevChar itemPosition item |
- during: [:bar |
[file position < stopPosition]
whileTrue:
[bar value: file position.
[file atEnd not and: [file peek isSeparator]]
whileTrue: [prevChar := file next].
(file peekFor: $!!)
ifTrue:
[(prevChar = Character cr or: [prevChar = Character lf])
ifTrue: [self scanCategory]]
ifFalse:
[itemPosition := file position.
item := file nextChunk.
file skipStyleChunk.
item size > 0 ifTrue:
[self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt)
text: 'do it: ' , (item contractTo: 50)]]]].
listSelections := Array new: list size withAll: false!
Item was changed:
----- Method: PackagePaneBrowser>>packageList (in category 'package list') -----
packageList
"Answer a list of the packages in the current system organization."
+ | str stream |
- | str cats stream |
str := Set new: 100.
stream := WriteStream on: (Array new: 100).
systemOrganizer categories do:
+ [ :categ | | cats |
- [ :categ |
cats := categ asString copyUpTo: $-.
(str includes: cats) ifFalse:
[str add: cats.
stream nextPut: cats]].
^stream contents!
Item was changed:
----- Method: ChangeList>>selectConflicts (in category 'menu actions') -----
selectConflicts
"Selects all method definitions for which there is ALSO an entry in changes"
+
- | change class |
Cursor read showWhile:
+ [ | change class |1 to: changeList size do:
- [1 to: changeList size do:
[:i | change := changeList at: i.
listSelections at: i put:
(change type = #method
and: [(class := change methodClass) notNil
and: [(ChangeSet current atSelector: change methodSelector
class: class) ~~ #none]])]].
self changed: #allSelections!
Item was changed:
----- Method: Model>>addItem: (in category '*Tools') -----
addItem: classAndMethod
"Make a linked message list and put this method in it"
+
- | list |
self flag: #mref. "classAndMethod is a String"
MessageSet
parse: classAndMethod
+ toClassAndSelector: [ :class :sel | | list |
- toClassAndSelector: [ :class :sel |
class ifNil: [^self].
list := OrderedCollection with: (
MethodReference new
setClass: class
methodSymbol: sel
stringVersion: classAndMethod
).
MessageSet
openMessageList: list
name: 'Linked by HyperText'.
]
!
Item was changed:
----- Method: FileContentsBrowser class>>browseStream:named: (in category 'instance creation') -----
browseStream: aStream named: aString
+ | browser |
+ Cursor wait showWhile: [ | package packageDict organizer |
- | package organizer packageDict browser |
- Cursor wait showWhile: [
packageDict := Dictionary new.
browser := self new.
organizer := SystemOrganizer defaultList: Array new.
package := (FilePackage new fullName: aString; fileInFrom: aStream).
packageDict
at: package packageName
put: package.
organizer
classifyAll: package classes keys
under: package packageName.
(browser := self systemOrganizer: organizer)
packages: packageDict].
self
openBrowserView: browser createViews
label: 'File Contents Browser'.
!
Item was changed:
----- Method: MessageSet>>initializeMessageList: (in category 'private') -----
initializeMessageList: anArray
"Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses."
+
- | s |
messageList := OrderedCollection new.
anArray do: [ :each |
MessageSet
parse: each
+ toClassAndSelector: [ :class :sel | | s |
- toClassAndSelector: [ :class :sel |
class ifNotNil:
[class isUniClass
ifTrue:
[s := class typicalInstanceName, ' ', sel]
ifFalse:
[s := class name , ' ' , sel , ' {' ,
((class organization categoryOfElement: sel) ifNil: ['']) , '}'].
messageList add: (
MethodReference new
setClass: class
methodSymbol: sel
stringVersion: s)]]].
messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1].
contents := ''!
Item was changed:
----- Method: FileContentsBrowser class>>browseFiles: (in category 'instance creation') -----
browseFiles: fileList
+ | browser |
+ Cursor wait showWhile: [ | organizer packageDict |
- | package organizer packageDict browser |
- Cursor wait showWhile: [
packageDict := Dictionary new.
organizer := SystemOrganizer defaultList: Array new.
+ fileList do: [:fileName | | package |
- fileList do: [:fileName |
package := FilePackage fromFileNamed: fileName.
packageDict
at: package packageName
put: package.
organizer
classifyAll: package classes keys
under: package packageName].
(browser := self systemOrganizer: organizer)
packages: packageDict].
self
openBrowserView: browser createViews
label: 'File Contents Browser'.
!
Item was changed:
----- Method: MessageSet>>filterToSendersOf (in category 'filtering') -----
filterToSendersOf
"Filter the receiver's list down to only those items which send a given selector"
+ | aFragment inputWithBlanksTrimmed |
- | aFragment inputWithBlanksTrimmed aMethod |
aFragment := UIManager default request: 'type selector:' initialAnswer: ''.
aFragment isEmptyOrNil ifTrue: [^ self].
inputWithBlanksTrimmed := aFragment withBlanksTrimmed.
Symbol hasInterned: inputWithBlanksTrimmed ifTrue:
[:aSymbol |
self filterFrom:
+ [:aClass :aSelector | | aMethod |
- [:aClass :aSelector |
(aMethod := aClass compiledMethodAt: aSelector) notNil and:
[aMethod hasLiteralThorough: aSymbol]]]
!
Item was changed:
----- Method: HierarchyBrowser>>initHierarchyForClass: (in category 'initialization') -----
initHierarchyForClass: aClassOrMetaClass
+ | index nonMetaClass tab |
- | tab stab index nonMetaClass |
centralClass := aClassOrMetaClass.
nonMetaClass := aClassOrMetaClass theNonMetaClass.
self systemOrganizer: SystemOrganization.
metaClassIndicated := aClassOrMetaClass isMeta.
classList := OrderedCollection new.
tab := ''.
nonMetaClass allSuperclasses reverseDo:
[:aClass |
classList add: tab , aClass name.
tab := tab , ' '].
index := classList size + 1.
nonMetaClass allSubclassesWithLevelDo:
+ [:aClass :level | | stab |
- [:aClass :level |
stab := ''. 1 to: level do: [:i | stab := stab , ' '].
classList add: tab , stab , aClass name]
startingLevel: 0.
self classListIndex: index!
Item was changed:
----- Method: CodeHolder>>annotationForSelector:ofClass: (in category 'annotation') -----
annotationForSelector: aSelector ofClass: aClass
"Provide a line of content for an annotation pane, representing
information about the given selector and class"
+ | separator aStream requestList |
- | stamp sendersCount implementorsCount aCategory separator aString aList aComment aStream requestList |
aSelector == #Comment
ifTrue: [^ self annotationForClassCommentFor: aClass].
aSelector == #Definition
ifTrue: [^ self annotationForClassDefinitionFor: aClass].
aSelector == #Hierarchy
ifTrue: [^ self annotationForHierarchyFor: aClass].
aStream := ReadWriteStream on: ''.
requestList := self annotationRequests.
separator := requestList size > 1
ifTrue: [self annotationSeparator]
ifFalse: [''].
requestList
+ do: [:aRequest | | aString sendersCount aComment aCategory implementorsCount aList stamp |
- do: [:aRequest |
aRequest == #firstComment
ifTrue: [aComment := aClass firstCommentAt: aSelector.
aComment isEmptyOrNil
ifFalse: [aStream nextPutAll: aComment , separator]].
aRequest == #masterComment
ifTrue: [aComment := aClass supermostPrecodeCommentFor: aSelector.
aComment isEmptyOrNil
ifFalse: [aStream nextPutAll: aComment , separator]].
aRequest == #documentation
ifTrue: [aComment := aClass precodeCommentOrInheritedCommentFor: aSelector.
aComment isEmptyOrNil
ifFalse: [aStream nextPutAll: aComment , separator]].
aRequest == #timeStamp
ifTrue: [stamp := self timeStamp.
aStream
nextPutAll: (stamp size > 0
ifTrue: [stamp , separator]
ifFalse: ['no timeStamp' , separator])].
aRequest == #messageCategory
ifTrue: [aCategory := aClass organization categoryOfElement: aSelector.
aCategory
ifNotNil: ["woud be nil for a method no longer present,
e.g. in a recent-submissions browser"
aStream nextPutAll: aCategory , separator]].
aRequest == #sendersCount
ifTrue: [sendersCount := (self systemNavigation allCallsOn: aSelector) size.
sendersCount := sendersCount == 1
ifTrue: ['1 sender']
ifFalse: [sendersCount printString , ' senders'].
aStream nextPutAll: sendersCount , separator].
aRequest == #implementorsCount
ifTrue: [implementorsCount := self systemNavigation numberOfImplementorsOf: aSelector.
implementorsCount := implementorsCount == 1
ifTrue: ['1 implementor']
ifFalse: [implementorsCount printString , ' implementors'].
aStream nextPutAll: implementorsCount , separator].
aRequest == #priorVersionsCount
ifTrue: [self
addPriorVersionsCountForSelector: aSelector
ofClass: aClass
to: aStream].
aRequest == #priorTimeStamp
ifTrue: [stamp := VersionsBrowser
timeStampFor: aSelector
class: aClass
reverseOrdinal: 2.
stamp
ifNotNil: [aStream nextPutAll: 'prior time stamp: ' , stamp , separator]].
aRequest == #recentChangeSet
ifTrue: [aString := ChangesOrganizer mostRecentChangeSetWithChangeForClass: aClass selector: aSelector.
aString size > 0
ifTrue: [aStream nextPutAll: aString , separator]].
aRequest == #allChangeSets
ifTrue: [aList := ChangesOrganizer allChangeSetsWithClass: aClass selector: aSelector.
aList size > 0
ifTrue: [aList size = 1
ifTrue: [aStream nextPutAll: 'only in change set ']
ifFalse: [aStream nextPutAll: 'in change sets: '].
aList
do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']]
ifFalse: [aStream nextPutAll: 'in no change set'].
aStream nextPutAll: separator]].
^ aStream contents!
Item was changed:
----- Method: TimeProfileBrowser>>setClassAndSelectorIn: (in category 'private') -----
setClassAndSelectorIn: csBlock
"Decode strings of the form <selectorName> (<className> [class]) "
- | string strm class sel parens |
-
self flag: #mref. "fix for faster references to methods"
+
+ [ | strm string class parens sel |
+ string := self selection asString.
-
- [string := self selection asString.
string first == $* ifTrue: [^contents := nil]. "Ignore lines starting with *"
parens := string includes: $(. "Does it have open-paren?"
strm := ReadStream on: string.
parens
ifTrue: [strm skipTo: $(. "easy case"
class := strm upTo: $).
strm next: 2.
sel := strm upToEnd]
ifFalse: [strm position: (string findString: ' class>>').
strm position > 0
ifFalse: [strm position: (string findLast: [ :ch | ch == $ ])]
ifTrue:
[ | subString | "find the next to last space character"
subString := strm contents copyFrom: 1 to: (string findLast: [ :ch | ch == $ ]) - 1.
strm position: (subString findLast: [ :ch | ch == $ ])].
"ifFalse: [strm position: (string findLast: [ :ch | ch == $ ])."
class := strm upTo: $>.
strm next.
sel := strm upToEnd].
^ MessageSet parse: (class, ' ', sel) toClassAndSelector: csBlock]
on: Error do: [:ex | ^ contents := nil]!
Item was changed:
----- Method: MessageSet>>filterToCurrentAuthor (in category 'filtering') -----
filterToCurrentAuthor
"Filter down only to messages with my initials as most recent author"
+ | myInitials |
- | myInitials aMethod aTimeStamp |
(myInitials := Utilities authorInitialsPerSe) ifNil: [^ self inform: 'No author initials set in this image'].
self filterFrom:
+ [:aClass :aSelector | | aMethod aTimeStamp |
- [:aClass :aSelector |
(aClass notNil and: [aSelector notNil]) and:
[aMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil].
aMethod notNil and:
[(aTimeStamp := Utilities timeStampForMethod: aMethod) notNil and:
[aTimeStamp beginsWith: myInitials]]]]!
Item was changed:
----- Method: Lexicon>>selectorsChanged (in category 'within-tool queries') -----
selectorsChanged
"Return a list of methods in the current change set (or satisfying some
other such criterion) that are in the protocol of this object"
+ | aList targetedClass |
- | aList aClass targetedClass |
targetedClass := self targetObject
ifNil: [targetClass]
ifNotNil: [self targetObject class].
aList := OrderedCollection new.
ChangeSet current methodChanges
associationsDo: [:classChgAssoc | classChgAssoc value
+ associationsDo: [:methodChgAssoc | | aClass | (methodChgAssoc value == #change
- associationsDo: [:methodChgAssoc | (methodChgAssoc value == #change
or: [methodChgAssoc value == #add])
ifTrue: [(aClass := targetedClass whichClassIncludesSelector: methodChgAssoc key)
ifNotNil: [aClass name = classChgAssoc key
ifTrue: [aList add: methodChgAssoc key]]]]].
^ aList!
Item was changed:
----- Method: Browser>>addCategory (in category 'message category functions') -----
addCategory
"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
+ | labels reject lines menuIndex oldIndex newName |
- | labels reject lines cats menuIndex oldIndex newName |
self okToChange ifFalse: [^ self].
classListIndex = 0 ifTrue: [^ self].
labels := OrderedCollection with: 'new...'.
reject := Set new.
reject
addAll: self selectedClassOrMetaClass organization categories;
add: ClassOrganizer nullCategory;
add: ClassOrganizer default.
lines := OrderedCollection new.
+ self selectedClassOrMetaClass allSuperclasses do: [:cls | | cats |
- self selectedClassOrMetaClass allSuperclasses do: [:cls |
cls = Object ifFalse: [
cats := cls organization categories reject:
[:cat | reject includes: cat].
cats isEmpty ifFalse: [
lines add: labels size.
labels addAll: cats asSortedCollection.
reject addAll: cats]]].
newName := (labels size = 1 or: [
menuIndex := (UIManager default chooseFrom: labels lines: lines title: 'Add Category').
menuIndex = 0 ifTrue: [^ self].
menuIndex = 1])
ifTrue: [
self request: 'Please type new category name'
initialAnswer: 'category name']
ifFalse: [
labels at: menuIndex].
oldIndex := messageCategoryListIndex.
newName isEmpty
ifTrue: [^ self]
ifFalse: [newName := newName asSymbol].
self classOrMetaClassOrganizer
addCategory: newName
before: (messageCategoryListIndex = 0
ifTrue: [nil]
ifFalse: [self selectedMessageCategoryName]).
self changed: #messageCategoryList.
self messageCategoryListIndex:
(oldIndex = 0
ifTrue: [self classOrMetaClassOrganizer categories size + 1]
ifFalse: [oldIndex]).
self changed: #messageCategoryList.
!
Item was changed:
----- Method: TimeProfileBrowser>>selectedMessage (in category 'message list') -----
selectedMessage
"Answer the source method for the currently selected message."
+
- | source |
self setClassAndSelectorIn:
+ [:class :selector | | source |
- [:class :selector |
source := class sourceMethodAt: selector ifAbsent: [^'Missing'].
Preferences browseWithPrettyPrint
ifTrue:
[source := class prettyPrinterClass
format: source
in: class
notifying: nil
decorated: false].
self selectedClass: class.
self selectedSelector: selector.
^source asText makeSelectorBoldIn: class].
^''!
Item was changed:
----- Method: ChangeList>>selectUnchangedMethods (in category 'menu actions') -----
selectUnchangedMethods
"Selects all method definitions for which there is already a method in the current image, whose source is exactly the same. 9/18/96 sw"
+
- | change class |
Cursor read showWhile:
+ [ | class change |1 to: changeList size do:
- [1 to: changeList size do:
[:i | change := changeList at: i.
listSelections at: i put:
((change type = #method and:
[(class := change methodClass) notNil]) and:
[(class includesSelector: change methodSelector) and:
[change string withBlanksCondensed = (class sourceCodeAt: change methodSelector) asString withBlanksCondensed ]])]].
self changed: #allSelections!
Item was changed:
----- Method: ChangesOrganizer class>>fileOutChangeSetsNamed: (in category 'utilities') -----
fileOutChangeSetsNamed: nameList
"File out the list of change sets whose names are provided"
"ChangeSorter fileOutChangeSetsNamed: #('New Changes' 'miscTidies-sw')"
+ | notFound empty infoString |
- | notFound aChangeSet infoString empty |
notFound := OrderedCollection new.
empty := OrderedCollection new.
nameList do:
+ [:aName | | aChangeSet | (aChangeSet := self changeSetNamed: aName)
- [:aName | (aChangeSet := self changeSetNamed: aName)
ifNotNil:
[aChangeSet isEmpty
ifTrue:
[empty add: aName]
ifFalse:
[aChangeSet fileOut]]
ifNil:
[notFound add: aName]].
infoString := (nameList size - notFound size) printString, ' change set(s) filed out'.
notFound size > 0 ifTrue:
[infoString := infoString, '
', notFound size printString, ' change set(s) not found:'.
notFound do:
[:aName | infoString := infoString, '
', aName]].
empty size > 0 ifTrue:
[infoString := infoString, '
', empty size printString, ' change set(s) were empty:'.
empty do:
[:aName | infoString := infoString, '
', aName]].
self inform: infoString!
More information about the Packages
mailing list