[Pkg] The Trunk: HelpSystem-Core-mt.93.mcz

[commits at source.squeak.org]

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]).!