Packages August 2019

packages@lists.squeakfoundation.org

1 participants
150 discussions

The Trunk: Tools-mt.876.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.876.mcz ==================== Summary ==================== Name: Tools-mt.876 Author: mt Time: 14 August 2019, 3:08:37.674512 pm UUID: fb8f517a-922f-eb41-a1de-f1e75de865c1 Ancestors: Tools-mt.875 Well ... same comment as before. We need a single way to get the current method in code browsers. =============== Diff against Tools-mt.875 =============== Item was changed: ----- Method: Browser>>dragFromMessageList: (in category 'drag and drop') ----- dragFromMessageList: index "Drag a method from the browser" + | selector | self flag: #refactor. "mt: Maybe use an approach similar to MessageSet class >> #parse:toClassAndSelector instead of #asString? There could be any fancy representation of a message in the message list." + selector := Symbol lookup: (self messageList at: index) asString. + selector ifNil: [^ self]. + + ^self selectedClassOrMetaClass compiledMethodAt: selector ifAbsent:[nil]! - ^self selectedClassOrMetaClass compiledMethodAt: (self messageList at: index) asString ifAbsent:[nil]!

1 0

The Trunk: Tools-mt.875.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.875.mcz ==================== Summary ==================== Name: Tools-mt.875 Author: mt Time: 14 August 2019, 1:16:03.729512 pm UUID: 6818d344-b9a1-ab49-bda7-a309a2e2c1c2 Ancestors: Tools-mt.874 Makes icons and dragging for deprecated messages work again. Hmm... it is really interesting to see how string-vs-text can blow up things. Maybe use an approach similar to MessageSet class >> #parse:toClassAndSelector instead of #asString? There could be any fancy representation of a message in the message list. =============== Diff against Tools-mt.874 =============== Item was changed: ----- Method: Browser>>dragFromMessageList: (in category 'drag and drop') ----- dragFromMessageList: index "Drag a method from the browser" + + self flag: #refactor. "mt: Maybe use an approach similar to MessageSet class >> #parse:toClassAndSelector instead of #asString? There could be any fancy representation of a message in the message list." + ^self selectedClassOrMetaClass compiledMethodAt: (self messageList at: index) asString ifAbsent:[nil]! - ^self selectedClassOrMetaClass compiledMethodAt: (self messageList at: index) ifAbsent:[nil]! Item was changed: ----- Method: Browser>>messageIconAt: (in category 'message list') ----- messageIconAt: anIndex self class showMessageIcons ifFalse: [^ nil]. + ^ self messageIconFor: (self messageList at: anIndex ifAbsent: [^nil]) asString! - ^ self messageIconFor: (self messageList at: anIndex ifAbsent: [^nil])! Item was changed: ----- Method: Browser>>messageListIndex: (in category 'message list') ----- messageListIndex: anInteger "Set the selected message selector to be the one indexed by anInteger." + self selectMessageNamed: (self messageList at: anInteger ifPresent: [:lbl | lbl asString] ifAbsent: [nil] )! - self selectMessageNamed: (self messageList at: anInteger ifAbsent: [nil])!

1 0

The Trunk: Morphic-ct.1503.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1503.mcz ==================== Summary ==================== Name: Morphic-ct.1503 Author: ct Time: 12 August 2019, 6:57:19.483878 pm UUID: edc880e2-504a-1a40-bdc9-e619c47f564a Ancestors: Morphic-mt.1498 Mark MenuMorph>>#filterListWith: as deprecated Thanks to Marcel for the tip :) =============== Diff against Morphic-mt.1498 =============== Item was changed: ----- Method: MenuMorph>>filterListWith: (in category 'keyboard control') ----- filterListWith: char | matchString | + self deprecated: 'ct: Use #handleFiltering: instead'. matchString := self valueOfProperty: #matchString ifAbsentPut: [String new]. matchString := char = Character backspace ifTrue: [matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]] ifFalse: [matchString copyWith: char]. self setProperty: #matchString toValue: matchString!

1 0

The Trunk: 60Deprecated-mt.42.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.42.mcz ==================== Summary ==================== Name: 60Deprecated-mt.42 Author: mt Time: 14 August 2019, 1:06:32.713512 pm UUID: 54694ba4-d41d-7e44-b3ea-8522f794574a Ancestors: 60Deprecated-mt.41 Deprecates old filter method in menus. =============== Diff against 60Deprecated-mt.41 =============== Item was added: + ----- Method: MenuMorph>>filterListWith: (in category '*60Deprecated-keyboard control') ----- + filterListWith: char + | matchString | + self deprecated: 'ct: Use #handleFiltering: instead'. + matchString := self valueOfProperty: #matchString ifAbsentPut: [String new]. + matchString := char = Character backspace + ifTrue: + [matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]] + ifFalse: [matchString copyWith: char]. + self setProperty: #matchString toValue: matchString!

1 0

The Trunk: Morphic-mt.1504.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1504.mcz ==================== Summary ==================== Name: Morphic-mt.1504 Author: mt Time: 14 August 2019, 1:05:30.371512 pm UUID: 0f3016f2-1bc1-bf46-b456-bf4f7bc11cf1 Ancestors: Morphic-mt.1501, Morphic-ct.1503 Merges ct.1503. =============== Diff against Morphic-mt.1501 =============== Item was removed: - ----- Method: MenuMorph>>filterListWith: (in category 'keyboard control') ----- - filterListWith: char - | matchString | - matchString := self valueOfProperty: #matchString ifAbsentPut: [String new]. - matchString := char = Character backspace - ifTrue: - [matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]] - ifFalse: [matchString copyWith: char]. - self setProperty: #matchString toValue: matchString!

1 0

The Trunk: Kernel-mt.1256.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1256.mcz ==================== Summary ==================== Name: Kernel-mt.1256 Author: mt Time: 14 August 2019, 11:47:08.245475 am UUID: d8d2cfa5-57d9-b24e-8173-811646541d8a Ancestors: Kernel-mt.1255 Speed up #isDeprecated check to speed up browsing tools. Thanks to Levente to the hints! =============== Diff against Kernel-mt.1255 =============== Item was changed: ----- Method: CompiledMethod>>isDeprecated (in category 'testing') ----- isDeprecated + "Note that #literalsDo: is faster than #hasLiteral: (and #hasLiteral:scanForSpecial:). We already know that 'self deprecated' should be the first statement in a deprecated method, which is directly accessible in this method's literals. No need to check compiled blocks or other nested structures. We expand the implementation of #literalsDo: here to gain twice the speed. - "Note that #literalsDo: is faster than #hasLiteral: (and #hasLiteral:scanForSpecial:). We already know that 'self deprecated' should be the first statement in a deprecated method, which is directly accessible in this method's literals. No need to check compiled blocks or other nested structures. Note that both #isQuick and is-this-method check make no sense performance-wise. Maybe bench again in the future." + | literal | + 1 to: self numLiterals do: [:index | + ((literal := self literalAt: index) == #deprecated: or: [ literal == #deprecated ]) + ifTrue: [ ^true ] ]. - self literalsDo: [:literal | - (#deprecated = literal or: [#deprecated: = literal]) - ifTrue: [^ true]]. ^ false!

1 0

The Trunk: Protocols-jr.63.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-jr.63.mcz ==================== Summary ==================== Name: Protocols-jr.63 Author: jr Time: 4 August 2019, 11:40:18.213513 am UUID: 7921d09f-b335-5e4e-bb85-ace62a287eb7 Ancestors: Protocols-pre.62 Implement spontaneous overriding of methods from Lexicon. Use a new instance variable to temporarily hold which class is the target of the current accept operation. Make sure to update the message list in case the current selector's class has now changed. Assumption: setClassAndSelectorIn: must provide the data of the currently selected method and it will not pretend to view a different class. Also add browseFullProtocol to ClassDescription to make it easier to open a Lexicon from a Workspace or the search box. Depends on Tools-jr.859. =============== Diff against Protocols-pre.62 =============== Item was added: + ----- Method: ClassDescription>>browseFullProtocol (in category '*Protocols-Tools') ----- + browseFullProtocol + Lexicon new openOnClass: self showingSelector: nil.! Item was changed: ProtocolBrowser subclass: #Lexicon + instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited compileTargetClass' - instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! + !Lexicon commentStamp: 'jr 8/4/2019 11:36' prior: 0! - !Lexicon commentStamp: 'fbs 5/2/2013 08:29' prior: 0! An instance of Lexicon shows the list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list. A variant with a search pane rather than a category list is also implemented. categoryList the list of categories categoryListIndex index of currently-selected category targetObject optional -- an instance being viewed targetClass the class being viewed lastSearchString the last string searched for lastSendersSearchSelector the last senders search selector limitClass optional -- the limit class to search for selectorsVisited list of selectors visited selectorsActive not presently in use, subsumed by selectorsVisited currentVocabulary the vocabulary currently installed currentQuery what the query category relates to: + #senders #selectorName #currentChangeSet + compileTargetClass transient -- behavior in which the current contents is + accepted/compiled! - #senders #selectorName #currentChangeSet! Item was added: + ----- Method: Lexicon>>contents:notifying: (in category 'private') ----- + contents: aString notifying: aController + "Make sure a possible choice of the compileTargetClass is not remembered." + [^ super contents: aString notifying: aController] + ensure: [compileTargetClass := nil]! Item was added: + ----- Method: Lexicon>>contents:oldSelector:in:classified:notifying: (in category 'private') ----- + contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController + "Update messageList if a method is compiled because the selector might be in a + different class now." + ^ (super contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController) + ifTrue: [ self reformulateList. ^ true] + ifFalse: [false]! Item was changed: ----- Method: Lexicon>>okayToAccept (in category 'model glue') ----- okayToAccept "Answer whether it is okay to accept the receiver's input" + | ok reply | - | ok aClass reply | (ok := super okayToAccept) ifTrue: + [((compileTargetClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: - [((aClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: [reply := UIManager default chooseFrom: + {'okay, no problem'. + 'cancel - let me reconsider'. + 'compile into ', targetClass name, ' instead'. + 'compile into a new uniclass'} title: - {'okay, no problem'. - 'cancel - let me reconsider'. - 'compile into ', targetClass name, ' instead'. - 'compile into a new uniclass'} title: 'Caution!! This would be + accepted into class ', compileTargetClass name, '. + Is that okay?'. + reply caseOf: + {[1] -> [^ true]. + [2] -> [^ false]. + [3] -> [compileTargetClass := targetClass. ^ true]} + otherwise: [self notYetImplemented]]]. - accepted into class ', aClass name, '. - Is that okay?' . - reply = 1 ifTrue: [^ true]. - reply ~= 2 ifTrue: - [self notYetImplemented]. - ^ false]]. ^ ok! Item was removed: - ----- Method: Lexicon>>setClassAndSelectorIn: (in category 'selection') ----- - setClassAndSelectorIn: csBlock - "Decode strings of the form <selectorName> (<className> [class])" - - - self selection ifNil: [^ csBlock value: targetClass value: nil]. - ^ super setClassAndSelectorIn: csBlock! Item was added: + ----- Method: Lexicon>>targetForContents: (in category 'private') ----- + targetForContents: aString + ^ compileTargetClass!

1 0

The Trunk: Protocols-jr.64.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-jr.64.mcz ==================== Summary ==================== Name: Protocols-jr.64 Author: jr Time: 10 August 2019, 8:37:33.025208 pm UUID: 88301d72-00b5-ef41-af99-d6650534d0fd Ancestors: Protocols-jr.63 Implement icons and help for messages in Lexicon Extract text rearranging from setClassAndSelectorIn: for reuse when other messages than the selected one need to be parsed. Depends on changes in Tools-jr.860 =============== Diff against Protocols-pre.62 =============== Item was added: + ----- Method: ClassDescription>>browseFullProtocol (in category '*Protocols-Tools') ----- + browseFullProtocol + Lexicon new openOnClass: self showingSelector: nil.! Item was changed: ProtocolBrowser subclass: #Lexicon + instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited compileTargetClass' - instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! + !Lexicon commentStamp: 'jr 8/4/2019 11:36' prior: 0! - !Lexicon commentStamp: 'fbs 5/2/2013 08:29' prior: 0! An instance of Lexicon shows the list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list. A variant with a search pane rather than a category list is also implemented. categoryList the list of categories categoryListIndex index of currently-selected category targetObject optional -- an instance being viewed targetClass the class being viewed lastSearchString the last string searched for lastSendersSearchSelector the last senders search selector limitClass optional -- the limit class to search for selectorsVisited list of selectors visited selectorsActive not presently in use, subsumed by selectorsVisited currentVocabulary the vocabulary currently installed currentQuery what the query category relates to: + #senders #selectorName #currentChangeSet + compileTargetClass transient -- behavior in which the current contents is + accepted/compiled! - #senders #selectorName #currentChangeSet! Item was added: + ----- Method: Lexicon>>contents:notifying: (in category 'private') ----- + contents: aString notifying: aController + "Make sure a possible choice of the compileTargetClass is not remembered." + [^ super contents: aString notifying: aController] + ensure: [compileTargetClass := nil]! Item was added: + ----- Method: Lexicon>>contents:oldSelector:in:classified:notifying: (in category 'private') ----- + contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController + "Update messageList if a method is compiled because the selector might be in a + different class now." + ^ (super contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController) + ifTrue: [ self reformulateList. ^ true] + ifFalse: [false]! Item was changed: ----- Method: Lexicon>>messageHelpAt: (in category 'message list') ----- messageHelpAt: anIndex + "Show the first n lines of the source code of the selected message." + Preferences balloonHelpInMessageLists ifFalse: [^ nil]. + self messageList size < anIndex ifTrue: [^ nil]. + + self setClassAndSelectorOf: (self messageList at: anIndex) in: + [:class :selector | + ^ self messageHelpForMethod: class >> selector]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>messageIconAt: (in category 'message list') ----- messageIconAt: anIndex + Browser showMessageIcons + ifFalse: [^ nil]. + self setClassAndSelectorOf: (self messageList at: anIndex) in: + [:class :selector | + ^ ToolIcons iconNamed: (ToolIcons + iconForClass: class + selector: selector)]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>okayToAccept (in category 'model glue') ----- okayToAccept "Answer whether it is okay to accept the receiver's input" + | ok reply | - | ok aClass reply | (ok := super okayToAccept) ifTrue: + [((compileTargetClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: - [((aClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: [reply := UIManager default chooseFrom: + {'okay, no problem'. + 'cancel - let me reconsider'. + 'compile into ', targetClass name, ' instead'. + 'compile into a new uniclass'} title: - {'okay, no problem'. - 'cancel - let me reconsider'. - 'compile into ', targetClass name, ' instead'. - 'compile into a new uniclass'} title: 'Caution!! This would be + accepted into class ', compileTargetClass name, '. + Is that okay?'. + reply caseOf: + {[1] -> [^ true]. + [2] -> [^ false]. + [3] -> [compileTargetClass := targetClass. ^ true]} + otherwise: [self notYetImplemented]]]. - accepted into class ', aClass name, '. - Is that okay?' . - reply = 1 ifTrue: [^ true]. - reply ~= 2 ifTrue: - [self notYetImplemented]. - ^ false]]. ^ ok! Item was removed: - ----- Method: Lexicon>>setClassAndSelectorIn: (in category 'selection') ----- - setClassAndSelectorIn: csBlock - "Decode strings of the form <selectorName> (<className> [class])" - - - self selection ifNil: [^ csBlock value: targetClass value: nil]. - ^ super setClassAndSelectorIn: csBlock! Item was added: + ----- Method: Lexicon>>targetForContents: (in category 'private') ----- + targetForContents: aString + ^ compileTargetClass! Item was changed: ----- Method: ProtocolBrowser>>setClassAndSelectorIn: (in category 'private') ----- setClassAndSelectorIn: csBlock "Decode strings of the form <selectorName> (<className> [class])" + | sel | - | i classAndSelString selString sel | sel := self selection ifNil: [^ csBlock value: nil value: nil]. (sel isKindOf: MethodReference) ifTrue: [ sel setClassAndSelectorIn: csBlock ] ifFalse: [ + self setClassAndSelectorOf: sel in: csBlock. - 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 added: + ----- Method: ProtocolBrowser>>setClassAndSelectorOf:in: (in category 'private') ----- + setClassAndSelectorOf: aText in: csBlock + "Decode strings of the form <selectorName> (<className> [class])" + | selString i classAndSelString| + selString := aText 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. + !

1 0

The Trunk: Protocols-jr.65.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-jr.65.mcz ==================== Summary ==================== Name: Protocols-jr.65 Author: jr Time: 10 August 2019, 10:04:53.967208 pm UUID: 798a2618-0a3b-3442-b7a9-ce5014fa1527 Ancestors: Protocols-jr.64 Make ProtocolBrowser and subclasses compatible with recent formatted message list changes parse:toClassAndSelector: is sent by MessageSet formattedLabel: ProtocolBrowser produces message items with different texts than those in MessageSet. Overriding the parse method in ProtocolBrowser class makes the setClassAndSelectorOf:in: method introduced in my previous versions obsolete. setClassAndSelectorIn: can be removed because its new implementation in MessageSet is suitable for ProtocolBrowser and subclasses as well. =============== Diff against Protocols-pre.62 =============== Item was added: + ----- Method: ClassDescription>>browseFullProtocol (in category '*Protocols-Tools') ----- + browseFullProtocol + Lexicon new openOnClass: self showingSelector: nil.! Item was changed: ProtocolBrowser subclass: #Lexicon + instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited compileTargetClass' - instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! + !Lexicon commentStamp: 'jr 8/4/2019 11:36' prior: 0! - !Lexicon commentStamp: 'fbs 5/2/2013 08:29' prior: 0! An instance of Lexicon shows the list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list. A variant with a search pane rather than a category list is also implemented. categoryList the list of categories categoryListIndex index of currently-selected category targetObject optional -- an instance being viewed targetClass the class being viewed lastSearchString the last string searched for lastSendersSearchSelector the last senders search selector limitClass optional -- the limit class to search for selectorsVisited list of selectors visited selectorsActive not presently in use, subsumed by selectorsVisited currentVocabulary the vocabulary currently installed currentQuery what the query category relates to: + #senders #selectorName #currentChangeSet + compileTargetClass transient -- behavior in which the current contents is + accepted/compiled! - #senders #selectorName #currentChangeSet! Item was added: + ----- Method: Lexicon>>contents:notifying: (in category 'private') ----- + contents: aString notifying: aController + "Make sure a possible choice of the compileTargetClass is not remembered." + [^ super contents: aString notifying: aController] + ensure: [compileTargetClass := nil]! Item was added: + ----- Method: Lexicon>>contents:oldSelector:in:classified:notifying: (in category 'private') ----- + contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController + "Update messageList if a method is compiled because the selector might be in a + different class now." + ^ (super contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController) + ifTrue: [ self reformulateList. ^ true] + ifFalse: [false]! Item was changed: ----- Method: Lexicon>>messageHelpAt: (in category 'message list') ----- messageHelpAt: anIndex + "Show the first n lines of the source code of the selected message." + Preferences balloonHelpInMessageLists ifFalse: [^ nil]. + self messageList size < anIndex ifTrue: [^ nil]. + + self class parse: (self messageList at: anIndex) toClassAndSelector: + [:class :selector | + ^ self messageHelpForMethod: class >> selector]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>messageIconAt: (in category 'message list') ----- messageIconAt: anIndex + Browser showMessageIcons + ifFalse: [^ nil]. + self class parse: (self messageList at: anIndex) toClassAndSelector: + [:class :selector | + ^ ToolIcons iconNamed: (ToolIcons + iconForClass: class + selector: selector)]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>okayToAccept (in category 'model glue') ----- okayToAccept "Answer whether it is okay to accept the receiver's input" + | ok reply | - | ok aClass reply | (ok := super okayToAccept) ifTrue: + [((compileTargetClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: - [((aClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: [reply := UIManager default chooseFrom: + {'okay, no problem'. + 'cancel - let me reconsider'. + 'compile into ', targetClass name, ' instead'. + 'compile into a new uniclass'} title: - {'okay, no problem'. - 'cancel - let me reconsider'. - 'compile into ', targetClass name, ' instead'. - 'compile into a new uniclass'} title: 'Caution!! This would be + accepted into class ', compileTargetClass name, '. + Is that okay?'. + reply caseOf: + {[1] -> [^ true]. + [2] -> [^ false]. + [3] -> [compileTargetClass := targetClass. ^ true]} + otherwise: [self notYetImplemented]]]. - accepted into class ', aClass name, '. - Is that okay?' . - reply = 1 ifTrue: [^ true]. - reply ~= 2 ifTrue: - [self notYetImplemented]. - ^ false]]. ^ ok! Item was removed: - ----- Method: Lexicon>>setClassAndSelectorIn: (in category 'selection') ----- - setClassAndSelectorIn: csBlock - "Decode strings of the form <selectorName> (<className> [class])" - - - self selection ifNil: [^ csBlock value: targetClass value: nil]. - ^ super setClassAndSelectorIn: csBlock! Item was added: + ----- Method: Lexicon>>targetForContents: (in category 'private') ----- + targetForContents: aString + ^ compileTargetClass! Item was added: + ----- Method: ProtocolBrowser class>>parse:toClassAndSelector: (in category 'utilities') ----- + parse: aStringOrText toClassAndSelector: csBlock + "Decode strings of the form <selectorName> (<className> [class])" + | string i classAndSelString| + aStringOrText ifNil: [^ csBlock value: nil value: nil]. + string := aStringOrText asString. + i := string indexOf: $(. + "Rearrange to <className> [class] <selectorName> , and use MessageSet" + classAndSelString := (string copyFrom: i + 1 to: string size - 1) , ' ' , + (string copyFrom: 1 to: i - 1) withoutTrailingBlanks. + super parse: classAndSelString toClassAndSelector: csBlock.! Item was removed: - ----- 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. - ]. - !

1 0

The Trunk: Protocols-jr.66.mcz
by commits＠source.squeak.org 14 Aug '19

14 Aug '19

Marcel Taeumel uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-jr.66.mcz ==================== Summary ==================== Name: Protocols-jr.66 Author: jr Time: 10 August 2019, 10:52:44.688208 pm UUID: d24c7b8e-2920-0a46-9a93-e89755df5ad4 Ancestors: Protocols-jr.65 Quick fix to highlight messages implemented in the browsed class of a Lexicon again =============== Diff against Protocols-pre.62 =============== Item was added: + ----- Method: ClassDescription>>browseFullProtocol (in category '*Protocols-Tools') ----- + browseFullProtocol + Lexicon new openOnClass: self showingSelector: nil.! Item was changed: ProtocolBrowser subclass: #Lexicon + instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited compileTargetClass' - instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! + !Lexicon commentStamp: 'jr 8/4/2019 11:36' prior: 0! - !Lexicon commentStamp: 'fbs 5/2/2013 08:29' prior: 0! An instance of Lexicon shows the list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list. A variant with a search pane rather than a category list is also implemented. categoryList the list of categories categoryListIndex index of currently-selected category targetObject optional -- an instance being viewed targetClass the class being viewed lastSearchString the last string searched for lastSendersSearchSelector the last senders search selector limitClass optional -- the limit class to search for selectorsVisited list of selectors visited selectorsActive not presently in use, subsumed by selectorsVisited currentVocabulary the vocabulary currently installed currentQuery what the query category relates to: + #senders #selectorName #currentChangeSet + compileTargetClass transient -- behavior in which the current contents is + accepted/compiled! - #senders #selectorName #currentChangeSet! Item was added: + ----- Method: Lexicon>>contents:notifying: (in category 'private') ----- + contents: aString notifying: aController + "Make sure a possible choice of the compileTargetClass is not remembered." + [^ super contents: aString notifying: aController] + ensure: [compileTargetClass := nil]! Item was added: + ----- Method: Lexicon>>contents:oldSelector:in:classified:notifying: (in category 'private') ----- + contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController + "Update messageList if a method is compiled because the selector might be in a + different class now." + ^ (super contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController) + ifTrue: [ self reformulateList. ^ true] + ifFalse: [false]! Item was added: + ----- Method: Lexicon>>formattedLabel:forSelector:inClass: (in category 'message list') ----- + formattedLabel: aString forSelector: aSymbol inClass: aClass + "Highlight messages implemented in the targetClass in bold print." + + | formattedLabel | + formattedLabel := super formattedLabel: aString forSelector: aSymbol inClass: aClass. + aClass = targetClass ifTrue: + [formattedLabel := formattedLabel asText. + (self userInterfaceTheme ownMessageAttributes ifNil: [{TextEmphasis bold}]) do: [:textAttribute | + formattedLabel addAttribute: textAttribute]]. + + ^ formattedLabel.! Item was changed: ----- Method: Lexicon>>messageHelpAt: (in category 'message list') ----- messageHelpAt: anIndex + "Show the first n lines of the source code of the selected message." + Preferences balloonHelpInMessageLists ifFalse: [^ nil]. + self messageList size < anIndex ifTrue: [^ nil]. + + self class parse: (self messageList at: anIndex) toClassAndSelector: + [:class :selector | + ^ self messageHelpForMethod: class >> selector]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>messageIconAt: (in category 'message list') ----- messageIconAt: anIndex + Browser showMessageIcons + ifFalse: [^ nil]. + self class parse: (self messageList at: anIndex) toClassAndSelector: + [:class :selector | + ^ ToolIcons iconNamed: (ToolIcons + iconForClass: class + selector: selector)]. + - "Not working due to text representation of message list." ^ nil! Item was changed: ----- Method: Lexicon>>okayToAccept (in category 'model glue') ----- okayToAccept "Answer whether it is okay to accept the receiver's input" + | ok reply | - | ok aClass reply | (ok := super okayToAccept) ifTrue: + [((compileTargetClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: - [((aClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue: [reply := UIManager default chooseFrom: + {'okay, no problem'. + 'cancel - let me reconsider'. + 'compile into ', targetClass name, ' instead'. + 'compile into a new uniclass'} title: - {'okay, no problem'. - 'cancel - let me reconsider'. - 'compile into ', targetClass name, ' instead'. - 'compile into a new uniclass'} title: 'Caution!! This would be + accepted into class ', compileTargetClass name, '. + Is that okay?'. + reply caseOf: + {[1] -> [^ true]. + [2] -> [^ false]. + [3] -> [compileTargetClass := targetClass. ^ true]} + otherwise: [self notYetImplemented]]]. - accepted into class ', aClass name, '. - Is that okay?' . - reply = 1 ifTrue: [^ true]. - reply ~= 2 ifTrue: - [self notYetImplemented]. - ^ false]]. ^ ok! Item was removed: - ----- Method: Lexicon>>setClassAndSelectorIn: (in category 'selection') ----- - setClassAndSelectorIn: csBlock - "Decode strings of the form <selectorName> (<className> [class])" - - - self selection ifNil: [^ csBlock value: targetClass value: nil]. - ^ super setClassAndSelectorIn: csBlock! Item was added: + ----- Method: Lexicon>>targetForContents: (in category 'private') ----- + targetForContents: aString + ^ compileTargetClass! Item was added: + ----- Method: ProtocolBrowser class>>parse:toClassAndSelector: (in category 'utilities') ----- + parse: aStringOrText toClassAndSelector: csBlock + "Decode strings of the form <selectorName> (<className> [class])" + | string i classAndSelString| + aStringOrText ifNil: [^ csBlock value: nil value: nil]. + string := aStringOrText asString. + i := string indexOf: $(. + "Rearrange to <className> [class] <selectorName> , and use MessageSet" + classAndSelString := (string copyFrom: i + 1 to: string size - 1) , ' ' , + (string copyFrom: 1 to: i - 1) withoutTrailingBlanks. + super parse: classAndSelString toClassAndSelector: csBlock.! Item was removed: - ----- 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. - ]. - !

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
15
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages August 2019