<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=us-ascii">
<meta name="Generator" content="Microsoft Exchange Server">
<!-- converted from text --><style><!-- .EmailQuote { margin-left: 1pt; padding-left: 4pt; border-left: #800000 2px solid; } --></style>
</head>
<body>
<meta content="text/html; charset=UTF-8">
<style type="text/css" style="">
<!--
p
{margin-top:0;
margin-bottom:0}
-->
</style>
<div dir="ltr">
<div id="x_divtagdefaultwrapper" dir="ltr" style="font-size:12pt; color:#000000; font-family:Calibri,Helvetica,sans-serif">
<p><img size="27116" id="x_img558836" tabindex="0" style="max-width:99.9%" src="cid:09a310f6-32c6-44cb-834e-62b19a2714c9"><br>
</p>
<div id="x_Signature">
<div name="x_divtagdefaultwrapper" style="font-family:Calibri,Arial,Helvetica,sans-serif; font-size:; margin:0">
<div><font size="2" color="#808080"></font></div>
</div>
</div>
</div>
<hr tabindex="-1" style="display:inline-block; width:98%">
<div id="x_divRplyFwdMsg" dir="ltr"><font face="Calibri, sans-serif" color="#000000" style="font-size:11pt"><b>Von:</b> Squeak-dev <squeak-dev-bounces@lists.squeakfoundation.org> im Auftrag von commits@source.squeak.org <commits@source.squeak.org><br>
<b>Gesendet:</b> Sonntag, 13. Oktober 2019 22:52:12<br>
<b>An:</b> squeak-dev@lists.squeakfoundation.org<br>
<b>Betreff:</b> [squeak-dev] The Inbox: HelpSystem-Core-ct.124.mcz</font>
<div> </div>
</div>
</div>
<font size="2"><span style="font-size:10pt;">
<div class="PlainText">A new version of HelpSystem-Core was added to project The Inbox:<br>
<a href="http://source.squeak.org/inbox/HelpSystem-Core-ct.124.mcz">http://source.squeak.org/inbox/HelpSystem-Core-ct.124.mcz</a><br>
<br>
==================== Summary ====================<br>
<br>
Name: HelpSystem-Core-ct.124<br>
Author: ct<br>
Time: 13 October 2019, 10:52:10.160932 pm<br>
UUID: e2346e98-30c4-964f-b015-dca8545b841c<br>
Ancestors: HelpSystem-Core-ct.123, HelpSystem-Core-ct.122<br>
<br>
Adds protocol & UI for subtopic management (#addSubtopic & #removeSubtopic)<br>
<br>
This commit is indeed intended to have two ancestors.<br>
<br>
=============== Diff against HelpSystem-Core-ct.123 ===============<br>
<br>
Item was added:<br>
+ ----- Method: AbstractHelpTopic>>canAddSubtopic (in category 'testing') -----<br>
+ canAddSubtopic<br>
+ <br>
+ ^ false!<br>
<br>
Item was added:<br>
+ ----- Method: AbstractHelpTopic>>canRemoveSubtopic (in category 'testing') -----<br>
+ canRemoveSubtopic<br>
+ <br>
+ ^ false!<br>
<br>
Item was added:<br>
+ ----- Method: AbstractHelpTopic>>isClassBasedHelpTopic (in category 'testing') -----<br>
+ isClassBasedHelpTopic<br>
+ <br>
+ ^ false!<br>
<br>
Item was changed:<br>
----- Method: AbstractHelpTopic>>topicMenu:parentTopic: (in category 'menus') -----<br>
topicMenu: aMenu parentTopic: parentTopic<br>
<br>
+ | editMenu |<br>
aMenu<br>
add: 'Inspect (i)' translated target: self action: #inspect;<br>
add: 'Explore (I)' translated target: self action: #explore.<br>
(self canBrowseTopicFromParent: parentTopic)<br>
ifTrue: [<br>
aMenu add: 'Browse (b)' translated<br>
target: self<br>
selector: #browseTopicFromParent:<br>
argumentList: {parentTopic} ].<br>
<br>
+ editMenu := aMenu class new target: self.<br>
+ self canAddSubtopic ifTrue: [<br>
+ editMenu add: 'Add topic...' translated<br>
+ target: self<br>
+ action: #addSubtopic ].<br>
+ parentTopic canRemoveSubtopic ifTrue: [<br>
+ editMenu add: 'Remove topic (x)' translated<br>
+ target: parentTopic<br>
+ selector: #removeSubtopic:<br>
+ argumentList: {self} ].<br>
+ editMenu hasItems ifTrue: [ aMenu<br>
+ addLine;<br>
+ addAllFrom: editMenu ].<br>
+ <br>
^ aMenu!<br>
<br>
Item was changed:<br>
----- Method: AbstractHelpTopic>>topicMenuKey:fromParent: (in category 'menus') -----<br>
topicMenuKey: aChar fromParent: parentTopic<br>
<br>
aChar<br>
caseOf: {<br>
[$b] -> [(self canBrowseTopicFromParent: parentTopic)<br>
ifTrue: [ self browseTopicFromParent: parentTopic ]].<br>
[$i] -> [self inspect].<br>
+ [$I] -> [self explore].<br>
+ [$x] -> [parentTopic canRemoveSubtopic ifTrue: [<br>
+ parentTopic removeSubtopic: self ]] }<br>
- [$I] -> [self explore] }<br>
otherwise: [^ false].<br>
^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>addMethodTopic (in category 'editing') -----<br>
+ addMethodTopic<br>
+ <br>
+ | title key needsToStorePages oldPages topic |<br>
+ title := UIManager default request: 'Please enter a topic name:' translated.<br>
+ title isEmptyOrNil ifTrue: [^ nil].<br>
+ key := self makeUniqueKeyFrom: (title asIdentifier: false).<br>
+ needsToStorePages := self needsToStorePages.<br>
+ needsToStorePages ifTrue: [<br>
+ (self okToWriteSelector: #pages)<br>
+ ifFalse: [^ false].<br>
+ oldPages := self helpClass pages].<br>
+ topic := HelpTopic named: title.<br>
+ topic key: key.<br>
+ self accept: '' for: topic.<br>
+ needsToStorePages ifTrue: [<br>
+ self storePages: (oldPages copyWith: key)].<br>
+ self refresh.<br>
+ ^ self subtopics detect: [:other | other key = key]!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>addSubclassTopic (in category 'editing') -----<br>
+ addSubclassTopic<br>
+ <br>
+ | className title subclass |<br>
+ title := UIManager default request: 'Please enter a book name:' translated.<br>
+ title isEmptyOrNil ifTrue: [^ nil].<br>
+ className := UIManager default request: 'Please enter a class name:' translated initialAnswer: (title asIdentifier: true).<br>
+ className isEmptyOrNil ifTrue: [^ nil].<br>
+ className := className asSymbol.<br>
+ Smalltalk at: className ifPresent: [:class | self inform: 'Class already exists' translated. ^ nil].<br>
+ subclass := self helpClass subclass: className<br>
+ instanceVariableNames: ''<br>
+ classVariableNames: ''<br>
+ poolDictionaries: ''<br>
+ category: self helpClass category.<br>
+ subclass theMetaClass<br>
+ compile: (String streamContents: [:stream |<br>
+ stream nextPutAll: #bookName;<br>
+ crtab; nextPutAll: '<generated>';<br>
+ crtab; nextPut: $^;<br>
+ store: title])<br>
+ classified: #accessing.<br>
+ subclass asHelpTopic storePages: #().<br>
+ self refresh.<br>
+ ^ self subtopics detect: [:topic | topic isClassBasedHelpTopic and: [topic helpClass = subclass]]!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>addSubtopic (in category 'editing') -----<br>
+ addSubtopic<br>
+ <br>
+ | strategy |<br>
+ strategy := UIManager default<br>
+ chooseFrom: (#('Add a method' 'Add a subclass') collect: #translated)<br>
+ values: #(addMethodTopic addSubclassTopic)<br>
+ title: 'Choose kind of subtopic' translated.<br>
+ strategy ifNil: [^ self].<br>
+ ^ self perform: strategy!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>canAddSubtopic (in category 'testing') -----<br>
+ canAddSubtopic<br>
+ <br>
+ ^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>canRemoveSubtopic (in category 'testing') -----<br>
+ canRemoveSubtopic<br>
+ <br>
+ ^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>isClassBasedHelpTopic (in category 'testing') -----<br>
+ isClassBasedHelpTopic<br>
+ <br>
+ ^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>makeUniqueKeyFrom: (in category 'editing') -----<br>
+ makeUniqueKeyFrom: aKey<br>
+ <br>
+ | keyIndex newKey |<br>
+ newKey := aKey.<br>
+ keyIndex := 0.<br>
+ [(self subtopics anySatisfy: [:existing | existing key = newKey])]<br>
+ whileTrue: [newKey := newKey , (keyIndex := keyIndex + 1)].<br>
+ ^ newKey asSymbol!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>needsToStorePages (in category 'testing') -----<br>
+ needsToStorePages<br>
+ <br>
+ | method |<br>
+ method := self helpClass theMetaClass lookupSelector: #pages.<br>
+ method ifNil: [^ true].<br>
+ ^ (method hasPragma: #pageInvariant) not!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>okToRemoveClass (in category 'editing') -----<br>
+ okToRemoveClass<br>
+ <br>
+ | message |<br>
+ message := (<br>
+ 'Are you certain that you want to remove\the class {1}\'<br>
+ , (self helpClass subclasses ifEmpty: [''] ifNotEmpty: ['and all its {2} subclasses\'])<br>
+ , 'from the system?')<br>
+ withCRs translated format: {self helpClass. self helpClass subclasses size}.<br>
+ ^ self confirm: message!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>okToWriteSelector: (in category 'editing') -----<br>
+ okToWriteSelector: aSelector<br>
+ <br>
+ | method |<br>
+ method := self helpClass theMetaClass compiledMethodAt: aSelector ifAbsent: [^ true].<br>
+ (method hasPragma: #generated) ifTrue: [^ true].<br>
+ ^ (UIManager default<br>
+ chooseFrom: (#('Override it' 'Don''t override, but browse it' 'Cancel') collect: #translated)<br>
+ values: { [true]. [method browse. false]. [false] }<br>
+ title: ('This will override the existing method\{1}!!\Proceed anyway?' withCRs translated asText<br>
+ format: {method reference asText<br>
+ addAttribute: (TextLink new classAndMethod: method reference);<br>
+ yourself })) value!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>removeSubtopic: (in category 'editing') -----<br>
+ removeSubtopic: aTopic<br>
+ <br>
+ | needsToStorePages confirmation oldPages |<br>
+ aTopic isClassBasedHelpTopic<br>
+ ifTrue: [<br>
+ | result |<br>
+ result := aTopic removeTopicClass.<br>
+ result ifTrue: [self refresh].<br>
+ ^ result].<br>
+ <br>
+ aTopic key ifNil: [<br>
+ self inform: 'Could not find topic' translated.<br>
+ ^ false].<br>
+ (self confirm: ('Are you sure you want to REMOVE the topic "{1}" from "{2}"?' translated format: {aTopic title. self title}))<br>
+ ifFalse: [^ false].<br>
+ needsToStorePages := self needsToStorePages.<br>
+ needsToStorePages ifTrue: [<br>
+ (self okToWriteSelector: #pages)<br>
+ ifFalse: [^ false].<br>
+ oldPages := self helpClass pages].<br>
+ confirmation := self systemNavigation<br>
+ confirmRemovalOf: aTopic key<br>
+ on: self helpClass theMetaClass.<br>
+ confirmation = 3 ifTrue: [^ false].<br>
+ self helpClass theMetaClass removeSelector: aTopic key.<br>
+ needsToStorePages ifTrue: [<br>
+ self storePages: (oldPages copyWithout: aTopic key)].<br>
+ <br>
+ self refresh.<br>
+ confirmation = 2 ifTrue: [<br>
+ self systemNavigation browseAllCallsOn: aTopic key].<br>
+ ^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>removeTopicClass (in category 'editing') -----<br>
+ removeTopicClass<br>
+ <br>
+ self okToRemoveClass ifFalse: [^ false].<br>
+ self helpClass removeFromSystem.<br>
+ ^ true!<br>
<br>
Item was added:<br>
+ ----- Method: ClassBasedHelpTopic>>storePages: (in category 'editing') -----<br>
+ storePages: keys<br>
+ <br>
+ | class |<br>
+ class := self helpClass theMetaClass.<br>
+ class<br>
+ compile: (String streamContents: [:stream |<br>
+ stream<br>
+ nextPutAll: 'pages'.<br>
+ (class includesSelector: #pages)<br>
+ ifFalse: [ stream<br>
+ crtab; nextPutAll: '<pageInvariant>';<br>
+ crtab; nextPutAll: '^ self class methodsInCategory: #pages' ]<br>
+ ifTrue: [ stream<br>
+ crtab; nextPutAll: '<generated>';<br>
+ crtab; nextPut: $^;<br>
+ store: keys ]])<br>
+ classified: #accessing.!<br>
<br>
<br>
</div>
</span></font>
</body>
</html>