cook@hplabsz.HPL.HP.COM (William Cook) (11/10/90)
Hi there- This file contains a small application to compute the "interface hierarchy" of a collection of smalltalk classes. It also difines a simple tree layout editor to let you look at the result and move the nodes around. It is just a prototype.. the graphics code was written in about ten hours, which included learning how smalltalk does graphics. Enjoy -william cook ps: it also contains some patches to the smalltalk class hierarchy. ------------ AtDefault.st cut here ----------------------- !Dictionary methodsFor: 'accessing'! at: key default: aBlock | index assoc value | index _ self findKeyOrNil: key. assoc _ self basicAt: index. assoc isNil ifTrue: [ value _ aBlock value. self basicAt: index put: (Association key: key value: value). tally _ tally + 1 ] ifFalse: [ value _ assoc value ]. ^value! ! !IdentityDictionary methodsFor: 'accessing'! at: key default: aBlock | index value | index _ self findKeyOrNil: key. (self basicAt: index) isNil ifTrue: [ tally _ tally + 1. value _ aBlock value. self basicAt: index put: key. valueArray basicAt: index put: value. ] ifFalse: [ value _ valueArray basicAt: index ]. ^value! ! !IdentityDictionary methodsFor: 'dictionary enumerating'! associatedDo: aBlock 1 to: self basicSize do: [ :index | (self basicAt: index) == nil ifFalse: [ aBlock value: (self basicAt: index) value: (valueArray at: index) ] ] ! ! !Dictionary methodsFor: 'dictionary enumerating'! associatedDo: aBlock "Evaluate aBlock for each of the receiver's keys and values." self associationsDo: [:association | aBlock value: association key value: association value]! ! -----------------ComparableSet.st cut here ------------------------------ Set variableSubclass: #ComparableSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered' ! ComparableSet comment: 'A set that can be compared and intersectied' ! !ComparableSet methodsFor: 'accessing'! pick "pick a random element from the set" " (ComparableSet with: 43 with: 18) pick" | index length probe | tally = 0 ifTrue: [^nil]. index _ 1. length _ self basicSize. [index <= length & (probe _ self basicAt: index) == nil] whileTrue: [index _ index + 1]. ^probe! ! !ComparableSet methodsFor: 'operating'! removeAll: aCollection ifAbsent: aBlock "Remove each element of aCollection from the receiver. If successful for each, answer aCollection." aCollection do: [:each | self remove: each ifAbsent: aBlock]. ^aCollection ! intersect: otherSet "Answer the intersection of two sets" | intersection | intersection _ self species new. self do: [ :elem | (otherSet includes: elem) ifTrue: [ intersection add: elem ] ]. ^ intersection! ! !ComparableSet methodsFor: 'comparing'! = otherSet "compare two sets" ^(self size == otherSet size) and: [ (otherSet includesAll: self) and: [ self includesAll: otherSet ] ] ! erase self become: ComparableSet new. ! hash "Return the hash code for the members of the set. Since order is unimportant; we use a commutative operator to compute the hash value." ^self inject: tally into: [ :hashValue :member | hashValue + member hash ] ! includesAll: otherSet "determine if this set is a subset of another set" (otherSet size > self size) ifTrue: [ ^false ]. otherSet do: [ :elem | (self includes: elem) ifFalse: [ ^false ] ]. ^true! ! -------------Driver.st cut here --------------------------- | ih | #( Object "Collection subclasses" Collection Bag SequenceableCollection MappedCollection Set OrderedCollection LinkedList Interval ArrayedCollection SortedCollection RunArray IntegerArray Array Text String WordArray ByteArray Symbol TwoByteString ByteString TwoByteSymbol ByteSymbol IdentitySet Dictionary IdentityDictionary "Magnitude subclasses" " commented out for now Magnitude Time Character ArithmeticValue Date Point Number LimitedPrecisionReal Fraction Integer Float LargeNegativeInteger SmallInteger LargePositiveInteger " "Stream subclasses" " commented out for now Stream PeekableStream Random PositionableStream InternalStream ExternalStream ReadStream WriteStream TextStream ReadWriteStream BufferedExternalStream ExternalReadStream ExternalWriteStream ExternalReadAppendStream ExternalReadWriteStream " ) do: [ :aClass | ih add: (Smalltalk at: aClass) ]. ih _ InterfaceHierarchy new initialize. ih computeHierarchy. "you have two options:" ih printOn: 'Hierarchy.data' "or if you are adventuresome... ih tree. " ------------- InterfaceHierarchy.st cut here --------------------------- 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 10 July 1990 on 9 November 1990 at 12:52:11 pm'! Object variableSubclass: #InterfaceHierarchy instanceVariableNames: 'classMap selectorMap selectors deltas categories ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Tree Editor'! !InterfaceHierarchy methodsFor: 'accessing'! add: aClass classMap at: (ComparableSet with: aClass) put: (Set new). aClass collectInterfaceInto: selectors. selectors do: [ :s | (selectorMap at: s default: [ ComparableSet new: 10 ]) add: aClass ]. 1 to: selectors basicSize do: [ :i | selectors basicAt: i put: nil ]. selectors setTally! ! !InterfaceHierarchy methodsFor: 'printing'! dump: name | file | "print out the hierarchy to a file" categories isNil ifTrue: [ self computeHierarchy. ]. file _ (Filename named: name) writeStream. 1 to: categories size do: [ :i | (deltas at: i) isNil ifFalse: [ file nextPutAll: '--------------------------'; cr. file nextPutAll: 'Interface #'. i printOn: file. file cr. file nextPutAll: 'Message Selectors:'; cr. (classMap at: (categories at: i)) do: [ :s | file nextPutAll: ' '. s printOn: file. file cr ]. (deltas at: i) isEmpty ifFalse: [ file nextPutAll: 'Supporting Classes:'; cr. (deltas at: i) do: [ :c | file nextPutAll: ' '. c printOn: file. file cr ] ]. (categories parents: i) isEmpty ifFalse: [ file nextPutAll: 'Extended Interfaces:'; cr; nextPutAll: ' '. (categories parents: i) do: [ :k | file nextPutAll: ' '. k printOn: file ]. file cr ]. (categories children: i) isEmpty ifFalse: [ file nextPutAll: 'Interface Extensions'; cr; nextPutAll: ' '. (categories children: i) do: [ :k | file nextPutAll: ' '. k printOn: file ]. file cr ]. file cr ] ]. file close! tree "open up a tree editor window on me... weee..." | stream forms cr | categories isNil ifTrue: [ self computeHierarchy. ]. forms _ Array new: categories size. 1 to: categories size do: [ :i | (deltas at: i) isNil ifTrue: [ forms at: i put: nil ] ifFalse: [ stream _ WriteStream on: (String new: 50). (deltas at: i) isEmpty ifTrue: [ | sorted | sorted _ (classMap at: (categories at: i)) asSortedCollection: [ :x :y | x size < y size ]. 1 to: (3 min: sorted size) do: [ :n | n > 1 ifTrue: [ stream cr ]. stream nextPutAll: (sorted at: n) printString. ]. ] ifFalse: [ cr _ false. (deltas at: i) do: [ :class | cr ifTrue: [ stream cr ]. cr _ true. stream nextPutAll: class printString. ]. ]. forms at: i put: stream contents asParagraph. "Transcript show: (forms at: i) extent printString." ] ]. ^TreeEditor edit: (Association key: categories value: forms)! ! !InterfaceHierarchy methodsFor: 'private'! categories ^categories! computeHierarchy | foo | "now selectorMap has all the selectors, with name of the interface it is part of. all we have to do now is find out which of the keys are the same, and put each method into its place" selectorMap associatedDo: [ :selector :classes | (classMap at: classes default: [ Set new: 51 ]) add: selector ]. "compute containments on sets of class names" categories _ TopologicalSort sortBlock: [ :x :y | x size > y size ]. categories topology: [ :x :y | x includesAll: y ]. classMap keysDo: [ :key | categories add: key ]. "make categories into deltas" deltas _ OrderedCollection new: categories size. 1 to: categories size do: [ :i | foo _ (categories at: i) copy. (categories children: i) do: [ :c | foo removeAll: (categories at: c) ifAbsent: [] ]. deltas addLast: foo ]. "remove sets that have no methods and only one parent" "and fix up ones with no methods and siblings with the same parents" 1 to: categories size do: [ :i | "check selectors" foo _ categories at: i. (classMap at: foo) isEmpty ifTrue: [ (categories parents: i) size = 1 ifTrue: [ "only has one parent" "put this category into parent" (categories parents: i) do: [ :p | (deltas at: p) addAll: foo. deltas at: i put: nil. (categories children: p) remove: i ] ] ifFalse: [ Transcript show: 'premoting '. Transcript show: foo printString; cr. (categories join: (categories parents: i)) do: [ :j | i = j ifFalse: [ (categories parents: j) removeAll: (categories parents: i) ifAbsent: []. (categories parents: i) do: [ :k | (categories children: k) remove: j ifAbsent: [] ]. (categories parents: j) add: i. (categories children: i) add: j. ] ] ] ] ]! initialize classMap _ Dictionary new: 511. selectorMap _ IdentityDictionary new: 3749. selectors _ Set new: 211! ! ------------- MethodCheck.st cut here --------------------------- !CompiledMethod methodsFor: 'querying'! selfSendLiteral self shouldNotImplement ! selfReturnSendLiteral ^self notKeyedError ! isntReallyImplemented ^(self numLiterals = 1) and: [ (self bytes = (CompiledMethod compiledMethodAt: #selfSendLiteral) bytes or: [ self bytes = (CompiledMethod compiledMethodAt: #selfReturnSendLiteral) bytes ]) and: [ (self literalAt: 1) == #shouldNotImplement or: [ (self literalAt: 1) == #notKeyedError or: [ (self literalAt: 1) == #deepCopyError ]]]] ! ! !Behavior methodsFor: 'accessing the methodDictionary'! interface "selectors with the unimplemented ones weeded out" ^self collectInterfaceInto: Set new ! collectInterfaceInto: aSet "scan up the parent, removing unimplemented selectors it would be nice if this removed methods that depend upon other, unimplemented methods" | parent foo | self isVariable | (self == SequenceableCollection) ifTrue: [ aSet add: #at:. aSet add: #at:put: ]. parent _ self superclass. parent notNil ifTrue: [ parent collectInterfaceInto: aSet ]. self selectors do: [ :s | ((self == Object) and: [ (s == #at:) | (s == #at:put:) | (s == #basicAt:) | (s == #basicAt:put:)]) ifFalse: [ (self compiledMethodAt: s) isntReallyImplemented ifTrue: [ aSet remove: s ifAbsent: [] ] ifFalse: [ foo _ self whichCategoryIncludesSelector: s. foo notNil ifTrue: [ foo indexOfSubCollection: 'private' startingAt: 1 ifAbsent: [ aSet add: s ] ] ] ] ]. ^aSet! ! " Set interface MappedCollection interface SequenceableCollection interface " ------------- PartialOrder.st cut here --------------------------- 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 10 July 1990 on 9 November 1990 at 12:52:38 pm'! Object variableSubclass: #PartialOrder instanceVariableNames: 'children parents ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! !PartialOrder methodsFor: 'insertion'! put: a above: b (self children: a) add: b. (self parents: b) add: a.! ! !PartialOrder methodsFor: 'accessing'! children: i |elem| elem _ children at: i. elem isNil ifTrue: [ elem _ ComparableSet new. children at: i put: elem. ]. ^elem! childrenAt: i |elem| elem _ children at: i. elem isNil ifTrue: [ children at: i put: ComparableSet new. ]. ^elem! hasChain: low to: high "determine if there is a chain from low to high in an array viewed as a partial order" (self children: low) do: [ :next | (next == high or: [self hasChain: next to: high]) ifTrue: [ ^true ] ]. ^false! join: aSet "return the set of points that are the maximal elements below all elemets in aSet" | theJoin base continue | aSet size <= 1 ifTrue: [ ^aSet ] ifFalse: [ theJoin _ Set new. base _ aSet pick. self treeFrom: base do: [ :test | continue _ true. aSet detect: [ :limit | (limit ~= base) and: [ (self hasChain: limit to: test) not ] ] ifNone: [ continue _ false. theJoin detect: [ :a | self hasChain: a to: test ] ifNone: [ theJoin _ theJoin reject: [ :a | self hasChain: test to: a ] . theJoin add: test. ] ]. continue ] ]. ^theJoin! parents: i |elem| elem _ parents at: i. elem isNil ifTrue: [ elem _ ComparableSet new. parents at: i put: elem. ]. ^elem! ! !PartialOrder methodsFor: 'iterating'! breadthFirst: i do: aBlock | q e scanned | "march down tree, passing indecies below i to aBlock, as long as it returns true" scanned _ Set new. q _ OrderedCollection with: i. [ q isEmpty] whileFalse: [ e _ q removeFirst. scanned add: e. (aBlock value: e) ifTrue: [ (self children: e) do: [ :ix | ((scanned includes: ix) or: [ q includes: ix]) ifFalse: [q addLast: ix]. ] ] ]! treeFrom: i do: aBlock "march down tree, passing indecies below i to aBlock, as long as it returns true" (self children: i) do: [ :k | (aBlock value: k) ifTrue: [ self treeFrom: k do: aBlock ] ]! ! !PartialOrder methodsFor: 'private'! initialize: size children _ Array new: size. parents _ Array new: size.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PartialOrder class instanceVariableNames: ''! !PartialOrder class methodsFor: 'instance creation'! new: size ^(super new: size) initialize: size! ! ------------- TopologicalSort.st cut here --------------------------- 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 10 July 1990 on 9 November 1990 at 12:52:31 pm'! SortedCollection variableSubclass: #TopologicalSort instanceVariableNames: 'po topBlock valid ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! TopologicalSort comment: 'a topological sort of a sorted collection'! !TopologicalSort methodsFor: 'adding'! add: newObject valid _ false. ^super add: newObject! addAll: aCollection valid _ false. ^super addAll: aCollection! ! !TopologicalSort methodsFor: 'removing'! remove: oldObject ifAbsent: anExceptionBlock valid _ false. ^super remove: oldObject ifAbsent: anExceptionBlock! removeAllSuchThat: aBlock valid _ false. ^super removeAllSuchThat: aBlock! removeAtIndex: index valid _ false. ^super removeAtIndex: index! ! !TopologicalSort methodsFor: 'accessing'! children: i valid ifFalse: [ self computeTopology ]. ^po children: i! join: aSet valid ifFalse: [ self computeTopology ]. ^po join: aSet! parents: i valid ifFalse: [ self computeTopology ]. ^po parents: i! ! !TopologicalSort methodsFor: 'private'! computeTopology po _ PartialOrder new: self size. 1 to: self size - 1 do: [ :d | 1 to: self size - d do: [ :i | ((po hasChain: i to: i + d) not and: [ topBlock value: (self at: i) value: (self at: i + d) ]) ifTrue: [ po put: i above: i + d. ] ] ]. valid _ true! grow | savePo saveTopBlock saveValid | "this looks funny, but it is the only way to save our prescious stat variables" savePo _ po. saveValid _ valid. saveTopBlock _ topBlock. super grow. po _ savePo. valid _ saveValid. topBlock _ saveTopBlock! order ^po! topology " set the topological sort function" ^topBlock! topology: aBlock " set the topological sort function" valid _ false. topBlock _ aBlock! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TopologicalSort class instanceVariableNames: ''! !TopologicalSort class methodsFor: 'creation'! sortBlock: qs topology: rs "Answer a new instance of SortedCollection such that its elements are sorted according to the criterion specified in aBlock." ^(super sortBlock: qs) topology: rs! ! ------------- TreeEditor.st cut here --------------------------- 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 10 July 1990 on 9 November 1990 at 12:52:05 pm'! MouseMenuController subclass: #TreeEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Tree Editor'! TreeEditor comment: 'Edits trees, dummy'! !TreeEditor methodsFor: 'menu messages'! redButtonActivity | node | Cursor blank showWhile: [ node _ view selectedNode. node isNil ifFalse: [ self track: node. "view displayView" ]]! redisplay view displayView! save view save! yellowButtonActivity yellowButtonMenu isNil ifTrue: [ self initializeYellowButtonMenu ]. super yellowButtonActivity! ! !TreeEditor methodsFor: 'cursor'! cursorPoint "Answer the mouse coordinate data" ^sensor cursorPoint! ! !TreeEditor methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: (PopUpMenu labels: 'refresh save') yellowButtonMessages: #(redisplay save).! track: node | previousPoint cursorPoint base | base _ view insetDisplayBox origin. previousPoint _ self cursorPoint. [sensor anyButtonPressed] whileTrue: [ cursorPoint _ self cursorPoint. cursorPoint ~= previousPoint ifTrue: [ view displayNodeArcs: node. view locations at: node put: self cursorPoint - base. view displayNodeArcs: node. previousPoint _ cursorPoint ] ]. ^previousPoint! view ^view! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeEditor class instanceVariableNames: ''! !TreeEditor class methodsFor: 'instance creation'! edit: aTree "Create and schedule a StandardSystemView for a TreeEditor on aTree." "a Tree is an association of a partial order and a dictionary of forms." | topView treeView treeEditor | treeView _ TreeView new model: aTree. treeEditor _ self new. treeView controller: treeEditor. "sets our view to treeView" "does it thus set our model too? -- I think so" "treeView assignDefaultLocations." "took out stuff here... taken from FormEditor class createOnForm:" treeView label: 'Tree Editor'. treeView borderWidth: 2. topView _ StandardSystemView new. topView model: aTree. topView addSubView: treeView. topView label: 'Tree Editor'. topView borderWidth: 2. topView controller open. ^topView! ! ------------- TreeView.st cut here --------------------------- 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 10 July 1990 on 9 November 1990 at 12:51:58 pm'! StandardSystemView subclass: #TreeView instanceVariableNames: 'pen levelHeight locations maxLevel ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Tree Editor'! !TreeView methodsFor: 'displaying'! displayNode: n | form | form _ model value at: n. form displayOn: Display at: (self insetDisplayBox origin + (locations at: n)) clippingBox: (self insetDisplayBox). ^form! displayNodeArcs: n | form | form _ model value at: n. form displayOn: Display at: (self insetDisplayBox origin + (locations at: n)) rule: Form reverse. self displaySuperArcs: n rule: Form reverse. self displaySubArcs: n rule: Form reverse. ^form! displaySubArcs: n rule: rule | form | form _ model value at: n. (model key children: n) do: [ :s | self drawLineFrom: (locations at: n) + (form width / 2 @ form height) to: (locations at: s) + ((model value at: s) width / 2 @ 0) rule: rule ]! displaySuperArcs: n rule: rule | form sform | form _ model value at: n. (model key parents: n) do: [ :s | sform _ (model value at: s). self drawLineFrom: (locations at: s) + (sform width / 2 @ sform height) to: (locations at: n) + (form width / 2 @ 0) rule: rule ]! displayView locations isNil ifTrue: [ self assignDefaultLocations ]. self clearInside. 1 to: model key size do: [ :n | (model value at: n) isNil ifFalse: [ self displayNode: n. self displaySubArcs: n rule: Form paint ]]! drawLineFrom: a to: b rule: rule Display drawLine: pen from: self insetDisplayBox origin + a to: self insetDisplayBox origin + b clippingBox: (self insetDisplayBox) rule: rule mask: Form black! selectedNode 1 to: model value size do: [ :n | (model value at: n) isNil ifFalse: [ ((Rectangle origin: (locations at: n) extent: (model value at: n) extent) containsPoint: (controller cursorPoint - self insetDisplayBox origin)) ifTrue: [^n] ] ]. ^nil! ! !TreeView methodsFor: 'private'! assignDefaultLocations | boundary height p spacing level bound widths counts | "ugh. THis is ugly." pen _ Form new extent: 1 @ 1. pen black. levelHeight _ Dictionary new. locations _ Dictionary new. boundary _ Dictionary new. widths _ Dictionary new. counts _ Dictionary new. maxLevel _ 0. self place: 1 atLevel: 1. 1 to: model key size do: [ :n | (model value at: n) isNil ifFalse: [ level _ locations at: n. bound _ widths at: level default: [0]. widths at: level put: (bound + (model value at: n) width). levelHeight at: level put: ((levelHeight at: level default: [0]) max: (model value at: n) height). counts at: level put: (counts at: level default: [0]) + 1. ] ]. height _ 0. 1 to: maxLevel do: [ :n | "Transcript show: 'width '; show: n printString; space; show: (widths at: n) printString; cr." widths at: n put: ((self insetDisplayBox width - (widths at: n)) // ((counts at: n) + 1)). height _ height + (levelHeight at: n). ]. model key order breadthFirst: 1 do: [ :n | level _ locations at: n. bound _ boundary at: level default: [widths at: level]. boundary at: level put: (bound + (model value at: n) width + (widths at: level)). locations at: n put: (bound @ level). true ]. spacing _ (self insetDisplayBox height - height) // (maxLevel + 1) max: 5. height _ 0. 1 to: maxLevel do: [ :level | p _ height. height _ height + (levelHeight at: level) + spacing. levelHeight at: level put: p ]. 1 to: model key size do: [ :n | (model value at: n) isNil ifFalse: [ p _ locations at: n. p y: (levelHeight at: p y) ] ]! locations ^locations! place: n atLevel: level (model value at: n) isNil ifFalse: [ locations at: n put: ((locations at: n default: [1]) max: level). maxLevel _ level max: maxLevel. (model key children: n) do: [ :s | self place: s atLevel: level + 1 ] ]! place: n in: boundary atLevel: level | bound h | (model value at: n) isNil ifFalse: [ (locations includesKey: n) ifFalse: [ maxLevel _ level max: maxLevel. (model key children: n) do: [ :s | self place: s in: boundary atLevel: level + 1 ]. h _ levelHeight at: level default: [0]. levelHeight at: level put: (h max: (model value at: n) height). bound _ boundary at: level default: [0]. locations at: n put: (bound @ level). boundary at: level put: bound + (model value at: n) width + 20. ] ]! save | file | file _ (Filename named: 'saved.tree') writeStream. file nextPutAll: model key size printString. file nextPutAll: '#('. 1 to: model key size do: [:n | (model value at: n ) isNil ifTrue: [ file nextPutAll: 'nil'; cr. ] ifFalse: [ file nextPut: $(. file nextPutAll: (locations at: n) x printString; space; nextPutAll: (locations at: n) y printString; cr; nextPut: $'; nextPutAll: (model value at: n) asString; nextPut: $'; cr. (model key children: n) do: [ :x | file nextPutAll: x printString; space ]. file nextPut: $) ; cr. ] ]. file nextPut: $) ; cr. file close! ! ------------- Fixes.st --------------------------- SequenceableCollection removeSelector: #remove:ifAbsent:! Dictionary organization classify: #grow under: 'private'! OrderedCollection organization classify: #grow under: 'private'! SortedCollection organization classify: #grow under: 'private'! SequenceableCollection organization classify: #grow under: 'private'! Set organization classify: #grow under: 'private'! !Interval methodsFor: 'adding'! addAll: aCollection "Provide an error notification that adding to an interval is not allowed." self shouldNotImplement! ! !Interval methodsFor: 'removing'! remove: newObject "Provide an error notification that removing an element from an Interval is not allowed." self shouldNotImplement! remove: newObject ifAbsent: aBlock "Provide an error notification that removing an element from an Interval is not allowed." self shouldNotImplement! removeAll: aCollection "Provide an error notification that removing elements from an Interval is not allowed." self shouldNotImplement! ! !Interval methodsFor: 'accessing'! at: anInteger put: anObject "Provide an error notification that storing into an interval is illegal." self shouldNotImplement! atAllPut: aValue "Provide an error notification that storing into an interval is illegal." self shouldNotImplement! atAll: aCollection put: aValue "Provide an error notification that storing into an interval is illegal." self shouldNotImplement! replaceFrom: a to: b with: c "Provide an error notification that storing into an interval is illegal." self shouldNotImplement! replaceFrom: a to: b with: c startingAt: d "Provide an error notification that storing into an interval is illegal." self shouldNotImplement! ! !MappedCollection methodsFor: 'adding'! addAll: aCollection "Provide an error notification that adding to a mapped collection is not allowed." self shouldNotImplement! ! !MappedCollection methodsFor: 'removing'! remove: newObject "Provide an error notification that removing an element from a MappedCollection is not allowed." self shouldNotImplement! remove: newObject ifAbsent: aBlock "Provide an error notification that removing an element from a MappedCollection is not allowed." self shouldNotImplement! removeAll: aCollection "Provide an error notification that removing elements from a MappedCollection is not allowed." self shouldNotImplement! ! !ArrayedCollection methodsFor: 'adding'! addAll: aCollection "Provide an error notification that adding to an array is not allowed." self shouldNotImplement! ! !ArrayedCollection methodsFor: 'removing'! remove: newObject "Provide an error notification that removing an element from an ArrayedCollection is not allowed." self shouldNotImplement! removeAll: aCollection "Provide an error notification that removing elements from an ArrayedCollection is not allowed." self shouldNotImplement! remove: oldObject ifAbsent: aBlock "Provide an error notification that removing an element from an ArrayedCollection is not allowed." self shouldNotImplement! ! !Dictionary methodsFor: 'removing'! removeAll: aCollection "Provide an error notification that removing an element from a Dictionary is not allowed." self shouldNotImplement! ! !SortedCollection methodsFor: 'accessing'! at: anInteger put: anObject "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! atAll: aCollection put: aValue "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! atAllPut: aValue "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! replaceFrom: a to: b with: c "Provide an error notification that replacing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! replaceFrom: a to: b with: c startingAt: d "Provide an error notification that replacing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! ! !SortedCollection methodsFor: 'adding'! addFirst: newObject "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! addLast: newObject "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! addAllFirst: newObjects "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! addAllLast: newObjects "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! add: newObject before: existingObject "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! add: newObject after: existingObject "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! add: a beforeIndex: c "Provide an error notification that storing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! ! !SortedCollection methodsFor: 'copying'! copyReplaceFrom: a to: b with: c "Provide an error notification that replacing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! copyReplaceAll: a with: c "Provide an error notification that replacing at a particular place in a SortedCollection is not allowed." self shouldNotImplement! ! ------------- Load.st cut here --------------------------- (Filename named: 'fixes.st') fileIn! (Filename named: 'MethodCheck.st') fileIn! (Filename named: 'AtDefault.st') fileIn! (Filename named: 'ComparableSet.st') fileIn! (Filename named: 'PartialOrder.st') fileIn! (Filename named: 'TopologicalSort.st') fileIn! (Filename named: 'TreeView.st') fileIn! (Filename named: 'TreeEditor.st') fileIn! (Filename named: 'InterfaceHierarchy.st') fileIn! (Filename named: 'Driver.st') fileIn!