Squeak-dev December 2014

squeak-dev@lists.squeakfoundation.org

35 participants
112 discussions

The Trunk: Protocols-bf.47.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

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

The Trunk: ToolBuilder-Kernel-bf.64.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-bf.64.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-bf.64 Author: bf Time: 8 December 2014, 2:11:41.299 am UUID: 3c3c6935-2022-4f1a-b70a-125d055210d3 Ancestors: ToolBuilder-Kernel-eem.63 Restore timestamps lost in assignment conversion. =============== Diff against ToolBuilder-Kernel-eem.63 =============== Item was changed: ----- Method: String>>displayProgressAt:from:to:during: (in category '*toolbuilder-kernel') ----- displayProgressAt: aPoint from: minVal to: maxVal during: workBlock "Display this string as a caption over a progress bar while workBlock is evaluated. EXAMPLE (Select next 6 lines and Do It) 'Now here''s some Real Progress' displayProgressAt: Sensor cursorPoint from: 0 to: 10 during: [:bar | 1 to: 10 do: [:x | bar value: x. (Delay forMilliseconds: 500) wait]]. HOW IT WORKS (Try this in any other language :-) Since your code (the last 2 lines in the above example) is in a block, this method gets control to display its heading before, and clean up the screen after, its execution. The key, though, is that the block is supplied with an argument, named 'bar' in the example, which will update the bar image every it is sent the message value: x, where x is in the from:to: range. " ^ProgressInitiationException display: self at: aPoint from: minVal to: maxVal during: workBlock!

1 0

The Trunk: Tests-bf.305.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-bf.305.mcz ==================== Summary ==================== Name: Tests-bf.305 Author: bf Time: 8 December 2014, 2:10:38.345 am UUID: 8013d62e-ef54-4473-805f-c8841ceb4f83 Ancestors: Tests-ul.304 Restore timestamps lost in assignment conversion. =============== Diff against Tests-ul.304 =============== Item was changed: ----- Method: BitmapStreamTests>>randomFloat (in category 'private') ----- randomFloat "Answer a random 32-bit float" | w | random seed: (w := random nextValue). ^w! Item was changed: ----- Method: BitmapStreamTests>>randomWord (in category 'private') ----- randomWord "Answer a random 32-bit integer" | w | random seed: (w := random nextValue). ^w truncated! Item was changed: ----- Method: BitmapStreamTests>>setUp (in category 'Running') ----- setUp random := Random new.! Item was changed: ----- Method: BitmapStreamTests>>testMatrixTransform2x3WithImageSegment (in category 'tests-MatrixTransform2x3') ----- testMatrixTransform2x3WithImageSegment array := MatrixTransform2x3 new. 1 to: 6 do: [ :i | array at: i put: self randomFloat ]. self validateImageSegment ! Item was changed: ----- Method: BitmapStreamTests>>testMatrixTransform2x3WithRefStream (in category 'tests-MatrixTransform2x3') ----- testMatrixTransform2x3WithRefStream array := MatrixTransform2x3 new. 1 to: 6 do: [ :i | array at: i put: self randomFloat ]. self validateRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testMatrixTransform2x3WithRefStreamOnDisk (in category 'tests-MatrixTransform2x3') ----- testMatrixTransform2x3WithRefStreamOnDisk array := MatrixTransform2x3 new. 1 to: 6 do: [ :i | array at: i put: self randomFloat ]. self validateRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testMatrixTransform2x3WithSmartRefStream (in category 'tests-MatrixTransform2x3') ----- testMatrixTransform2x3WithSmartRefStream array := MatrixTransform2x3 new. 1 to: 6 do: [ :i | array at: i put: self randomFloat ]. self validateSmartRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testMatrixTransform2x3WithSmartRefStreamOnDisk (in category 'tests-MatrixTransform2x3') ----- testMatrixTransform2x3WithSmartRefStreamOnDisk array := MatrixTransform2x3 new. 1 to: 6 do: [ :i | array at: i put: self randomFloat ]. self validateSmartRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortIntegerArrayWithImageSegment (in category 'tests-ShortIntegerArray') ----- testShortIntegerArrayWithImageSegment array := ShortIntegerArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortInt ]. self validateImageSegment ! Item was changed: ----- Method: BitmapStreamTests>>testShortIntegerArrayWithRefStream (in category 'tests-ShortIntegerArray') ----- testShortIntegerArrayWithRefStream array := ShortIntegerArray with: 0 with: 1 with: 2 with: 3. self validateRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortIntegerArrayWithRefStreamOnDisk (in category 'tests-ShortIntegerArray') ----- testShortIntegerArrayWithRefStreamOnDisk array := ShortIntegerArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortInt ]. self validateRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortIntegerArrayWithSmartRefStream (in category 'tests-ShortIntegerArray') ----- testShortIntegerArrayWithSmartRefStream array := ShortIntegerArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortInt ]. self validateSmartRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortIntegerArrayWithSmartRefStreamOnDisk (in category 'tests-ShortIntegerArray') ----- testShortIntegerArrayWithSmartRefStreamOnDisk array := ShortIntegerArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortInt ]. self validateSmartRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortPointArrayWithImageSegment (in category 'tests-ShortPointArray') ----- testShortPointArrayWithImageSegment array := ShortPointArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortPoint ]. self validateImageSegment ! Item was changed: ----- Method: BitmapStreamTests>>testShortPointArrayWithRefStream (in category 'tests-ShortPointArray') ----- testShortPointArrayWithRefStream array := ShortPointArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortPoint ]. self validateRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortPointArrayWithRefStreamOnDisk (in category 'tests-ShortPointArray') ----- testShortPointArrayWithRefStreamOnDisk array := ShortPointArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortPoint ]. self validateRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortPointArrayWithSmartRefStream (in category 'tests-ShortPointArray') ----- testShortPointArrayWithSmartRefStream array := ShortPointArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortPoint ]. self validateSmartRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortPointArrayWithSmartRefStreamOnDisk (in category 'tests-ShortPointArray') ----- testShortPointArrayWithSmartRefStreamOnDisk array := ShortPointArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomShortPoint ]. self validateSmartRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortRunArrayWithImageSegment (in category 'tests-ShortRunArray') ----- testShortRunArrayWithImageSegment array := self createSampleShortRunArray. self validateImageSegment ! Item was changed: ----- Method: BitmapStreamTests>>testShortRunArrayWithRefStream (in category 'tests-ShortRunArray') ----- testShortRunArrayWithRefStream array := self createSampleShortRunArray. self validateRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortRunArrayWithRefStreamOnDisk (in category 'tests-ShortRunArray') ----- testShortRunArrayWithRefStreamOnDisk array := self createSampleShortRunArray. self validateRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testShortRunArrayWithSmartRefStream (in category 'tests-ShortRunArray') ----- testShortRunArrayWithSmartRefStream array := self createSampleShortRunArray. self validateSmartRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testShortRunArrayWithSmartRefStreamOnDisk (in category 'tests-ShortRunArray') ----- testShortRunArrayWithSmartRefStreamOnDisk array := self createSampleShortRunArray. self validateSmartRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testWordArrayWithImageSegment (in category 'tests-WordArray') ----- testWordArrayWithImageSegment array := WordArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomWord ]. self validateImageSegment ! Item was changed: ----- Method: BitmapStreamTests>>testWordArrayWithRefStream (in category 'tests-WordArray') ----- testWordArrayWithRefStream array := WordArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomWord ]. self validateRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testWordArrayWithRefStreamOnDisk (in category 'tests-WordArray') ----- testWordArrayWithRefStreamOnDisk array := WordArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomWord ]. self validateRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>testWordArrayWithSmartRefStream (in category 'tests-WordArray') ----- testWordArrayWithSmartRefStream array := WordArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomWord ]. self validateSmartRefStream ! Item was changed: ----- Method: BitmapStreamTests>>testWordArrayWithSmartRefStreamOnDisk (in category 'tests-WordArray') ----- testWordArrayWithSmartRefStreamOnDisk array := WordArray new: 10. 1 to: 10 do: [ :i | array at: i put: self randomWord ]. self validateSmartRefStreamOnDisk ! Item was changed: ----- Method: BitmapStreamTests>>validateRefStream (in category 'private') ----- validateRefStream "array is set up with an array." | other rwstream | rwstream := RWBinaryOrTextStream on: (ByteArray new: array basicSize * 6). stream := ReferenceStream on: rwstream. stream nextPut: array; close. rwstream position: 0. stream := ReferenceStream on: rwstream. other := stream next. stream close. self assert: array = other! Item was changed: ----- Method: BitmapStreamTests>>validateSmartRefStream (in category 'private') ----- validateSmartRefStream "array is set up with an array." | other | stream := RWBinaryOrTextStream on: (ByteArray new: array basicSize * 6). stream binary. stream fileOutClass: nil andObject: array. stream position: 0. stream binary. other := stream fileInObjectAndCode. self assert: array = other! Item was changed: ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'Private') ----- removeEverythingInSetFromSystem: aChangeSet aChangeSet changedMessageList do: [:methodRef | methodRef actualClass removeSelector: methodRef methodSymbol]. aChangeSet changedClasses do: [:each | each isMeta ifFalse: [each removeFromSystemUnlogged]]! Item was changed: ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'Tests') ----- testRenameClassUsingClass "self run: #testRenameClassUsingClass" self renameClassUsing: [:class :newName | class rename: newName].! Item was changed: ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'create/delete tests') ----- testDeleteDirectory "Test deletion of a directory" | aContainingDirectory preTestItems | aContainingDirectory := self myDirectory containingDirectory. preTestItems := aContainingDirectory fileAndDirectoryNames. self assert: self myAssuredDirectory exists. aContainingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [aContainingDirectory directoryNames includes: self myLocalDirectoryName ] description: 'Should successfully delete directory.'. self should: [preTestItems = aContainingDirectory fileAndDirectoryNames] description: 'Should only delete the indicated directory.'. ! Item was changed: ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'existence tests') ----- testNonExistentDirectory | directory parentDirectory | directory :=FileDirectory default directoryNamed: 'nonExistentFolder'. self shouldnt: [directory exists] description: 'A FileDirectory instance should know if it points to a non-existent directory.'. parentDirectory :=FileDirectory default. self shouldnt: [parentDirectory directoryExists: 'nonExistentFolder'] description: 'A FileDirectory instance should know when a directory of the given name doesn''t exist'. ! Item was changed: ----- Method: HashAndEqualsTestCase>>setUp (in category 'as yet unclassified') ----- setUp "subclasses will add their prototypes into this collection" prototypes := OrderedCollection new ! Item was changed: ----- Method: HashTester>>resultFor: (in category 'as yet unclassified') ----- resultFor: runs "Test that the hash is the same over runs and answer the result" | hash | hash := self prototype hash. 1 to: runs do: [:i | hash = self prototype hash ifFalse: [^ false]]. ^ true ! Item was changed: ----- Method: MCAncestryTest>>assertNamesOf:are: (in category 'asserting') ----- assertNamesOf: versionInfoCollection are: nameArray | names | names := versionInfoCollection collect: [:ea | ea name]. self assert: names asArray = nameArray! Item was changed: ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'as yet unclassified') ----- testCannotLoad | d | d := self mockClass: 'MCMockClassC' super: 'NotAnObject'. self should: [d load] raise: Error. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: ----- Method: MCClassDefinitionTest>>testComparison (in category 'as yet unclassified') ----- testComparison | d1 d2 d3 d4 | d1 := self mockClass: 'A' super: 'X'. d2 := self mockClass: 'A' super: 'Y'. d3 := self mockClass: 'B' super: 'X'. d4 := self mockClass: 'B' super: 'X'. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self assert: (d3 isRevisionOf: d4). self assert: (d3 isSameRevisionAs: d4). self deny: (d1 isRevisionOf: d3). self deny: (d4 isRevisionOf: d2).! Item was changed: ----- Method: MCClassDefinitionTest>>testCreation (in category 'as yet unclassified') ----- testCreation | d | d := self mockClassA asClassDefinition. self assert: d className = #MCMockClassA. self assert: d superclassName = #MCMock. self assert: d type = #normal. self assert: d category = self mockCategoryName. self assert: d instVarNames asArray = #('ivar'). self assert: d classVarNames asArray = #('CVar'). self assert: d classInstVarNames asArray = #(). self assert: d comment isString. self assert: d comment = self classAComment. self assert: d commentStamp = self mockClassA organization commentStamp! Item was changed: ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'as yet unclassified') ----- testDefinitionString | d | d := self mockClassA asClassDefinition. self assert: d definitionString = self mockClassA definition.! Item was changed: ----- Method: MCClassDefinitionTest>>testEquals (in category 'as yet unclassified') ----- testEquals | a b | a := self mockClass: 'ClassA' super: 'SuperA'. b := self mockClass: 'ClassA' super: 'SuperA'. self assert: a = b! Item was changed: ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'as yet unclassified') ----- testEqualsSensitivity | message a b defA args defB | message := self creationMessage. a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA) typeA 'A comment' 'A'). b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB) typeB 'B comment' 'B'). defA := message valueWithArguments: a. 1 to: 8 do: [:index | args := a copy. args at: index put: (b at: index). defB := message valueWithArguments: args. self deny: defA = defB.]! Item was changed: ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'as yet unclassified') ----- testLoadAndUnload | d c | d := self mockClass: 'MCMockClassC' super: 'Object'. d load. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). c := (Smalltalk classNamed: 'MCMockClassC'). self assert: (c isKindOf: Class). self assert: c superclass = Object. self assert: c instVarNames isEmpty. self assert: c classVarNames isEmpty. self assert: c sharedPools isEmpty. self assert: c category = self mockCategoryName. self assert: c organization classComment = (self commentForClass: 'MCMockClassC'). self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC'). d unload. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: ----- Method: MCDependencySorterTest>>assertItems:orderAs:withRequired:toLoad:extraProvisions: (in category 'asserting') ----- assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems extraProvisions: provisions | order sorter items missing unloadable | items := anArray collect: [:ea | self itemWithSpec: ea]. sorter := MCDependencySorter items: items. sorter addExternalProvisions: provisions. order := (sorter orderedItems collect: [:ea | ea name]) asArray. self assert: order = depOrder. missing := sorter externalRequirements. self assert: missing asSet = missingDeps asSet. unloadable := (sorter itemsWithMissingRequirements collect: [:ea | ea name]) asArray. self assert: unloadable asSet = unloadableItems asSet! Item was changed: ----- Method: MCDictionaryRepositoryTest>>dictionary (in category 'as yet unclassified') ----- dictionary ^ dict ifNil: [dict := Dictionary new]! Item was changed: ----- Method: MCDictionaryRepositoryTest>>setUp (in category 'as yet unclassified') ----- setUp repository := MCDictionaryRepository new dictionary: self dictionary! Item was changed: ----- Method: MCDirectoryRepositoryTest>>addVersion: (in category 'as yet unclassified') ----- addVersion: aVersion | file | file := FileStream newFileNamed: (directory fullNameFor: aVersion fileName). aVersion fileOutOn: file. file close.! Item was changed: ----- Method: MCDirectoryRepositoryTest>>directory (in category 'as yet unclassified') ----- directory directory ifNil: [directory := FileDirectory default directoryNamed: 'mctest'. directory assureExistence]. ^ directory! Item was changed: ----- Method: MCFileInTest>>assertInitializersCalled (in category 'testing') ----- assertInitializersCalled | cvar | cvar := self mockClassA cVar. self assert: cvar = #initialized! Item was changed: ----- Method: MCFileInTest>>assertNoChange (in category 'asserting') ----- assertNoChange | actual | actual := MCSnapshotResource takeSnapshot. diff := actual patchRelativeToBase: expected. self assert: diff isEmpty! Item was changed: ----- Method: MCFileInTest>>setUp (in category 'running') ----- setUp expected := self mockSnapshot. stream := RWBinaryOrTextStream on: String new.! Item was changed: ----- Method: MCMczInstallerTest>>assertNoChange (in category 'as yet unclassified') ----- assertNoChange | actual | actual := MCSnapshotResource takeSnapshot. diff := actual patchRelativeToBase: expected snapshot. self assert: diff isEmpty! Item was changed: ----- Method: MCMczInstallerTest>>assertVersionInfoPresent (in category 'as yet unclassified') ----- assertVersionInfoPresent | dict info | dict := MczInstaller versionInfo at: self mockPackage name. info := expected info. self assertDict: dict matchesInfo: info.! Item was changed: ----- Method: MCMczInstallerTest>>setUp (in category 'as yet unclassified') ----- setUp expected := self mockVersion. self change: #one toReturn: 2.! Item was changed: ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'as yet unclassified') ----- testInstallFromStream | stream | stream := RWBinaryOrTextStream on: String new. MCMczWriter fileOut: expected on: stream. MczInstaller installStream: stream reset. self assertNoChange. self assertVersionInfoPresent. ! Item was changed: ----- Method: MCMergingTest>>assertMerge:with:base:gives:conflicts: (in category 'asserting') ----- assertMerge: local with: remote base: ancestor gives: result conflicts: conflictResult | merger | conflicts := #(). merger := MCThreeWayMerger base: (self snapshotWithElements: local) target: (self snapshotWithElements: remote) ancestor: (self snapshotWithElements: ancestor). merger conflicts do: [:ea | self handleConflict: ea]. self assert: merger mergedSnapshot definitions hasElements: result. self assert: conflicts asSet = conflictResult asSet.! Item was changed: ----- Method: MCMethodDefinitionTest>>override (in category 'mocks') ----- override ^ 1! Item was changed: ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'testing') ----- testCannotLoad | definition | definition := self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false. self should: [definition load] raise: Error. self assert: (navigation allImplementorsOf: #kjahs87) isEmpty! Item was changed: ----- Method: MCMethodDefinitionTest>>testComparison (in category 'testing') ----- testComparison |d1 d2 d3 d4 d5 | d1 := self mockMethod: #one class: 'A' source: '1' meta: false. d2 := self mockMethod: #one class: 'A' source: '2' meta: false. d3 := self mockMethod: #one class: 'A' source: '1' meta: true. d4 := self mockMethod: #two class: 'A' source: '1' meta: false. d5 := self mockMethod: #two class: 'A' source: '1' meta: false. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self deny: (d1 isRevisionOf: d3). self deny: (d1 isRevisionOf: d4). self assert: (d4 isSameRevisionAs: d5).! Item was changed: ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'testing') ----- testLoadAndUnload |definition| definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false. self assert: self mockInstanceA one = 1. definition load. self assert: self mockInstanceA one = 2. definition unload. self deny: (self mockInstanceA respondsTo: #one)! Item was changed: ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'testing') ----- testPartiallyRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz'. self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory. self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory. definition := (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod. self assert: self override = 4. definition unload. self assert: self override = 2. self assert: (MethodReference class: self class selector: #override) category = '*foobarbaz'. ! Item was changed: ----- Method: MCMockClassA class>>initialize (in category 'as yet unclassified') ----- initialize CVar := #initialized! Item was changed: ----- Method: MCMockClassA class>>touchCVar (in category 'as yet unclassified') ----- touchCVar CVar := #touched! Item was changed: ----- Method: MCMockDefinition>>token: (in category 'as yet unclassified') ----- token: aString token := aString! Item was changed: ----- Method: MCMockDependency>>initializeWithTree: (in category 'accessing') ----- initializeWithTree: expr expr isSymbol ifTrue: [name := expr. children := Array new. hasResolution := true.] ifFalse: [name := expr first. expr second isSymbol ifTrue: [hasResolution := false. children := Array new] ifFalse: [hasResolution := true. children := expr second]]! Item was changed: ----- Method: MCMockDependentItem>>name: (in category 'as yet unclassified') ----- name: aString name := aString! Item was changed: ----- Method: MCMockDependentItem>>provides: (in category 'as yet unclassified') ----- provides: anArray provides := anArray! Item was changed: ----- Method: MCMockDependentItem>>requires: (in category 'as yet unclassified') ----- requires: anArray requires := anArray! Item was changed: ----- Method: MCOrganizationTest>>testReordering (in category 'as yet unclassified') ----- testReordering |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(B C A). self assert: newCats asArray = #(X Y A B C Z Q).! Item was changed: ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'as yet unclassified') ----- testReorderingWithNoCategoriesInVersion |dec cats newCats | dec := MCOrganizationDefinition categories: #(). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(). self assert: newCats asArray = cats.! Item was changed: ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'as yet unclassified') ----- testReorderingWithRemovals |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(Y B C A Q). self assert: newCats asArray = #(X A B C Z).! Item was changed: ----- Method: MCPatchTest>>setUp (in category 'as yet unclassified') ----- setUp |rev1 rev2| rev1 := MCSnapshotResource takeSnapshot. self change: #one toReturn: 2. rev2 := MCSnapshotResource takeSnapshot. patch := rev2 patchRelativeToBase: rev1. self change: #one toReturn: 1.! Item was changed: ----- Method: MCRepositoryTest>>addVersionWithSnapshot:name: (in category 'actions') ----- addVersionWithSnapshot: aSnapshot name: aString | version | version := self versionWithSnapshot: aSnapshot name: aString. self addVersion: version. ^ version info! Item was changed: ----- Method: MCRepositoryTest>>saveSnapshot:named: (in category 'actions') ----- saveSnapshot: aSnapshot named: aString | version | version := self versionWithSnapshot: aSnapshot name: aString. repository storeVersion: version. ^ version info ! Item was changed: ----- Method: MCRepositoryTest>>testAddAndLoad (in category 'tests') ----- testAddAndLoad | node | node := self addVersionWithSnapshot: self snapshot1 name: 'rev1'. self assert: (self snapshotAt: node) = self snapshot1. ! Item was changed: ----- Method: MCRepositoryTest>>testLoadMissingNode (in category 'tests') ----- testLoadMissingNode | node | node := MCVersionInfo new. self assertMissing: node! Item was changed: ----- Method: MCRepositoryTest>>testStoreAndLoad (in category 'tests') ----- testStoreAndLoad | node node2 | node := self saveSnapshot1. node2 := self saveSnapshot2. self assert: (self snapshotAt: node) = self snapshot1. self assert: (self snapshotAt: node2) = self snapshot2.! Item was changed: ----- Method: MCRepositoryTest>>versionWithSnapshot:name: (in category 'building') ----- versionWithSnapshot: aSnapshot name: aString | info | info := self mockVersionInfo: aString. ^ MCVersion package: (MCPackage new name: aString) info: info snapshot: aSnapshot! Item was changed: ----- Method: MCSerializationTest>>assertClass:providesServices: (in category 'asserting') ----- assertClass: readerClass providesServices: labels | services suffix | suffix := readerClass extension. self assert: (FileList isReaderNamedRegistered: readerClass name). services := readerClass fileReaderServicesForFile: 'foo' suffix: suffix. self assert: ((services collect: [:service | service buttonLabel]) includesAllOf: labels)! Item was changed: ----- Method: MCSerializationTest>>assertDependenciesMatchWith: (in category 'asserting') ----- assertDependenciesMatchWith: writerClass | stream readerClass expected actual | readerClass := writerClass readerClass. expected := self mockVersionWithDependencies. stream := RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual := (readerClass on: stream reset) dependencies. self assert: actual = expected dependencies.! Item was changed: ----- Method: MCSerializationTest>>assertSnapshotsMatchWith: (in category 'asserting') ----- assertSnapshotsMatchWith: writerClass | readerClass expected stream actual | readerClass := writerClass readerClass. expected := self mockSnapshot. stream := RWBinaryOrTextStream on: String new. (writerClass on: stream) writeSnapshot: expected. actual := readerClass snapshotFromStream: stream reset. self assertSnapshot: actual matches: expected.! Item was changed: ----- Method: MCSerializationTest>>assertVersionInfosMatchWith: (in category 'asserting') ----- assertVersionInfosMatchWith: writerClass | stream readerClass expected actual | readerClass := writerClass readerClass. expected := self mockVersion. stream := RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual := readerClass versionInfoFromStream: stream reset. self assert: actual = expected info.! Item was changed: ----- Method: MCSerializationTest>>assertVersionsMatchWith: (in category 'asserting') ----- assertVersionsMatchWith: writerClass | stream readerClass expected actual | readerClass := writerClass readerClass. expected := self mockVersion. stream := RWBinaryOrTextStream on: String new. writerClass fileOut: expected on: stream. actual := readerClass versionFromStream: stream reset. self assertVersion: actual matches: expected.! Item was changed: ----- Method: MCSerializationTest>>mockDiffyVersion (in category 'mocks') ----- mockDiffyVersion | repos workingCopy base next | repos := MCDictionaryRepository new. workingCopy := MCWorkingCopy forPackage: self mockPackage. workingCopy repositoryGroup addRepository: repos. MCRepositoryGroup default removeRepository: repos. base := self mockVersion. repos storeVersion: base. self change: #a toReturn: 'a2'. next := self mockVersionWithAncestor: base. ^ next asDiffAgainst: base ! Item was changed: ----- Method: MCSnapshotBrowserTest>>clickOnListItem: (in category 'simulating') ----- clickOnListItem: aString | listMorph | listMorph := self findListContaining: aString. listMorph changeModelSelection: (listMorph getList indexOf: aString).! Item was changed: ----- Method: MCSnapshotBrowserTest>>morphsOfClass: (in category 'morphic') ----- morphsOfClass: aMorphClass | morphs | morphs := OrderedCollection new. morph allMorphsDo: [:m | (m isKindOf: aMorphClass) ifTrue: [morphs add: m]]. ^ morphs! Item was changed: ----- Method: MCSnapshotBrowserTest>>protocolsForClass: (in category 'private') ----- protocolsForClass: aClass | protocols | protocols := aClass organization categories. protocols size > 1 ifTrue: [protocols := protocols copyWith: '-- all --']. ^ protocols.! Item was changed: ----- Method: MCSnapshotResource>>setUp (in category 'as yet unclassified') ----- setUp snapshot := self class takeSnapshot.! Item was changed: ----- Method: MCSnapshotTest>>setUp (in category 'running') ----- setUp snapshot := self mockSnapshot.! Item was changed: ----- Method: MCSnapshotTest>>testCreation (in category 'tests') ----- testCreation |d| d := self mockSnapshot definitions. self assert: (d anySatisfy: [:ea | ea isClassDefinition and: [ea className = #MCMockClassA]]). self assert: (d anySatisfy: [:ea | ea isMethodDefinition and: [ea selector = #mockClassExtension]]). self assert: (d allSatisfy: [:ea | ea isClassDefinition not or: [ea category endsWith: 'Mocks']]). ! Item was changed: ----- Method: MCSnapshotTest>>testInstanceReuse (in category 'tests') ----- testInstanceReuse | x m n y | x := (MCPackage new name: self mockCategoryName) snapshot. Smalltalk garbageCollect. n := MCDefinition allSubInstances size. y := (MCPackage new name: self mockCategoryName) snapshot. Smalltalk garbageCollect. m := MCDefinition allSubInstances size. self assert: m = n! Item was changed: ----- Method: MCSortingTest>>testConsistentSorting (in category 'tests') ----- testConsistentSorting | definitions shuffledAndSorted| definitions := {self methodNamed: #a class: #A meta: false. self methodNamed: #a class: #A meta: true. self methodNamed: #a class: #B meta: false. self methodNamed: #b class: #A meta: false. self methodNamed: #b class: #B meta: false. self classNamed: #A. self classNamed: #B}. shuffledAndSorted := (1 to: 100) collect: [:ea | self sortDefinitions: definitions shuffled]. self assert: shuffledAndSorted asSet size = 1. ! Item was changed: ----- Method: MCSortingTest>>testSortOrder (in category 'tests') ----- testSortOrder | aA aAm aB bA bB A B cA bAm cAm | aA := self methodNamed: #a class: #A meta: false. bA := self methodNamed: #b class: #A meta: false. cA := self methodNamed: #c class: #A meta: false. aAm := self methodNamed: #a class: #A meta: true. bAm := self methodNamed: #b class: #A meta: true. cAm := self methodNamed: #c class: #A meta: true. aB := self methodNamed: #a class: #B meta: false. bB := self methodNamed: #b class: #B meta: false. A := self classNamed: #A. B := self classNamed: #B. self assert: (self sortDefinitions: {aA. aAm. cAm. aB. bAm. bA. bB. A. cA. B}) = {A. aAm. bAm. cAm. aA. bA. cA. B. aB. bB}! Item was changed: ----- Method: MCStReaderTest>>methodWithStyle (in category 'as yet unclassified') ----- methodWithStyle ^ '!!EventHandler methodsFor: ''copying'' stamp: ''tk 1/22/2001 17:39''!! veryDeepInner: deepCopier "ALL fields are weakly copied. Can''t duplicate an object by duplicating a button that activates it. See DeepCopier." super veryDeepInner: deepCopier. "just keep old pointers to all fields" clickRecipient := clickRecipient.!! ]style[(25 108 10 111)f1b,f1,f1LDeepCopier Comment;,f1!! !! '! Item was changed: ----- Method: MCStReaderTest>>testCommentWithStyle (in category 'as yet unclassified') ----- testCommentWithStyle | reader | reader := MCStReader on: self commentWithStyle readStream. reader definitions! Item was changed: ----- Method: MCStReaderTest>>testCommentWithoutStyle (in category 'as yet unclassified') ----- testCommentWithoutStyle | reader | reader := MCStReader on: self commentWithoutStyle readStream. self assert: (reader definitions anySatisfy: [:ea | ea isMethodDefinition]).! Item was changed: ----- Method: MCStReaderTest>>testMethodWithStyle (in category 'as yet unclassified') ----- testMethodWithStyle | reader | reader := MCStReader on: self methodWithStyle readStream. self assert: reader definitions first isMethodDefinition.! Item was changed: ----- Method: MCStWriterTest>>setUp (in category 'testing') ----- setUp stream := RWBinaryOrTextStream on: String new. writer := MCStWriter on: stream. ! Item was changed: ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'testing') ----- testInitializerDefinition |chunk lastChunk| writer writeSnapshot: self mockSnapshot. stream reset. [stream atEnd] whileFalse: [chunk := stream nextChunk. chunk isAllSeparators ifFalse: [lastChunk := chunk]]. self assertContentsOf: lastChunk readStream match: self expectedInitializerA! Item was changed: ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'testing') ----- testOrganizationDefinition | definition | definition := MCOrganizationDefinition categories: (self mockPackage packageInfo systemCategories). writer visitOrganizationDefinition: definition. self assertContentsOf: stream match: self expectedOrganizationDefinition. self assertAllChunksAreWellFormed.! Item was changed: ----- Method: MCTestCase>>assertSnapshot:matches: (in category 'asserting') ----- assertSnapshot: actual matches: expected | diff | diff := actual patchRelativeToBase: expected. self assert: diff isEmpty ! Item was changed: ----- Method: MCTestCase>>treeFrom: (in category 'mocks') ----- treeFrom: anArray | name id | name := anArray first. id := '00000000-0000-0000-0000-0000000000', (name asString size = 1 ifTrue: [name asString, '0'] ifFalse: [name asString]). ^ MCVersionInfo name: name id: (UUID fromString: id) message: '' date: nil time: nil author: '' ancestors: (anArray size > 1 ifTrue: [(anArray second collect: [:ea | self treeFrom: ea])] ifFalse: [#()])! Item was changed: ----- Method: MCVersionTest>>setUp (in category 'running') ----- setUp visited := OrderedCollection new.! Item was changed: ----- Method: MCWorkingCopyTest>>testAncestorMerge (in category 'tests') ----- testAncestorMerge | base revA revB revC | base := self snapshot. self change: #a toReturn: 'a1'. revA := self snapshot. self change: #b toReturn: 'b1'. revB := self snapshot. self change: #c toReturn: 'c1'. revC := self snapshot. self should: [self basicMerge: revA] raise: MCNoChangesException. ! Item was changed: ----- Method: MCWorkingCopyTest>>testBackport (in category 'tests') ----- testBackport | inst base final backported | inst := self mockInstanceA. base := self snapshot. self assert: inst one = 1. self change: #one toReturn: 2. self change: #two toReturn: 3. final := self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest do: [:e | e resume: e patch]. self assert: inst one = 2. self assert: inst two = 3. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = final info. backported := self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest do: [:e | e resume: e patch]. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = backported info. ! Item was changed: ----- Method: MCWorkingCopyTest>>testMergeIntoImageWithNoChanges (in category 'tests') ----- testMergeIntoImageWithNoChanges | base revB revA1 | self change: #a toReturn: 'a'. base := self snapshot. self change: #b toReturn: 'b'. revB := self snapshot. self load: base. self change: #a toReturn: 'a1'. revA1 := self snapshot. self change: #a toReturn: 'a'. self snapshot. self merge: revB. self assert: (workingCopy ancestors size = 2) ! Item was changed: ----- Method: MCWorkingCopyTest>>testMergeIntoUnmodifiedImage (in category 'tests') ----- testMergeIntoUnmodifiedImage | base revA | base := self snapshot. self change: #a toReturn: 'a1'. revA := self snapshot. self load: base. self merge: revA. self assert: (workingCopy ancestors size = 1) ! Item was changed: ----- Method: MCWorkingCopyTest>>testSimpleMerge (in category 'tests') ----- testSimpleMerge | mother base inst | inst := self mockInstanceA. base := self snapshot. self change: #one toReturn: 2. mother := self snapshot. self load: base. self change: #two toReturn: 3. self snapshot. self assert: inst one = 1. self assert: inst two = 3. self merge: mother. self assert: inst one = 2. self assert: inst two = 3.! Item was changed: ----- Method: MCWorkingCopyTest>>testSnapshotAndLoad (in category 'tests') ----- testSnapshotAndLoad | base inst | inst := self mockInstanceA. base := self snapshot. self change: #one toReturn: 2. self assert: inst one = 2. self load: base. self assert: inst one = 1.! Item was changed: ----- Method: PCCByCompilation>>extractCallNamesFromPrimString: (in category 'private') ----- extractCallNamesFromPrimString: aString "method works for both enabled and disabled prim strings" "<primitive: 'doSomething' module:'ModuleFoo'" | tokens | tokens := aString findTokens: ''''. ^ (tokens at: 2) -> (tokens at: 4 ifAbsent: [nil])! Item was changed: ----- Method: PCCByCompilationTest>>cExternalCall1 (in category 'example module') ----- cExternalCall1 <primitive: 'prim1' module: 'CPCCT'> ! Item was changed: ----- Method: PCCByCompilationTest>>cExternalCall2 (in category 'example module') ----- cExternalCall2 <primitive:'prim2'module:'CPCCT'> self primitiveFailed! Item was changed: ----- Method: PCCByCompilationTest>>cFailedCall (in category 'test methods') ----- cFailedCall <primitive: 'primGetModuleName' module:'CFailModule'> ^ 'failed call'! Item was changed: ----- Method: PCCByCompilationTest>>cRealExternalCallOrPrimitiveFailed (in category 'test methods') ----- cRealExternalCallOrPrimitiveFailed <primitive: 'primGetModuleName' module:'LargeIntegers'> self primitiveFailed! Item was changed: ----- Method: PrimCallControllerAbstract>>initialize (in category 'initialize-release') ----- initialize treatedMethods := Dictionary new. " logStream := Transcript." changeStatusOfFailedCallsFlag := false! Item was changed: ----- Method: PrototypeTester>>prototype: (in category 'as yet unclassified') ----- prototype: aPrototype "Set my prototype" prototype := aPrototype copy !

1 0

The Trunk: SUnit-bf.101.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of SUnit to project The Trunk: http://source.squeak.org/trunk/SUnit-bf.101.mcz ==================== Summary ==================== Name: SUnit-bf.101 Author: bf Time: 8 December 2014, 2:04:30.045 am UUID: d3caaa64-523b-482d-8297-097530a99a0c Ancestors: SUnit-fbs.100 Restore timestamps lost in assignment conversion. =============== Diff against SUnit-fbs.100 =============== Item was changed: ----- Method: TestCase class>>addTestsFor:toSuite: (in category 'building suites') ----- addTestsFor: classNameString toSuite: suite | cls | cls := Smalltalk at: classNameString ifAbsent: [ ^suite ]. ^cls isAbstract ifTrue: [ cls allSubclasses do: [ :each | each isAbstract ifFalse: [ each addToSuiteFromSelectors: suite ] ]. suite] ifFalse: [ cls addToSuiteFromSelectors: suite ] ! Item was changed: ----- Method: TestCase class>>debug: (in category 'instance creation') ----- debug: aSymbol ^(self selector: aSymbol) debug ! Item was changed: ----- Method: TestCase class>>run: (in category 'instance creation') ----- run: aSymbol ^(self selector: aSymbol) run ! Item was changed: ----- Method: TestResult>>errorCount (in category 'accessing') ----- errorCount ^self errors size ! Item was changed: ----- Method: TestResult>>failureCount (in category 'accessing') ----- failureCount ^self failures size !

1 0

The Trunk: ST80Tools-bf.4.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of ST80Tools to project The Trunk: http://source.squeak.org/trunk/ST80Tools-bf.4.mcz ==================== Summary ==================== Name: ST80Tools-bf.4 Author: bf Time: 8 December 2014, 2:03:19.031 am UUID: 6201f65e-3f42-4c07-b43a-505e4972c06a Ancestors: ST80Tools-eem.3 Restore timestamps lost in assignment conversion. =============== Diff against ST80Tools-eem.3 =============== Item was changed: ----- Method: ParagraphEditor>>browseChangeSetsWithSelector (in category '*ST80Tools') ----- browseChangeSetsWithSelector "Determine which, if any, change sets have at least one change for the selected selector, independent of class" | aSelector | self lineSelectAndEmptyCheck: [^ self]. (aSelector := self selectedSelector) == nil ifTrue: [^ view flash]. self terminateAndInitializeAround: [ChangeSorter browseChangeSetsWithSelector: aSelector]!

1 0

The Trunk: ST80-bf.175.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-bf.175.mcz ==================== Summary ==================== Name: ST80-bf.175 Author: bf Time: 8 December 2014, 2:02:23.412 am UUID: b4102f05-6b6c-4c17-8344-b300953f369f Ancestors: ST80-nice.174 Restore timestamps lost in assignment conversion. =============== Diff against ST80-nice.174 =============== Item was changed: ----- Method: Paragraph>>composeAll (in category 'composition') ----- composeAll "Compose a collection of characters into a collection of lines." | startIndex stopIndex lineIndex maximumRightX compositionScanner | lines := Array new: 32. lastLine := 0. maximumRightX := 0. text size = 0 ifTrue: [compositionRectangle := compositionRectangle withHeight: 0. ^maximumRightX]. startIndex := lineIndex := 1. stopIndex := text size. compositionScanner := CompositionScanner new forParagraph: self. [startIndex > stopIndex] whileFalse: [self lineAt: lineIndex put: (compositionScanner composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: self). maximumRightX := compositionScanner rightX max: maximumRightX. startIndex := (lines at: lineIndex) last + 1. lineIndex := lineIndex + 1]. self updateCompositionHeight. self trimLinesTo: lineIndex - 1. ^ maximumRightX! Item was changed: ----- Method: SyntaxError class>>buildMVCViewOn: (in category '*ST80-Support') ----- buildMVCViewOn: aSyntaxError "Answer an MVC view on the given SyntaxError." | topView aListView aCodeView | topView := StandardSystemView new model: aSyntaxError; label: 'Syntax Error'; minimumSize: 380@220. aListView := PluggableListView on: aSyntaxError list: #list selected: #listIndex changeSelected: nil menu: #listMenu:. aListView window: (0@0 extent: 380@20). topView addSubView: aListView. aCodeView := PluggableTextView on: aSyntaxError text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. aCodeView window: (0@0 extent: 380@200). topView addSubView: aCodeView below: aListView. ^ topView !

1 0

The Trunk: SMLoader-bf.80.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of SMLoader to project The Trunk: http://source.squeak.org/trunk/SMLoader-bf.80.mcz ==================== Summary ==================== Name: SMLoader-bf.80 Author: bf Time: 8 December 2014, 2:00:38.883 am UUID: 557eeed3-a3db-4eca-9f4f-d8fb732e5795 Ancestors: SMLoader-fbs.79 Restore timestamps lost in assignment conversion. =============== Diff against SMLoader-fbs.79 =============== Item was changed: ----- Method: FileList2 class>>morphicViewOnDirectory: (in category '*smloader-extension') ----- morphicViewOnDirectory: aFileDirectory | aFileList window fileListBottom midLine fileListTopOffset buttonPane | aFileList := self new directory: aFileDirectory. window := (SystemWindow labelled: aFileDirectory pathName) model: aFileList. fileListTopOffset := (TextStyle defaultFont pointSize * 2) + 14. fileListBottom := 0.4. midLine := 0.4. buttonPane := aFileList optionalButtonRow addMorph: (aFileList morphicPatternPane vResizing: #spaceFill; yourself). self addFullPanesTo: window from: { {buttonPane. 0@0 corner: 1@0. 0@0 corner: 0@fileListTopOffset}. {aFileList morphicDirectoryTreePane. 0@0 corner: midLine@fileListBottom. 0@fileListTopOffset corner: 0@0}. {aFileList morphicFileListPane. midLine @ 0 corner: 1@fileListBottom. 0@fileListTopOffset corner: 0@0}. {aFileList morphicFileContentsPane. 0@fileListBottom corner: 1@1. nil}. }. aFileList postOpen. ^ window ! Item was changed: ----- Method: SMLoader>>buildPackagePane (in category 'interface') ----- buildPackagePane "Create the text area to the right in the loader." | ptm | ptm := PluggableTextMorph on: self text: #contents accept: nil readSelection: nil "#packageSelection " menu: nil. ptm setBalloonText: 'This is where the selected package or package release is displayed.'. ptm lock. ^ptm! Item was changed: ----- Method: SMLoader>>contents (in category 'private') ----- contents | packageOrRelease | packageOrRelease := self selectedPackageOrRelease. ^packageOrRelease ifNil: ['<No package selected>'] ifNotNil: [packageOrRelease fullDescription] ! Item was changed: ----- Method: SMLoader>>selectedItemWrapper: (in category 'accessing') ----- selectedItemWrapper: aWrapper selectedItemWrapper := aWrapper. self changed: #selectedItemWrapper. self contentsChanged!

1 0

The Trunk: SMBase-bf.133.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of SMBase to project The Trunk: http://source.squeak.org/trunk/SMBase-bf.133.mcz ==================== Summary ==================== Name: SMBase-bf.133 Author: bf Time: 8 December 2014, 1:59:49.419 am UUID: 6561d5c0-abd2-4521-ab54-656fdf9fab4b Ancestors: SMBase-nice.132 Restore timestamps lost in assignment conversion. =============== Diff against SMBase-nice.132 =============== Item was changed: ----- Method: ImageSegment>>writeForExportOn: (in category '*SMBase-export') ----- writeForExportOn: fileStream "Write the segment on the disk with all info needed to reconstruct it in a new image. For export. Out pointers are encoded as normal objects on the disk." | temp | state = #activeCopy ifFalse: [self error: 'wrong state']. temp := endMarker. endMarker := nil. fileStream fileOutClass: nil andObject: self. "remember extra structures. Note class names." endMarker := temp. ! Item was changed: ----- Method: RcsDiff>>commandLines: (in category 'accessing') ----- commandLines: aString commandLines := aString! Item was changed: ----- Method: SMAccount>>advogatoId: (in category 'accessing') ----- advogatoId: aString advogatoId := aString! Item was changed: ----- Method: SMAccount>>correctPassword: (in category 'passwords') ----- correctPassword: aPassword "We store the password as a SHA hash so that we can let the slave maps have them too. Also check the optional new random password." | try | aPassword isEmptyOrNil ifTrue:[^false]. try := SecureHashAlgorithm new hashMessage: aPassword. ^password = try or: [newPassword = try]! Item was changed: ----- Method: SMAccount>>deleteFiles: (in category 'files') ----- deleteFiles: fileNames "Delete all fileNames from the uploads directory." | dir | dir := self uploadsDirectory. fileNames do: [:fn | dir deleteFileNamed: fn] ! Item was changed: ----- Method: SMAccount>>directory (in category 'files') ----- directory "Get the directory for the account." | dir | dir := (map directory directoryNamed: 'accounts') assureExistence; yourself. ^(dir directoryNamed: id asString) assureExistence; yourself ! Item was changed: ----- Method: SMAccount>>email: (in category 'accessing') ----- email: address email := address! Item was changed: ----- Method: SMAccount>>initialize (in category 'initialize-release') ----- initialize "Initialize account." super initialize. initials := signature := advogatoId := ''. isAdmin := false. objects := OrderedCollection new. coObjects := OrderedCollection new! Item was changed: ----- Method: SMAccount>>initials: (in category 'accessing') ----- initials: aString "If these are changed we need to update the dictionary in the map." initials ~= aString ifTrue: [ initials := aString. map clearUsernames]! Item was changed: ----- Method: SMAccount>>isAdmin: (in category 'accessing') ----- isAdmin: aBoolean isAdmin := aBoolean! Item was changed: ----- Method: SMAccount>>newPassword: (in category 'accessing') ----- newPassword: aHashNumber "Set the parallell password hash." newPassword := aHashNumber! Item was changed: ----- Method: SMAccount>>password: (in category 'accessing') ----- password: aHashNumber "Set the password hash." password := aHashNumber! Item was changed: ----- Method: SMAccount>>setNewPassword: (in category 'passwords') ----- setNewPassword: aString "Set a new parallell password the user can use to get in if the old password is forgotten. We don't delete the old password since the request for this new password is made anonymously. Note that the password is stored as a secured hash large integer." newPassword := SecureHashAlgorithm new hashMessage: aString! Item was changed: ----- Method: SMAccount>>setPassword: (in category 'passwords') ----- setPassword: aString "We also clear the random extra password." password := SecureHashAlgorithm new hashMessage: aString. newPassword := nil! Item was changed: ----- Method: SMAccount>>signature: (in category 'accessing') ----- signature: aSignature "Set the signature." signature := aSignature! Item was changed: ----- Method: SMCategorizableObject>>addCategory: (in category 'private') ----- addCategory: aCategory "Add <aCategory> to me. If I already have it do nothing." categories ifNil: [categories := OrderedCollection new]. (categories includes: aCategory) ifFalse:[ aCategory addObject: self. categories add: aCategory]. ^aCategory! Item was changed: ----- Method: SMCategory>>addCategory: (in category 'private') ----- addCategory: cat "Add a category as a subcategory to self. The collection of subcategories is lazily instantiated." subCategories ifNil: [subCategories := OrderedCollection new]. cat parent ifNotNil: [cat parent removeCategory: cat ]. subCategories add: cat. cat parent: self. ^cat! Item was changed: ----- Method: SMCategory>>delete (in category 'private') ----- delete "Delete me. Disconnect me from my objects and my parent. Then delete my subcategories." super delete. self removeFromObjects; removeFromParent. self subCategories do: [:c | c delete ]! Item was changed: ----- Method: SMCategory>>initialize (in category 'initialize-release') ----- initialize super initialize. name := summary := url := ''. objects := OrderedCollection new! Item was changed: ----- Method: SMCategory>>mandatory: (in category 'accessing') ----- mandatory: aSet mandatory := aSet! Item was changed: ----- Method: SMCategory>>parent: (in category 'private') ----- parent: aCategory "Change the parent category. This method relies on that somebody else updates the parent's subCategories collection." parent := aCategory! Item was changed: ----- Method: SMDVSInstaller>>install (in category 'services') ----- install "Install using DVS." | imagePackageLoader streamPackageLoader packageInfo packageManager baseName current new manager | self cache; unpack. imagePackageLoader := Smalltalk at: #ImagePackageLoader ifAbsent: []. streamPackageLoader := Smalltalk at: #StreamPackageLoader ifAbsent: []. packageInfo := Smalltalk at: #PackageInfo ifAbsent: []. packageManager := Smalltalk at: #FilePackageManager ifAbsent: []. ({ imagePackageLoader. streamPackageLoader. packageInfo. packageManager } includes: nil) ifTrue: [ (self confirm: ('DVS support is not loaded, but would be helpful in loading ', unpackedFileName, '. It isn''t necessary, but if you intend to use DVS later it would be a good idea to load it now. Load it from SqueakMap?')) ifTrue: [ self class loadDVS. ^self install ] ifFalse: [ ^self fileIn ]]. baseName := packageRelease name. dir rename: unpackedFileName toBe: (baseName, '.st'). unpackedFileName := baseName, '.st'. (manager := packageManager allManagers detect: [ :pm | pm packageName = baseName ] ifNone: []) ifNotNil: [ current := imagePackageLoader new package: (packageInfo named: baseName). new := streamPackageLoader new stream: (dir readOnlyFileNamed: unpackedFileName). (new changesFromBase: current) fileIn ] ifNil: [ self fileIn. manager := packageManager named: baseName. ]. manager directory: dir. packageManager changed: #allManagers. packageRelease noteInstalled! Item was changed: ----- Method: SMDocument>>author: (in category 'accessing') ----- author: aString author := aString! Item was changed: ----- Method: SMDocument>>description: (in category 'accessing') ----- description: aString description := aString! Item was changed: ----- Method: SMExternalResource>>downloadUrl: (in category 'accessing') ----- downloadUrl: anUrl downloadUrl := anUrl! Item was changed: ----- Method: SMFileCache>>directoryForPackage: (in category 'accessing') ----- directoryForPackage: aPackage "Returns the local path for storing the package cache's package file area. This also ensures that the path exists." | slash path dir | slash := FileDirectory slash. path := 'packages' , slash , aPackage id asString36 , slash. dir := FileDirectory default on: self directory fullName, slash, path. dir assureExistence. ^dir! Item was changed: ----- Method: SMFileCache>>directoryForPackageRelease: (in category 'accessing') ----- directoryForPackageRelease: aPackageRelease "Returns the local path for storing the package cache's version of a package file. This also ensures that the path exists." | slash path dir | slash := FileDirectory slash. path := 'packages' , slash , aPackageRelease package id asString36 , slash , aPackageRelease automaticVersionString. dir := FileDirectory default on: self directory fullName, slash, path. dir assureExistence. ^dir! Item was changed: ----- Method: SMFileCache>>directoryForResource: (in category 'accessing') ----- directoryForResource: aResource "Returns the local path for storing the package cache's version of a resource file. This also ensures that the path exists." | slash path dir | slash := FileDirectory slash. path := 'resources' , slash , aResource id asString36. dir := FileDirectory default on: self directory fullName, slash, path. dir assureExistence. ^dir! Item was changed: ----- Method: SMFileCache>>forMap: (in category 'initialize') ----- forMap: aMap "Initialize the ache, make sure the cache dir exists." map := aMap! Item was changed: ----- Method: SMInstaller class>>classForPackageRelease: (in category 'instance creation') ----- classForPackageRelease: aPackageRelease "Decide which subclass to instantiate. We detect and return the first subclass that wants to handle the release going recursively leaf first so that subclasses gets first chance if several classes compete over the same packages, like for example SMDVSInstaller that also uses the .st file extension." self subclasses do: [:ea | (ea classForPackageRelease: aPackageRelease) ifNotNilDo: [:class | ^ class]]. ^(self canInstall: aPackageRelease) ifTrue: [self]! Item was changed: ----- Method: SMInstaller class>>forPackageRelease: (in category 'deprecated') ----- forPackageRelease: aPackageRelease "Instantiate the first class suitable to install the package release. If no installer class is found we raise an Error." | class | aPackageRelease ifNil: [self error: 'No package release specified to find installer for.']. class := self classForPackageRelease: aPackageRelease. ^class ifNil: [self error: 'No installer found for package ', aPackageRelease name, '.'] ifNotNil: [class new packageRelease: aPackageRelease]! Item was changed: ----- Method: SMInstaller>>packageRelease: (in category 'accessing') ----- packageRelease: aPackageRelease packageRelease := aPackageRelease! Item was changed: ----- Method: SMMcInstaller class>>canInstall: (in category 'testing') ----- canInstall: aPackage "Is this a Monticello package and do I have MCInstaller or Monticello available?" | fileName | ((Smalltalk includesKey: #MCMczReader) or: [ Smalltalk includesKey: #MczInstaller]) ifTrue: [ fileName := aPackage downloadFileName. fileName ifNil: [^false]. ^ 'mcz' = (FileDirectory extensionFor: fileName) asLowercase]. ^false! Item was changed: ----- Method: SMMcInstaller>>fileIn (in category 'private') ----- fileIn | extension | extension := (FileDirectory extensionFor: fileName) asLowercase. extension = 'mcz' ifTrue: [self installMcz] ifFalse: [self error: 'Cannot install file of type .', extension]! Item was changed: ----- Method: SMObject>>id: (in category 'accessing') ----- id: anId id := anId! Item was changed: ----- Method: SMObject>>initialize (in category 'initialize-release') ----- initialize "Initialize the receiver." updated := created := TimeStamp current asSeconds. name := summary := url := ''.! Item was changed: ----- Method: SMObject>>map: (in category 'accessing') ----- map: aMap map := aMap! Item was changed: ----- Method: SMObject>>map:id: (in category 'initialize-release') ----- map: aMap id: anId "Initialize the receiver." self initialize. map := aMap. id := anId! Item was changed: ----- Method: SMObject>>name: (in category 'accessing') ----- name: aName name := aName! Item was changed: ----- Method: SMObject>>stampAsUpdated (in category 'updating') ----- stampAsUpdated "This method should be called whenever the object is modified." updated := TimeStamp current asSeconds! Item was changed: ----- Method: SMObject>>summary: (in category 'accessing') ----- summary: aString summary := aString! Item was changed: ----- Method: SMObject>>url: (in category 'accessing') ----- url: aString url := aString! Item was changed: ----- Method: SMPackage>>isSafelyOld (in category 'testing') ----- isSafelyOld "Answer if I am installed and there also is a newer published version for this version of Squeak available." | installed | installed := self installedRelease. ^installed ifNil: [false] ifNotNil: [ ^(self lastPublishedReleaseForCurrentSystemVersionNewerThan: installed) notNil]! Item was changed: ----- Method: SMPackage>>isSafelyOldAndUpgradeable (in category 'testing') ----- isSafelyOldAndUpgradeable "Answer if I am installed and there also is a newer published version for this version of Squeak available that can be upgraded to (installer support)." | installed newRelease | installed := self installedRelease. ^installed ifNil: [false] ifNotNil: [ newRelease := self lastPublishedReleaseForCurrentSystemVersionNewerThan: installed. ^newRelease ifNil: [false] ifNotNil: [newRelease isUpgradeable]]! Item was changed: ----- Method: SMPackage>>packageInfoName: (in category 'accessing') ----- packageInfoName: aString packageInfoName := aString! Item was changed: ----- Method: SMPackage>>releaseWithId: (in category 'services') ----- releaseWithId: anIdString "Look up a specific package release of mine. Return nil if missing. They are few so we just do a #select:." | anId | anId := UUID fromString: anIdString. releases detect: [:rel | rel id = anId ]. ^nil! Item was changed: ----- Method: SMPackage>>upgrade (in category 'installation') ----- upgrade "Upgrade to the latest newer published version for this version of Squeak." | installed | installed := self installedRelease. installed ifNil: [self error: 'No release installed, can not upgrade.'] ifNotNil: [^installed upgrade]! Item was changed: ----- Method: SMPackage>>upgradeOrInstall (in category 'installation') ----- upgradeOrInstall "Upgrade to or install the latest newer published version for this version of Squeak." | installed | installed := self installedRelease. installed ifNil: [^self install] ifNotNil: [^installed upgrade]! Item was changed: ----- Method: SMPackage>>versionLabel (in category 'installation') ----- versionLabel "Return a label indicating installed and available version as: '1.0' = 1.0 is installed and no new published version for this version of Squeak is available '1.0->1.1' = 1.0 is installed and 1.1 is published for this version of Squeak '->1.1' = No version is installed and 1.1 is published for this version of Squeak '->(1.1) = No version is installed and there is only a non published version available for this version of Squeak The version showed is the one that #smartVersion returns. If a version name is in parenthesis it is not published." | installedVersion r r2 | r := self installedRelease. r ifNotNil: [ installedVersion := r smartVersion. r2 := self lastPublishedReleaseForCurrentSystemVersionNewerThan: r] ifNil: [ installedVersion := ''. r2 := self lastPublishedReleaseForCurrentSystemVersion ]. ^r2 ifNil: [installedVersion ] ifNotNil: [installedVersion, '->', r2 smartVersion].! Item was changed: ----- Method: SMPackageRelease>>package: (in category 'private') ----- package: aPackage "Set when I am created." package := aPackage! Item was changed: ----- Method: SMPackageRelease>>upgrade (in category 'services') ----- upgrade "Upgrade this package release if there is a new release available." | newRelease | newRelease := package lastPublishedReleaseForCurrentSystemVersionNewerThan: self. newRelease ifNotNil: [(SMInstaller forPackageRelease: newRelease) upgrade]! Item was changed: ----- Method: SMPersonalObject>>owner: (in category 'accessing') ----- owner: anAccount owner := anAccount! Item was changed: ----- Method: SMProjectInstaller class>>canInstall: (in category 'testing') ----- canInstall: aPackage "Answer if this class can install the package. We handle .pr files (upper and lowercase)" | fileName | fileName := aPackage downloadFileName. fileName ifNil: [^false]. ^'pr' = (FileDirectory extensionFor: fileName) asLowercase! Item was changed: ----- Method: SMResource>>version: (in category 'accessing') ----- version: aVersion version := aVersion! Item was changed: ----- Method: SMSimpleInstaller>>cache (in category 'services') ----- cache "Download object into cache if needed. Set the directory and fileName for subsequent unpacking and install." packageRelease ensureInCache ifTrue: [ fileName := packageRelease downloadFileName. dir := packageRelease cacheDirectory]! Item was changed: ----- Method: SMSimpleInstaller>>download (in category 'services') ----- download "This service downloads the last release of the package even if it is in the cache already." packageRelease download ifTrue: [ fileName := packageRelease downloadFileName. dir := packageRelease cacheDirectory]! Item was changed: ----- Method: SMSimpleInstaller>>fileName: (in category 'accessing') ----- fileName: aFileName fileName := aFileName! Item was changed: ----- Method: SMSqueakMap class>>clear (in category 'instance creation') ----- clear "Clear out the model in the image. This will forget about what packages are installed and what versions. The map is itself on disk though and will be reloaded. If you only want to reload the map and not forget about installed packages then use 'SMSqueakMap default reload'. If you want to throw out the map perhaps when shrinking an image, then use 'SMSqueakMap default purge'." "SMSqueakMap clear" DefaultMap := nil! Item was changed: ----- Method: SMSqueakMap class>>default (in category 'instance creation') ----- default "Return the default map, create one if missing." "SMSqueakMap default" ^DefaultMap ifNil: [DefaultMap := self new]! Item was changed: ----- Method: SMSqueakMap class>>findServer (in category 'server detection') ----- findServer "Go through the list of known master servers, ping each one using simple http get on a known 'ping'-url until one responds return the server name. If some servers are bypassed we write that to Transcript. If all servers are down we inform the user and return nil." | notAnswering deafServers | Socket initializeNetwork. notAnswering := OrderedCollection new. Cursor wait showWhile: [ServerList do: [:server | (self pingServer: server) ifTrue: [notAnswering isEmpty ifFalse: [deafServers := String streamContents: [:str | notAnswering do: [:srvr | str nextPutAll: srvr printString; nextPut: Character cr]]. Transcript show: ('These SqueakMap master servers did not respond:\' , deafServers , 'Falling back on ' , server printString , '.') withCRs]. ^ server] ifFalse: [notAnswering add: server]]]. deafServers := String streamContents: [:str | notAnswering do: [:srvr | str nextPutAll: srvr printString; nextPut: Character cr]]. self error: ('All SqueakMap master servers are down:\' , deafServers , '\ \Can not update SqueakMap...') withCRs. ^ nil! Item was changed: ----- Method: SMSqueakMap>>accountWithId: (in category 'queries') ----- accountWithId: anIdString "Look up an account. Return nil if missing. Raise error if it is not an account." | account | account := self objectWithId: anIdString. account ifNil: [^nil]. account isAccount ifTrue:[^account]. self error: 'UUID did not map to a account.'! Item was changed: ----- Method: SMSqueakMap>>accounts (in category 'accessing') ----- accounts "Lazily maintain a cache of all known account objects." accounts ifNotNil: [^accounts]. accounts := objects select: [:o | o isAccount]. ^accounts! Item was changed: ----- Method: SMSqueakMap>>adminPassword: (in category 'accessing') ----- adminPassword: aString "We store the password as a SHA hash so that we can let the slave maps have it too." adminPassword := SecureHashAlgorithm new hashMessage: aString! Item was changed: ----- Method: SMSqueakMap>>categoryWithId: (in category 'queries') ----- categoryWithId: anIdString "Look up a category. Return nil if missing. Raise error if it is not a category." | cat | cat := self objectWithId: anIdString. cat ifNil: [^nil]. cat isCategory ifTrue:[^cat]. self error: 'UUID did not map to a category.'! Item was changed: ----- Method: SMSqueakMap>>categoryWithNameBeginning: (in category 'queries') ----- categoryWithNameBeginning: aString "Look up a category beginning with <aString>. Return nil if missing. We return the shortest matching one. We also strip out spaces and ignore case in both <aString> and the names." | candidates shortest answer searchString | searchString := (aString asLowercase) copyWithout: Character space. candidates := self categories select: [:cat | ((cat name asLowercase) copyWithout: Character space) beginsWith: searchString ]. shortest := 1000. candidates do: [:ca | ca name size < shortest ifTrue:[answer := ca. shortest := ca name size]]. ^answer ! Item was changed: ----- Method: SMSqueakMap>>clearCaches (in category 'private') ----- clearCaches "Clear the caches." packages := accounts := users := categories := nil ! Item was changed: ----- Method: SMSqueakMap>>clearCachesFor: (in category 'private') ----- clearCachesFor: anObject "Clear the valid caches." anObject isPackage ifTrue:[packages := nil]. anObject isAccount ifTrue:[accounts := users := nil]. anObject isCategory ifTrue:[categories := nil] ! Item was changed: ----- Method: SMSqueakMap>>clearUsernames (in category 'private') ----- clearUsernames "Clear the username cache." users := nil! Item was changed: ----- Method: SMSqueakMap>>installPackage: (in category 'public-installation') ----- installPackage: aPackage "Install the package. Note: This method should not be used anymore, better to specify a specific release." | rel | rel := aPackage lastPublishedReleaseForCurrentSystemVersion ifNil: [self error: 'No published release for this system version found to install.']. ^self installPackageRelease: rel! Item was changed: ----- Method: SMSqueakMap>>installPackage:autoVersion: (in category 'public-installation') ----- installPackage: aPackage autoVersion: version "Install the release <version> of <aPackage. <version> is the automatic version name." | r | r := aPackage releaseWithAutomaticVersionString: version. r ifNil: [self error: 'No package release found with automatic version ', version]. ^self installPackageRelease: r! Item was changed: ----- Method: SMSqueakMap>>installPackageNamed: (in category 'public-installation') ----- installPackageNamed: aString "Install the last published release for this Squeak version of the package with a name beginning with aString (see method comment of #packageWithNameBeginning:). Note: This method should not be used anymore. Better to specify a specific release." | p | p := self packageWithNameBeginning: aString. p ifNil: [self error: 'No package found with name beginning with ', aString]. ^self installPackage: p! Item was changed: ----- Method: SMSqueakMap>>installPackageNamed:autoVersion: (in category 'public-installation') ----- installPackageNamed: aString autoVersion: version "Install the release <version> of the package with a name beginning with aString (see method comment of #packageWithNameBeginning:). <version> is the automatic version name." | p r | p := self packageWithNameBeginning: aString. p ifNil: [self error: 'No package found with name beginning with ', aString]. r := p releaseWithAutomaticVersionString: version. r ifNil: [self error: 'No package release found with automatic version ', version]. ^self installPackageRelease: r! Item was changed: ----- Method: SMSqueakMap>>installPackageReleaseWithId: (in category 'public-installation') ----- installPackageReleaseWithId: anUUIDString "Look up and install the given release." | r | r := self packageReleaseWithId: anUUIDString. r ifNil: [self error: 'No package release available with id: ''', anUUIDString, '''']. ^self installPackageRelease: r! Item was changed: ----- Method: SMSqueakMap>>installPackageWithId: (in category 'public-installation') ----- installPackageWithId: anUUIDString "Look up and install the latest release of the given package. Note: This method should not be used anymore. Better to specify a specific release." | package | package := self packageWithId: anUUIDString. package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. ^self installPackage: package! Item was changed: ----- Method: SMSqueakMap>>installPackageWithId:autoVersion: (in category 'public-installation') ----- installPackageWithId: anUUIDString autoVersion: version "Install the release <version> of the package with id <anUUIDString>. <version> is the automatic version name." | p | p := self packageWithId: anUUIDString. p ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. ^self installPackage: p autoVersion: version! Item was changed: ----- Method: SMSqueakMap>>loadUpdatesFull: (in category 'private') ----- loadUpdatesFull: full "Find a server and load updates from it." | server | server := self class findServer. server ifNotNil: [ self synchWithDisk. full ifTrue: [self loadFullFrom: server] ifFalse:[self error: 'Not supported yet!!'."self loadUpdatesFrom: server"]]! Item was changed: ----- Method: SMSqueakMap>>mutex (in category 'transactions') ----- mutex "Lazily initialize the Semaphore." ^mutex ifNil: [mutex := Semaphore forMutualExclusion]! Item was changed: ----- Method: SMSqueakMap>>newAccount:username:email: (in category 'public-master') ----- newAccount: name username: username email: email "Create an account. Checking for previous account should already have been done. To add the account to the map, use SMSqueakMap>>addObject:" | account | account := self newAccount name: name; initials: username; email: email. ^account ! Item was changed: ----- Method: SMSqueakMap>>noteInstalledPackageNamed:autoVersion: (in category 'public-installation') ----- noteInstalledPackageNamed: aString autoVersion: aVersion "Mark that the package release was just successfully installed. <aVersion> is the automatic version as a String. Can be used to inform SM of an installation not been done using SM." | p | p := self packageWithNameBeginning: aString. p ifNil: [self error: 'No package found with name beginning with ', aString]. ^self noteInstalledPackage: p autoVersion: aVersion asVersion! Item was changed: ----- Method: SMSqueakMap>>packageCacheDirectory (in category 'accessing') ----- packageCacheDirectory "Return a FileDirectory for the package cache of the map. Creates it if it is missing." | dirName baseDir | dirName := self packageCacheDirectoryName. baseDir := self directory. (baseDir fileOrDirectoryExists: dirName) ifFalse:[baseDir createDirectory: dirName]. ^baseDir directoryNamed: dirName! Item was changed: ----- Method: SMSqueakMap>>packageReleaseWithId: (in category 'queries') ----- packageReleaseWithId: anIdString "Look up a package release. Return nil if missing. Raise error if it is not a package release." | r | r := self objectWithId: anIdString. r ifNil: [^nil]. r isPackageRelease ifTrue:[^r]. self error: 'UUID did not map to a package release.'! Item was changed: ----- Method: SMSqueakMap>>packageWithId: (in category 'queries') ----- packageWithId: anIdString "Look up a package. Return nil if missing. Raise error if it is not a package." | package | package := self objectWithId: anIdString. package ifNil: [^nil]. package isPackage ifTrue:[^package]. self error: 'UUID did not map to a package.'! Item was changed: ----- Method: SMSqueakMap>>packageWithNameBeginning: (in category 'queries') ----- packageWithNameBeginning: aString "Look up a package beginning with <aString>. Return nil if missing. We return the shortest matching one. We also strip out spaces and ignore case in both <aString> and the names." | candidates shortest answer searchString | searchString := (aString asLowercase) copyWithout: Character space. candidates := self packages select: [:package | ((package name asLowercase) copyWithout: Character space) beginsWith: searchString ]. shortest := 1000. candidates do: [:package | package name size < shortest ifTrue:[answer := package. shortest := package name size]]. ^answer ! Item was changed: ----- Method: SMSqueakMap>>packages (in category 'accessing') ----- packages "Lazily maintain a cache of all known package objects." packages ifNotNil: [^packages]. objects ifNil: [^#()]. packages := objects select: [:o | o isPackage]. ^packages! Item was changed: ----- Method: SMSqueakMap>>setDirty (in category 'transactions') ----- setDirty "Set the map modified so that it will get written to disk." isDirty := true! Item was changed: ----- Method: SMSqueakMap>>silentlyDo: (in category 'public-installation') ----- silentlyDo: aBlock "Execute <aBlock> with the Silent flag set. This is a crude way of avoiding user interaction during batch operations, like loading updates." [silent := true. aBlock value] ensure: [silent := nil]! Item was changed: ----- Method: SMSqueakMap>>transaction: (in category 'transactions') ----- transaction: aBlock "Execute aBlock and then make sure any modified SMObjects are committed to disk. We do this inside a mutex in order to serialize transactions. Transactions must be initiated from service methods in this class and not from inside the domain objects - otherwise they could get nested and a deadlock occurs." "In first version of SM2 we simply set the isDirty flag, when next client asks for updates, or 30 minutes has passed, we checkpoint." " self mutex critical: [" aBlock value. isDirty := true " ]" " self mutex critical: [ dirtyList := OrderedCollection new. aBlock value. dirtyList do: [:obj | obj commit]. dirtyList := nil ]"! Item was changed: ----- Method: SMSqueakMap>>upgradeOldPackagesConfirmBlock: (in category 'public-installation') ----- upgradeOldPackagesConfirmBlock: aBlock "First we find out which of the installed packages are upgradeable and old. Then we upgrade them if confirmation block yields true. The block will be called with each SMPackage to upgrade. We return a Dictionary with the packages we tried to upgrade as keys and the value being the result of the upgrade, true or false." | result | result := Dictionary new. self upgradeableAndOldPackages do: [:package | (aBlock value: package) ifTrue:[ result at: package put: package upgrade]]. ^result ! Item was changed: ----- Method: SMSqueakMap>>upgradeOrInstallPackageWithId: (in category 'public-installation') ----- upgradeOrInstallPackageWithId: anUUIDString "Upgrade package (or install) to the latest published release for this Squeak version." | package | package := self packageWithId: anUUIDString. package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. ^package upgradeOrInstall! Item was changed: ----- Method: SMSqueakMap>>upgradePackageWithId: (in category 'public-installation') ----- upgradePackageWithId: anUUIDString "Upgrade package to the latest published release for this Squeak version. Will raise error if there is no release installed, otherwise use #upgradeOrInstallPackageWithId: " | package | package := self packageWithId: anUUIDString. package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. ^package upgrade! Item was changed: ----- Method: SMSqueakMap>>users (in category 'accessing') ----- users "Lazily maintain a cache of all known account objects keyed by their developer initials." users ifNotNil: [^users]. users := Dictionary new. self accounts do: [:a | users at: a initials put: a]. ^users! Item was changed: ----- Method: SMUtilities class>>mailServer:masterServer: (in category 'class initialization') ----- mailServer: ipName masterServer: httpUrl "Initialize server settings." MailServer := ipName. MasterServer := httpUrl! Item was changed: ----- Method: SMUtilities class>>stripNameFrom: (in category 'utilities') ----- stripNameFrom: aString "Picks out the name from: 'Robert Robertson <rob(a)here.com>' => 'Robert Robertson' " | lessThan | lessThan := aString indexOf: $<. ^(aString copyFrom: 1 to: lessThan - 1) withBlanksTrimmed !

1 0

Squeak 4.5: Protocols-bf.47.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Protocols to project Squeak 4.5: http://source.squeak.org/squeak45/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

The Trunk: Network-bf.157.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-bf.157.mcz ==================== Summary ==================== Name: Network-bf.157 Author: bf Time: 8 December 2014, 1:57:48.396 am UUID: f8529b69-72e6-4dec-bd3c-408fecda17eb Ancestors: Network-cmm.156 Restore timestamps lost in assignment conversion. =============== Diff against Network-cmm.156 =============== Item was changed: ----- Method: FileStream class>>httpPostDocument:args: (in category '*network') ----- httpPostDocument: url args: argsDict | argString | argString := argsDict ifNotNil: [argString := HTTPSocket argString: argsDict] ifNil: ['']. ^self post: argString url: url , argString ifError: [self halt]! Item was changed: ----- Method: FileStream class>>requestURL:target: (in category '*network') ----- requestURL: url target: target "FileStream requestURL:'http://isgwww.cs.uni-magdeburg.de/~raab' target: ':=blank' " ^self concreteStream new requestURL: url target: target! Item was changed: ----- Method: ProtocolClient>>ensureConnection (in category 'private') ----- ensureConnection self isConnected ifTrue: [^self]. self stream ifNotNil: [self stream close]. self stream: (SocketStream openConnectionToHost: self host port: self port). self checkResponse. self login! Item was changed: ----- Method: Socket>>getOption: (in category 'other') ----- getOption: aName "Get options on this socket, see Unix man pages for values for sockets, IP, TCP, UDP. IE SO_KEEPALIVE returns an array, element one is an status number (0 ok, -1 read only option) element two is the resulting of the requested option" (socketHandle == nil or: [self isValid not]) ifTrue: [InvalidSocketStatusException signal: 'Socket status must valid before getting an option']. ^self primSocket: socketHandle getOption: aName "| foo options | Socket initializeNetwork. foo := Socket newTCP. foo connectTo: (NetNameResolver addressFromString: '192.168.1.1') port: 80. foo waitForConnectionUntil: (Socket standardDeadline). options := { 'SO_DEBUG'. 'SO_REUSEADDR'. 'SO_REUSEPORT'. 'SO_DONTROUTE'. 'SO_BROADCAST'. 'SO_SNDBUF'. 'SO_RCVBUF'. 'SO_KEEPALIVE'. 'SO_OOBINLINE'. 'SO_PRIORITY'. 'SO_LINGER'. 'SO_RCVLOWAT'. 'SO_SNDLOWAT'. 'IP_TTL'. 'IP_HDRINCL'. 'IP_RCVOPTS'. 'IP_RCVDSTADDR'. 'IP_MULTICAST_IF'. 'IP_MULTICAST_TTL'. 'IP_MULTICAST_LOOP'. 'UDP_CHECKSUM'. 'TCP_MAXSEG'. 'TCP_NODELAY'. 'TCP_ABORT_THRESHOLD'. 'TCP_CONN_NOTIFY_THRESHOLD'. 'TCP_CONN_ABORT_THRESHOLD'. 'TCP_NOTIFY_THRESHOLD'. 'TCP_URGENT_PTR_TYPE'}. 1 to: options size do: [:i | | fum | fum :=foo getOption: (options at: i). Transcript show: (options at: i),fum printString;cr]. foo := Socket newUDP. foo setPeer: (NetNameResolver addressFromString: '192.168.1.9') port: 7. foo waitForConnectionUntil: (Socket standardDeadline). 1 to: options size do: [:i | | fum | fum :=foo getOption: (options at: i). Transcript show: (options at: i),fum printString;cr]. "! Item was changed: ----- Method: SocketStream class>>openConnectionToHost:port: (in category 'instance creation') ----- openConnectionToHost: hostIP port: portNumber | socket | socket := Socket new. socket connectTo: hostIP port: portNumber. ^self on: socket! Item was changed: ----- Method: SocketStream>>cr (in category 'stream out') ----- cr self nextPutAll: String cr! Item was changed: ----- Method: SocketStream>>crlf (in category 'stream out') ----- crlf self nextPutAll: String crlf! Item was changed: ----- Method: SocketStream>>isBinary (in category 'testing') ----- isBinary ^binary! Item was changed: ----- Method: SocketStream>>nextLine (in category 'stream in') ----- nextLine ^self nextLineCrLf! Item was changed: ----- Method: SocketStream>>nextLineLf (in category 'stream in') ----- nextLineLf | nextLine | nextLine := self upToAll: String lf. ^nextLine! Item was changed: ----- Method: SocketStream>>shouldTimeout (in category 'testing') ----- shouldTimeout ^self timeout > 0! Item was changed: ----- Method: SocketStream>>socket (in category 'configuration') ----- socket ^socket! Item was changed: ----- Method: SocketStream>>socket: (in category 'configuration') ----- socket: aSocket socket := aSocket! Item was changed: ----- Method: SocketStream>>space (in category 'stream out') ----- space self nextPut: Character space! Item was changed: ----- Method: String>>asUrl (in category '*network-url') ----- asUrl "convert to a Url" "'http://www.cc.gatech.edu/' asUrl" "msw://chaos.resnet.gatech.edu:9000/' asUrl" ^Url absoluteFromText: self! Item was changed: ----- Method: String>>asUrlRelativeTo: (in category '*network-url') ----- asUrlRelativeTo: aUrl ^aUrl newFromRelativeText: self!

1 0

← Newer
1
...
5
6
7
8
9
10
11
12
Older →