Marcel Taeumel uploaded a new version of HelpSystem-Core to project The Trunk: http://source.squeak.org/trunk/HelpSystem-Core-ct.122.mcz
==================== Summary ====================
Name: HelpSystem-Core-ct.122 Author: ct Time: 3 October 2019, 2:20:52.152682 am UUID: 71c0495c-bf43-b440-aa1b-1cf195eb6a54 Ancestors: HelpSystem-Core-mt.116
Refines accepting text in HelpBrowser
- Revise use of #clearUserEdits and isUpdating - Use the right #accept: return pattern (Boolean or False) - Catch an edge case when you try to write something into a nested ClassBasedHelpTopic - Mark saved methods with a #generated pragma; ask user before overwriting non-auto-generated methods to avoid discarding manual code (such as in SqueakToolsDebuggerHelp>>#usingTheDebugger)
Depends on Tools-ct.894.
=============== Diff against HelpSystem-Core-mt.116 ===============
Item was changed: ----- Method: AbstractHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic + "If this topic is editable, this will be the callback to update its contents." + ^ false! - "If this topic is editable, this will be the callback to update its contents."!
Item was changed: ----- Method: ClassBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic "Supports indirect content storage in classes other than helpClass." | topicClass topicMethodSelector code indirect | + (subtopic respondsTo: #contentsAsIs) + ifFalse: [^ self inform: 'Cannot store into this topic' translated]. + (indirect := subtopic contentsAsIs isMessageSend) ifFalse: [ topicClass := self helpClass. topicMethodSelector := subtopic key asLegalSelector asSymbol] ifTrue: [ topicClass := subtopic contentsAsIs receiver. topicMethodSelector := subtopic contentsAsIs selector]. + (topicClass class includesSelector: topicMethodSelector) ==> [self okToWriteSelector: topicMethodSelector] + ifFalse: [^ false]. + code := String streamContents:[:s| s nextPutAll: topicMethodSelector. s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'. s crtab; nextPutAll: '"', self helpClass name,' edit: ', subtopic key storeString,'"'. indirect ifTrue: [s crtab; nextPutAll: '^ ('] ifFalse: [ + s crtab; nextPutAll: '<generated>'. s crtab; nextPutAll: '^(HelpTopic'. s crtab: 2; nextPutAll: 'title: ', subtopic title storeString. s crtab: 2; nextPutAll: 'contents: ']. s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: newContents]) storeString. s nextPutAll:' readStream nextChunkText)'. indirect ifFalse: [ subtopic key ifNotNil: [s crtab: 3; nextPutAll: 'key: ', subtopic key storeString; nextPutAll: ';']. subtopic shouldStyle ifNotNil: [s crtab: 3; nextPutAll: 'shouldStyle: ', subtopic shouldStyle storeString; nextPutAll: ';']. s crtab: 3; nextPutAll: 'yourself'] ].
topicClass class compile: code + classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']). + ^ true! - classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']).!
Item was added: + ----- Method: ClassBasedHelpTopic>>okToWriteSelector: (in category 'editing') ----- + okToWriteSelector: aSelector + + | method | + method := self helpClass theMetaClass compiledMethodAt: aSelector ifAbsent: [^ true]. + (method hasPragma: #generated) ifTrue: [^ true]. + ^ (UIManager default + chooseFrom: (#('Override it' 'Don''t override, but browse it' 'Cancel') collect: #translated) + values: { [true]. [method browse. false]. [false] } + title: ('This will override the existing method{1}!!\Proceed anyway?' withCRs translated asText + format: {method reference asText + addAttribute: (TextLink new classAndMethod: method reference); + yourself })) value!
Item was changed: ----- Method: DirectoryBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic
FileStream forceNewFileNamed: subtopic fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. + ^ true !
Item was changed: ----- Method: FileBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic
FileStream forceNewFileNamed: self fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. + ^ true - !
Item was changed: ----- Method: HelpBrowser>>accept: (in category 'actions') ----- accept: text "Accept edited text. Compile it into a HelpTopic"
| parent currentKey normalizedText colorsToRemove | ((self currentParentTopic isNil or: [self currentParentTopic isEditable not]) or: [self currentTopic isEditable not]) + ifTrue: [^ self inform: 'This help topic cannot be edited.' translated]. - ifTrue: [^ self inform: 'This help topic cannot be edited.']. - self changed: #clearUserEdits. - "Remove default colors for the sake of UI themes." normalizedText := text. colorsToRemove := {Color black. Color white}. normalizedText runs: (normalizedText runs collect: [:attributes | attributes reject: [:attribute | (((attribute respondsTo: #color) and: [colorsToRemove includes: attribute color]) or: [attribute respondsTo: #font])]]).
parent := self currentParentTopic. currentKey := self currentTopic key.
+ [isUpdating := true. + (parent accept: normalizedText for: self currentTopic) == true + ifFalse: [^ false]. + self changed: #clearUserEdits. - isUpdating := true. - - parent accept: normalizedText for: self currentTopic. parent refresh. + parent == self rootTopic ifTrue: [self rootTopic: parent]] + ensure: [isUpdating := false]. - parent == self rootTopic ifTrue: [self rootTopic: parent]. + self currentTopic: (parent subtopics detect: [:t | t key = currentKey]). + ^ true! - isUpdating := false. - - self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).!