The Trunk: HelpSystem-Core-mt.90.mcz

Marcel Taeumel uploaded a new version of HelpSystem-Core to project The Trunk:
http://source.squeak.org/trunk/HelpSystem-Core-mt.90.mcz

==================== Summary ====================

Name: HelpSystem-Core-mt.90
Author: mt
Time: 12 August 2016, 12:28:01.727343 pm
UUID: 4ac95aa0-aa5f-334e-8f71-57b608bd5b4b
Ancestors: HelpSystem-Core-mt.89

Normalize text attributes when editing help texts via the help browser. This is necessary to produce formatted text that works well with a variety of UI themes.

=============== Diff against HelpSystem-Core-mt.89 ===============

Item was changed:
  ----- Method: HelpBrowser>>accept: (in category 'actions') -----
  accept: text
  "Accept edited text. Compile it into a HelpTopic"
 
+ | code parent topicClass topicMethod normalizedText colorsToRemove |
- | code parent topicClass topicMethod |
  (self currentParentTopic isNil or: [self currentParentTopic isEditable not])
  ifTrue: [^ self inform: 'This help topic cannot be edited.'].
 
  self changed: #clearUserEdits.
 
  parent := self currentParentTopic.
  topicClass := parent helpClass.
  topicMethod := self currentTopic key.
+ normalizedText := text.
+
+ "Remove default colors for the sake of UI themes."
+ 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])]]).
 
  code := String streamContents:[:s|
  s nextPutAll: topicMethod.
  s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'.
  s crtab; nextPutAll: '"', self name,' edit: ', topicMethod storeString,'"'.
  s crtab; nextPutAll: '^HelpTopic'.
  s crtab: 2; nextPutAll: 'title: ', currentTopic title storeString.
  s crtab: 2; nextPutAll: 'contents: '.
+ s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: normalizedText]) storeString.
- s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: text]) storeString.
  s nextPutAll:' readStream nextChunkText'.
  ].
 
  topicClass class
  compile: code
  classified: ((topicClass class organization categoryOfElement: topicMethod) ifNil:['pages']).
 
  parent refresh.
  parent == self rootTopic ifTrue: [self rootTopic: parent].
 
  self currentTopic: (parent subtopics detect: [:t | t key = topicMethod]).!