David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-bf.997.mcz==================== Summary ====================
Name: System-bf.997
Author: bf
Time: 25 January 2018, 4:56:35.380251 pm
UUID: 604954ca-0389-43c0-a5c7-4ddc8e613cc9
Ancestors: System-dtl.996
Simplify project dispatch selector detection. No hard-coded list. Almost as good.
=============== Diff against System-dtl.996 ===============
Item was removed:
- ----- Method: Project class>>baseSelectors (in category 'dispatching') -----
- baseSelectors
- "The list of known base selectors that may be dispatched to project specific
- implementations. For example, #OpenLabel:in: will be dispatched to #mvcOpenLabel:in:
- for its MVC specific implementation. Add new base selectors here if additional methods
- are added as targets of the dispatchTo:addPrefixAndSend:withArguments: mechanism."
-
- ^ {
- #StartUpLeftFlush .
- #StartUpWithCaption:icon:at:allowKeyboard: .
- #OpenLabel:in: .
- #Open: .
- #Open .
- #OpenOn:context:label:contents:fullView: .
- #ResumeProcess: .
- #OpenContext:label:contents:
- }
- !
Item was removed:
- ----- Method: Project class>>dispatchSelectors (in category 'dispatching') -----
- dispatchSelectors
- "All known targets of the dispatch mechanism"
-
- "Project dispatchSelectors"
-
- | selectors dispatchPrefixes |
- selectors := OrderedCollection new.
- dispatchPrefixes := Set withAll: (Project allSubclasses collect: [ :e | e basicNew selectorPrefixForDispatch ]).
- self baseSelectors do: [ :base |
- dispatchPrefixes do: [ :prefix |
- selectors add: (prefix, base) asSymbol ] ].
- ^ selectors
-
- !
Item was changed:
----- Method: Project class>>isDispatchSelector: (in category 'dispatching') -----
isDispatchSelector: aSelector
"In support of package modularity, some method selectors are generated based
on project type and dispatched to the appropriate implementation for that project.
For methods with these selectors, let dispatchTo:addPrefixAndSend:withArguments:
be found as a sender."
+ | dispatchPrefixes prefix otherSelector |
+ dispatchPrefixes := Project allSubclasses collect:
+ [:cls | cls basicNew selectorPrefixForDispatch].
+ "If it doesn't start with a recognized prefix, it's not dispatchable"
+ prefix := dispatchPrefixes detect: [:each | aSelector beginsWith: each]
+ ifNone: [^false].
+ "If a similar symbol exists for all other prefixes, it's likely dispatchable"
+ ^(dispatchPrefixes copyWithout: prefix)
+ allSatisfy: [:otherPrefix |
+ otherSelector := otherPrefix, (aSelector allButFirst: prefix size).
+ Symbol hasInterned: otherSelector ifTrue: [:s]]
-
- ^ self dispatchSelectors includes: aSelector.
!