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

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

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

Name: HelpSystem-Core-mt.93
Author: mt
Time: 14 August 2016, 6:45:02.594782 pm
UUID: 246b0b54-03fd-bb4b-9ec3-e9a8d8b70635
Ancestors: HelpSystem-Core-mt.92

Well, adds support for directory/file-based help topics. Need this for writing release notes.

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

Item was added:
+ ----- 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."!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>accept:for: (in category 'editing') -----
+ accept: newContents for: subtopic
+
+ | topicClass topicMethodSelector code |
+ topicClass := self helpClass.
+ topicMethodSelector := (subtopic key copyReplaceAll: '-' with: '') copyReplaceAll: '.' with: ''.
+
+ code := String streamContents:[:s|
+ s nextPutAll: topicMethodSelector.
+ s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'.
+ s crtab; nextPutAll: '"', topicClass name,' edit: ', subtopic key storeString,'"'.
+ 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)'.
+ s crtab: 3; nextPutAll: 'key: ', subtopic key storeString.
+ ].
+
+ topicClass class
+ compile: code
+ classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']).!

Item was added:
+ AbstractHelpTopic subclass: #DirectoryBasedHelpTopic
+ instanceVariableNames: 'directoryEntry title filter sortBlock subtopics'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'HelpSystem-Core-Model'!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>><= (in category 'comparing') -----
+ <= anotherTopic
+
+ ^ anotherTopic class == FileBasedHelpTopic
+ ifTrue: [true]
+ ifFalse: [super <= anotherTopic]!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>accept:for: (in category 'editing') -----
+ accept: newContents for: subtopic
+
+ FileStream fileNamed: subtopic fileEntry fullName do: [:strm |
+ strm nextChunkPutWithStyle: newContents].
+
+ !

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>contents (in category 'accessing') -----
+ contents
+
+ ^ 'This is a directory-based help topic. It''s contents are in ', self directoryEntry fullName!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>directoryEntry (in category 'accessing') -----
+ directoryEntry
+ ^ directoryEntry!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>directoryEntry: (in category 'accessing') -----
+ directoryEntry: aDirectoryEntry
+ directoryEntry := aDirectoryEntry.!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>editable (in category 'testing') -----
+ editable
+ ^ true!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>filter (in category 'accessing') -----
+ filter
+
+ ^ filter ifNil: [filter := '*.*']!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>filter: (in category 'accessing') -----
+ filter: aFilterPattern
+
+ filter := aFilterPattern.!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>isEditable (in category 'testing') -----
+ isEditable
+ ^ true!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>refresh (in category 'updating') -----
+ refresh
+
+ subtopics := nil.
+ self changed: #subtopicsUpdated.!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>sortBlock (in category 'accessing') -----
+ sortBlock
+ ^ sortBlock ifNil: [ sortBlock := [:a :b | true] ]!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>sortBlock: (in category 'accessing') -----
+ sortBlock: aBlock
+ sortBlock := aBlock.!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>subtopics (in category 'accessing') -----
+ subtopics
+
+ | directory |
+ subtopics ifNotNil: [^ subtopics].
+
+ directory := self directoryEntry asFileDirectory.
+ ^ subtopics := (directory entries
+ select: [:ea | ea isDirectory]
+ thenCollect: [:ea | DirectoryBasedHelpTopic new directoryEntry: ea]),
+
+ ((directory fileNamesMatching: self filter)
+ collect: [:fileName | FileBasedHelpTopic new
+ fileEntry: (directory entryAt: fileName);
+ sortBlock: self sortBlock])!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>title (in category 'accessing') -----
+ title
+ ^ title ifNil: [self directoryEntry name]!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>title: (in category 'accessing') -----
+ title: aString
+ title := aString.!

Item was added:
+ AbstractHelpTopic subclass: #FileBasedHelpTopic
+ instanceVariableNames: 'contents fileEntry sortBlock'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'HelpSystem-Core-Model'!

Item was added:
+ ----- Method: FileBasedHelpTopic>><= (in category 'comparing') -----
+ <= anotherTopic
+
+ ^ self class == anotherTopic class
+ ifTrue: [self sortBlock value: self value: anotherTopic]
+ ifFalse: [super <= anotherTopic]!

Item was added:
+ ----- Method: FileBasedHelpTopic>>contents (in category 'accessing') -----
+ contents
+
+ ^ contents ifNil: [
+ contents := fileEntry readStream nextChunkText withSqueakLineEndings].!

Item was added:
+ ----- Method: FileBasedHelpTopic>>fileEntry (in category 'accessing') -----
+ fileEntry
+ ^ fileEntry!

Item was added:
+ ----- Method: FileBasedHelpTopic>>fileEntry: (in category 'accessing') -----
+ fileEntry: aFileEntry
+ fileEntry := aFileEntry.
+ contents := nil.!

Item was added:
+ ----- Method: FileBasedHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self fileEntry fullName!

Item was added:
+ ----- Method: FileBasedHelpTopic>>sortBlock (in category 'accessing') -----
+ sortBlock
+ ^ sortBlock ifNil: [sortBlock := [:a :b | true]]!

Item was added:
+ ----- Method: FileBasedHelpTopic>>sortBlock: (in category 'accessing') -----
+ sortBlock: aBlock
+ sortBlock := aBlock.!

Item was added:
+ ----- Method: FileBasedHelpTopic>>title (in category 'accessing') -----
+ title
+
+ ^ self fileEntry name!

Item was changed:
  ----- Method: HelpBrowser>>accept: (in category 'actions') -----
  accept: text
  "Accept edited text. Compile it into a HelpTopic"
 
+ | parent currentKey normalizedText colorsToRemove |
- | code parent topicClass topicMethod topicMethodSelector normalizedText colorsToRemove |
  (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.
- topicMethodSelector := (topicMethod copyReplaceAll: '-' with: '') copyReplaceAll: '.' with: ''.
- normalizedText := text.
-
  "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])]]).
-
- code := String streamContents:[:s|
- s nextPutAll: topicMethodSelector.
- s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'.
- s crtab; nextPutAll: '"', topicClass 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 nextPutAll:' readStream nextChunkText)'.
- s crtab: 3; nextPutAll: 'key: ', topicMethod storeString.
- ].
 
+ parent := self currentParentTopic.
+ currentKey := self currentTopic key.
+
+ parent accept: normalizedText for: self currentTopic.
- topicClass class
- compile: code
- classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']).
 
  parent refresh.
  parent == self rootTopic ifTrue: [self rootTopic: parent].
 
+ self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).!
- self currentTopic: (parent subtopics detect: [:t | t key = topicMethod]).!