Smalltalk › Squeak › Squeak - Dev

Squeak 4.6: HelpSystem-Core-mt.78.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

Squeak 4.6: HelpSystem-Core-mt.78.mcz

Chris Muller uploaded a new version of HelpSystem-Core to project Squeak 4.6:
http://source.squeak.org/squeak46/HelpSystem-Core-mt.78.mcz

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

Name: HelpSystem-Core-mt.78
Author: mt
Time: 14 May 2015, 6:45:57.427 pm
UUID: d3d02275-f61e-8f4f-91e0-5dcf9b37c8d5
Ancestors: HelpSystem-Core-kfr.77

Class-based help topics are editable again. Help browser updates correctly after edits.

==================== Snapshot ====================

SystemOrganization addCategory: #'HelpSystem-Core-Builders'!
SystemOrganization addCategory: #'HelpSystem-Core-Help'!
SystemOrganization addCategory: #'HelpSystem-Core-Model'!
SystemOrganization addCategory: #'HelpSystem-Core-UI'!
SystemOrganization addCategory: #'HelpSystem-Core-Utilities'!

(PackageInfo named: 'HelpSystem-Core') postscript: '"below, add code to be run after the loading of this package"
TheWorldMainDockingBar updateInstances'!

Model subclass: #AbstractHelpTopic
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

!AbstractHelpTopic commentStamp: 'mt 3/24/2015 16:26' prior: 0!
A HelpTopic provides content information that can be used as a help to the user.
It can be labeled with a title and marked with an (optional) icon.

Help topics form a hierarchy since any topic is able to have zero or more
subtopics. !

----- Method: AbstractHelpTopic>><= (in category 'comparing') -----
<= anotherHelpTopic

"Priority-based: ... -3 -2 -1 nil nil nil 1 2 3 4 ..."
(self priority notNil and: [anotherHelpTopic priority notNil])
ifTrue: [^ self priority <= anotherHelpTopic priority].

(self priority notNil and: [anotherHelpTopic priority isNil])
ifTrue: [^ self priority <= 0].

(self priority isNil and: [anotherHelpTopic priority notNil])
ifTrue: [^ anotherHelpTopic priority >= 0].

"Fall-back."
^ self title <= anotherHelpTopic title!

----- Method: AbstractHelpTopic>>asHelpTopic (in category 'conversion') -----
asHelpTopic

^ self!

----- Method: AbstractHelpTopic>>contents (in category 'accessing') -----
contents
"Return the text contents of this topic."

self subclassResponsibility.!

----- Method: AbstractHelpTopic>>hasSubtopics (in category 'testing') -----
hasSubtopics

^ self subtopics notEmpty!

----- Method: AbstractHelpTopic>>icon (in category 'accessing') -----
icon
"Returns a descriptive form to support manual detection in a list of topics. Icons may encode the kind of topic."

^ nil!

----- Method: AbstractHelpTopic>>isEditable (in category 'testing') -----
isEditable

^ false!

----- Method: AbstractHelpTopic>>isSearchable (in category 'testing') -----
isSearchable

^ true!

----- Method: AbstractHelpTopic>>printOn: (in category 'printing') -----
printOn: stream

| title |
super printOn: stream.
(title := self title) notNil
ifTrue: [stream nextPutAll: '<' , title , '>'].!

----- Method: AbstractHelpTopic>>priority (in category 'accessing') -----
priority

^ nil!

----- Method: AbstractHelpTopic>>priorityForSearch (in category 'accessing') -----
priorityForSearch

^ 0!

----- Method: AbstractHelpTopic>>refresh (in category 'updating') -----
refresh
"Do nothing."!

----- Method: AbstractHelpTopic>>subtopics (in category 'accessing') -----
subtopics
"Topics can be nested in a tree structure."

^ #()!

----- Method: AbstractHelpTopic>>title (in category 'accessing') -----
title
"A brief description of this topic's contents."

^ self contents truncateWithElipsisTo: 20!

AbstractHelpTopic subclass: #ClassAPIHelpTopic
instanceVariableNames: 'theClass withSubclasses withMethods subclassesAsSeparateTopic'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

!ClassAPIHelpTopic commentStamp: 'mt 3/25/2015 15:03' prior: 0!
Show comments of a class, their subclasses and methods.!

----- Method: ClassAPIHelpTopic>>contents (in category 'accessing') -----
contents

^ self theClass instanceSide organization classComment!

----- Method: ClassAPIHelpTopic>>icon (in category 'accessing') -----
icon

^ ToolIcons iconNamed: (ToolIcons iconForClass: self theClass name)!

----- Method: ClassAPIHelpTopic>>subclassesAsSeparateTopic (in category 'accessing') -----
subclassesAsSeparateTopic

^ subclassesAsSeparateTopic!

----- Method: ClassAPIHelpTopic>>subclassesAsSeparateTopic: (in category 'accessing') -----
subclassesAsSeparateTopic: aBoolean

subclassesAsSeparateTopic := aBoolean.!

----- Method: ClassAPIHelpTopic>>subtopics (in category 'accessing') -----
subtopics

^ (self withMethods ifFalse: [#()] ifTrue: [ {
MethodListHelpTopic new theClass: self theClass theNonMetaClass.
MethodListHelpTopic new theClass: self theClass theMetaClass }]),

(self withSubclasses ifFalse: [#()] ifTrue: [
| topics |
topics := self theClass subclasses collect: [:cls |
self class new
theClass: cls;
subclassesAsSeparateTopic: self subclassesAsSeparateTopic;
withMethods: self withMethods;
withSubclasses: self withSubclasses].

self subclassesAsSeparateTopic
ifTrue: [{(HelpTopic named: 'Subclasses')
subtopics: topics;
yourself}]
ifFalse: [topics]])!

----- Method: ClassAPIHelpTopic>>theClass (in category 'accessing') -----
theClass

^ theClass!

----- Method: ClassAPIHelpTopic>>theClass: (in category 'accessing') -----
theClass: aClassDescription

theClass := aClassDescription.!

----- Method: ClassAPIHelpTopic>>title (in category 'accessing') -----
title

^ self theClass name!

----- Method: ClassAPIHelpTopic>>withMethods (in category 'accessing') -----
withMethods

^ withMethods ifNil:[false]!

----- Method: ClassAPIHelpTopic>>withMethods: (in category 'accessing') -----
withMethods: aBoolean

withMethods := aBoolean.!

----- Method: ClassAPIHelpTopic>>withSubclasses (in category 'accessing') -----
withSubclasses

^ withSubclasses ifNil:[false]!

----- Method: ClassAPIHelpTopic>>withSubclasses: (in category 'accessing') -----
withSubclasses: aBoolean

withSubclasses := aBoolean.!

AbstractHelpTopic subclass: #ClassBasedHelpTopic
instanceVariableNames: 'helpClass subtopics'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

!ClassBasedHelpTopic commentStamp: 'mt 3/24/2015 16:28' prior: 0!
This kind of topic uses subclasses and methods to encode books and pages.!

----- Method: ClassBasedHelpTopic>>contents (in category 'accessing') -----
contents
"A book has no contents. Only its pages do."

^ ''!

----- Method: ClassBasedHelpTopic>>hasSubtopics (in category 'testing') -----
hasSubtopics

^ self helpClass pages notEmpty or: [self helpClass subclasses notEmpty]!

----- Method: ClassBasedHelpTopic>>helpClass (in category 'accessing') -----
helpClass

^ helpClass!

----- Method: ClassBasedHelpTopic>>helpClass: (in category 'accessing') -----
helpClass: aHelpClass

helpClass := aHelpClass.!

----- Method: ClassBasedHelpTopic>>icon (in category 'accessing') -----
icon
^ self helpClass icon!

----- Method: ClassBasedHelpTopic>>isEditable (in category 'testing') -----
isEditable
^ true!

----- Method: ClassBasedHelpTopic>>priority (in category 'accessing') -----
priority

^ self helpClass priority!

----- Method: ClassBasedHelpTopic>>refresh (in category 'updating') -----
refresh

self updateSubtopics.
self changed: #subtopicsUpdated.!

----- Method: ClassBasedHelpTopic>>subtopics (in category 'accessing') -----
subtopics

^ subtopics ifNil: [self updateSubtopics]!

----- Method: ClassBasedHelpTopic>>title (in category 'accessing') -----
title
^ self helpClass bookName!

----- Method: ClassBasedHelpTopic>>updateSubtopics (in category 'updating') -----
updateSubtopics

| pages |
pages := (self helpClass pages collect: [:pageSelectorOrClassName |
(Smalltalk hasClassNamed: pageSelectorOrClassName asString)
ifTrue: [Smalltalk classNamed: pageSelectorOrClassName asString]
ifFalse: [pageSelectorOrClassName]]) asOrderedCollection.

self helpClass subclasses
select: [:cls | cls ignore not]
thenDo: [:cls | pages addIfNotPresent: cls].

^ subtopics := pages withIndexCollect: [:pageSelectorOrClass :priority |
pageSelectorOrClass isBehavior
ifFalse: [(self helpClass perform: pageSelectorOrClass) priority: priority - pages size; key: pageSelectorOrClass; yourself]
ifTrue: [pageSelectorOrClass asHelpTopic]]!

AbstractHelpTopic subclass: #HelpTopic
instanceVariableNames: 'title key icon contents subtopics priority'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

!HelpTopic commentStamp: 'mt 3/25/2015 11:27' prior: 0!
This is a configurable version of a help topic. You can define its contents, title, icon, and subtopics manually.

Help builders make use of this.!

----- Method: HelpTopic class>>named: (in category 'instance creation') -----
named: aString
"Create a new instance with given title and empty contents"

^(self new)
title: aString;
yourself!

----- Method: HelpTopic class>>title:contents: (in category 'instance creation') -----
title: aTitle contents: aText
"Create a new instance with given title and content"

^(self new)
title: aTitle;
contents: aText;
yourself.
!

----- Method: HelpTopic class>>title:icon:contents: (in category 'instance creation') -----
title: aTitle icon: anIcon contents: aText
"Create a new instance with given title, icon and content"

^(self new)
title: aTitle;
icon: anIcon;
contents: aText;
yourself.
!

----- Method: HelpTopic>>addSubtopic: (in category 'accessing') -----
addSubtopic: aTopic
"Adds the given topic to the receivers collection of subtopics"

self subtopics add: aTopic.
self changed: #subtopicAdded with: aTopic.
^aTopic!

----- Method: HelpTopic>>contents (in category 'accessing') -----
contents
"Returns the receivers contents"

^ contents!

----- Method: HelpTopic>>contents: (in category 'accessing') -----
contents: anObject
"Sets the receivers contents to the given object"

contents := anObject!

----- Method: HelpTopic>>defaultTitle (in category 'defaults') -----
defaultTitle
"Returns the receivers default title"

^'Unnamed Topic'
!

----- Method: HelpTopic>>icon (in category 'accessing') -----
icon
"Returns the receivers icon"

^icon!

----- Method: HelpTopic>>icon: (in category 'accessing') -----
icon: aSymbol
"Sets the receivers icon"

icon := aSymbol !

----- Method: HelpTopic>>initialize (in category 'initialize-release') -----
initialize
"Initializes the receiver"

super initialize.
self title: self defaultTitle.
self contents: ''.!

----- Method: HelpTopic>>key (in category 'accessing') -----
key

^ key!

----- Method: HelpTopic>>key: (in category 'accessing') -----
key: aSymbol

key := aSymbol.!

----- Method: HelpTopic>>priority (in category 'accessing') -----
priority
"A hint for tools to influence sort order."

^ priority!

----- Method: HelpTopic>>priority: (in category 'accessing') -----
priority: anInteger

priority := anInteger.!

----- Method: HelpTopic>>sortSubtopicsByTitle (in category 'operating') -----
sortSubtopicsByTitle
"Sort the subtopics by title"

subtopics := SortedCollection withAll: self subtopics !

----- Method: HelpTopic>>subtopics (in category 'accessing') -----
subtopics
"Returns the receivers list of subtopics"

subtopics isNil ifTrue: [subtopics := OrderedCollection new].
^subtopics!

----- Method: HelpTopic>>subtopics: (in category 'accessing') -----
subtopics: aCollection
"Sets the receivers subtopics"

subtopics := aCollection !

----- Method: HelpTopic>>title (in category 'accessing') -----
title
"Returns the receivers title"

^ title!

----- Method: HelpTopic>>title: (in category 'accessing') -----
title: anObject
"Sets the receivers title"

title := anObject!

AbstractHelpTopic subclass: #HtmlHelpTopic
instanceVariableNames: 'url document selectBlock convertBlock subtopicUrls subtopics level'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

----- Method: HtmlHelpTopic>>contents (in category 'accessing') -----
contents

| start end |
start := (self document findString: '<body').
start := (self document findString: '>' startingAt: start) + 1.
end := self document findString: '</body>' startingAt: start.

start > end ifTrue: [^ self document].

^ ((self document copyFrom: start to: end - 1)
copyReplaceAll: String cr with: '<br>')
asTextFromHtml!

----- Method: HtmlHelpTopic>>convertBlock (in category 'accessing') -----
convertBlock

^ convertBlock ifNil: [ [:aUrl | aUrl] ]!

----- Method: HtmlHelpTopic>>convertBlock: (in category 'accessing') -----
convertBlock: aBlock

convertBlock := aBlock.!

----- Method: HtmlHelpTopic>>document (in category 'accessing') -----
document

^ document ifNil: [document :=
[
(HTTPSocket httpGet: self url accept: 'text/html') contents
] on: Error do: [:err | err printString]]!

----- Method: HtmlHelpTopic>>fetchSubtopics (in category 'caching') -----
fetchSubtopics
"If this method is called from another process than the ui process, there will be no progress shown."

| updateBlock |
updateBlock := [:topic | topic document; subtopicUrls].

Project current uiProcess == Processor activeProcess
ifFalse: [self subtopics do: updateBlock]
ifTrue: [self subtopics
do: updateBlock
displayingProgress: [:topic | 'Fetching documents ... ', topic url]].!

----- Method: HtmlHelpTopic>>hasSubtopics (in category 'testing') -----
hasSubtopics

^ self subtopicUrls notEmpty!

----- Method: HtmlHelpTopic>>isSearchable (in category 'testing') -----
isSearchable

^ self level < 2!

----- Method: HtmlHelpTopic>>level (in category 'accessing') -----
level

^ level ifNil: [level := 1]!

----- Method: HtmlHelpTopic>>level: (in category 'accessing') -----
level: anInteger

level := anInteger.!

----- Method: HtmlHelpTopic>>priorityForSearch (in category 'accessing') -----
priorityForSearch

^ 999 "very late"!

----- Method: HtmlHelpTopic>>refresh (in category 'caching') -----
refresh
"Re-fetch document and all referenced urls."

document := nil.
subtopics := nil.

self changed: #contents. "See #contents. It is based on document."
self changed: #subtopics.!

----- Method: HtmlHelpTopic>>selectBlock (in category 'accessing') -----
selectBlock

^ selectBlock ifNil: [ [:aUrl | true] ]!

----- Method: HtmlHelpTopic>>selectBlock: (in category 'accessing') -----
selectBlock: aBlock
"Which urls should be followed?"

selectBlock := aBlock.!

----- Method: HtmlHelpTopic>>subtopicUrls (in category 'accessing') -----
subtopicUrls

^ subtopicUrls ifNil: [
| start end |
subtopicUrls := OrderedCollection new.

start := self document findString: '<a '.
start := self document findString: 'href' startingAt: start.
[start > 0] whileTrue: [
start := self document findString: '"' startingAt: start.
end := self document findString: '"' startingAt: start+1.
subtopicUrls addIfNotPresent: (self document copyFrom: start+1 to: end-1).
start := self document findString: '<a ' startingAt: end+1.
start > 0 ifTrue: [start := self document findString: 'href' startingAt: start]].

subtopicUrls := subtopicUrls
select: self selectBlock
thenCollect: self convertBlock.
subtopicUrls]!

----- Method: HtmlHelpTopic>>subtopics (in category 'accessing') -----
subtopics

| start end urls |
subtopics ifNotNil: [^ subtopics].

urls := OrderedCollection new.

start := self document findString: '<a '.
[start > 0] whileTrue: [
start := self document findString: 'href' startingAt: start.
start := (self document findString: '"' startingAt: start) + 1.
end := self document findString: '"' startingAt: start.
urls addIfNotPresent: (self document copyFrom: start to: end - 1).
start := self document findString: '<a ' startingAt: start.].

subtopics := (self subtopicUrls collect: [:aUrl | self class new
level: self level + 1;
url: aUrl;
selectBlock: self selectBlock;
convertBlock: self convertBlock]).

Project current uiProcess == Processor activeProcess
ifTrue: [self fetchSubtopics].

^ subtopics!

----- Method: HtmlHelpTopic>>title (in category 'accessing') -----
title

| start end |
start := (self document findString: '<title') + 6.
start := (self document findString: '>' startingAt: start) + 1.
end := self document findString: '</title>' startingAt: start.

start > end ifTrue: [^ self url asUrl authority].

^ self document copyFrom: start to: end - 1!

----- Method: HtmlHelpTopic>>url (in category 'accessing') -----
url

^ url!

----- Method: HtmlHelpTopic>>url: (in category 'accessing') -----
url: aString

url := aString.!

AbstractHelpTopic subclass: #MethodListHelpTopic
instanceVariableNames: 'theClass'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

----- Method: MethodListHelpTopic>>contents (in category 'accessing') -----
contents

^ (String streamContents: [ :stream |
self theClass selectors sort do: [ :selector |
stream
nextPutAll: self theClass name;
nextPutAll: '>>';
nextPutAll: selector asString;
cr;
nextPutAll: (
(self theClass commentsAt: selector)
at: 1
ifAbsent: [ '-' ]);
cr; cr ] ])!

----- Method: MethodListHelpTopic>>icon (in category 'accessing') -----
icon

^ HelpIcons iconNamed: #pageIcon!

----- Method: MethodListHelpTopic>>priority (in category 'accessing') -----
priority

^ -999!

----- Method: MethodListHelpTopic>>theClass (in category 'accessing') -----
theClass

^ theClass!

----- Method: MethodListHelpTopic>>theClass: (in category 'accessing') -----
theClass: aClassOrMetaClass

theClass := aClassOrMetaClass.!

----- Method: MethodListHelpTopic>>title (in category 'accessing') -----
title

^ self theClass isMeta
ifTrue: ['Class side']
ifFalse: ['Instance side']!

AbstractHelpTopic subclass: #PackageAPIHelpTopic
instanceVariableNames: 'packageName'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

!PackageAPIHelpTopic commentStamp: 'mt 3/25/2015 15:02' prior: 0!
List all classes and their method comments. No subclasses.!

----- Method: PackageAPIHelpTopic>>contents (in category 'accessing') -----
contents

^ ''!

----- Method: PackageAPIHelpTopic>>hasSubtopics (in category 'testing') -----
hasSubtopics

^ SystemOrganization categories anySatisfy: [:cat |
(cat beginsWith: self packageName) and: [(SystemOrganization listAtCategoryNamed: cat) notEmpty]]!

----- Method: PackageAPIHelpTopic>>packageName (in category 'accessing') -----
packageName

^ packageName!

----- Method: PackageAPIHelpTopic>>packageName: (in category 'accessing') -----
packageName: aString

packageName := aString.!

----- Method: PackageAPIHelpTopic>>subtopics (in category 'accessing') -----
subtopics

^ ((PackageInfo named: self packageName) classes
sorted: [:cl1 :cl2 | cl1 name < cl2 name])
collect: [:class | ClassAPIHelpTopic new
theClass: class;
withSubclasses: false;
withMethods: true]!

----- Method: PackageAPIHelpTopic>>title (in category 'accessing') -----
title

^ self packageName!

AbstractHelpTopic subclass: #SearchTopic
instanceVariableNames: 'term process results resultText topicsToSearch mutex updatePending'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Model'!

----- Method: SearchTopic>><= (in category 'comparing') -----
<= anotherHelpTopic

^ true "Keep insertion order in parent topic."!

----- Method: SearchTopic>>contents (in category 'accessing') -----
contents

^ resultText ifNil: [self updateResultText]!

----- Method: SearchTopic>>find:in:results: (in category 'as yet unclassified') -----
find: term in: path results: results

| resultTemplate c topic |
topic := path last.
resultTemplate := Array new: 5.
(topic title asString findString: term startingAt: 1 caseSensitive: false) in: [:index |
index > 0 ifTrue: [resultTemplate at: 2 put: (index to: index + term size)]].

((c := topic contents asString withSqueakLineEndings) findString: term startingAt: 1 caseSensitive: false) in: [:index |
index > 0 ifTrue: [
| leadingContext trailingContext i |
leadingContext := 0.
trailingContext := 0.
i := index.
[i notNil] whileTrue: [
(leadingContext = 2 or: [i = 1])
ifTrue: [
leadingContext := i = 1 ifTrue: [i] ifFalse: [i+1].
i := nil]
ifFalse: [
((c at: i) = Character cr) ifTrue: [
leadingContext := leadingContext + 1].
i := i - 1] ].
i := index + term size.
[i notNil] whileTrue: [
(trailingContext = 2 or: [i = c size])
ifTrue: [
trailingContext := i = c size ifTrue: [i] ifFalse: [i-1].
i := nil]
ifFalse: [
((c at: i) = Character cr) ifTrue: [
trailingContext := trailingContext + 1].
i := i + 1] ].

resultTemplate
at: 1 put: path;
at: 3 put: (index - leadingContext + 1 to: index - leadingContext + term size);
at: 4 put: (c copyFrom: leadingContext to: trailingContext);
at: 5 put: leadingContext.

self mutex critical: [ results add: resultTemplate ].
self triggerUpdateContents.

] ].

topic isSearchable ifTrue: [
topic subtopics do: [:t | self find: term in: path, {t} results: results]].!

----- Method: SearchTopic>>mutex (in category 'as yet unclassified') -----
mutex

^ mutex ifNil: [mutex := Mutex new]!

----- Method: SearchTopic>>printResultEntry: (in category 'as yet unclassified') -----
printResultEntry: entry

| resultEntry topic |
resultEntry := '' asText.
topic := entry first last.

entry second notNil
ifFalse: [resultEntry append: (
(topic title) asText
addAttribute: TextEmphasis bold)]
ifTrue: [resultEntry append: (
(topic title) asText
addAttribute: TextEmphasis bold;
addAttribute: (TextColor color: Color green muchDarker)
from: entry second first
to: entry second last)].

resultEntry append: (' (open topic)' asText
addAttribute: (PluggableTextAttribute evalBlock: [self changed: #searchResultSelected with: entry first])).

resultEntry append: String cr.

entry fourth in: [:contents |
| text |
text := contents asText.
text
addAttribute: (TextColor color: Color green muchDarker)
from: entry third first
to: entry third last;
addAttribute: TextEmphasis bold
from: entry third first
to: entry third last.
resultEntry
append: text withBlanksTrimmed;
append: '\\' withCRs.

].

^ resultEntry!

----- Method: SearchTopic>>startSearch (in category 'as yet unclassified') -----
startSearch

self stopSearch.
results := OrderedCollection new.

self topicsToSearch ifEmpty: [
self changed: #contents.
^ self].

process := [

(self topicsToSearch
sorted: [:t1 :t2 | t1 priorityForSearch <= t2 priorityForSearch])
do: [:topic |
| nestedResults |
nestedResults := OrderedCollection new.
self mutex critical: [results add: topic -> nestedResults].
self find: self term in: {topic} results: nestedResults].

results add: 'Search finished.'.
self triggerUpdateContents.

] forkAt: 35.!

----- Method: SearchTopic>>stopSearch (in category 'as yet unclassified') -----
stopSearch

process ifNotNil: #terminate.
process := nil.!

----- Method: SearchTopic>>term (in category 'accessing') -----
term

^ term!

----- Method: SearchTopic>>term: (in category 'accessing') -----
term: aString

term := aString.!

----- Method: SearchTopic>>title (in category 'accessing') -----
title

^ '''', self term, ''''!

----- Method: SearchTopic>>topicsToSearch (in category 'accessing') -----
topicsToSearch

^ topicsToSearch ifNil: [#()]!

----- Method: SearchTopic>>topicsToSearch: (in category 'accessing') -----
topicsToSearch: someTopics

topicsToSearch := someTopics.!

----- Method: SearchTopic>>triggerUpdateContents (in category 'as yet unclassified') -----
triggerUpdateContents

self mutex critical: [
updatePending == true ifFalse: [
updatePending := true.
Project current addDeferredUIMessage: [ActiveWorld
addAlarm: #updateContents withArguments: #()
for: self at: Time millisecondClockValue + 250] ] ].
!

----- Method: SearchTopic>>updateContents (in category 'as yet unclassified') -----
updateContents

self mutex critical: [ updatePending := false ].

resultText := nil.
self changed: #contents with: self.!

----- Method: SearchTopic>>updateResultText (in category 'as yet unclassified') -----
updateResultText

resultText := '' asText.

self mutex critical: [
results ifNil: [^ resultText].
results do: [:topicToResult |
topicToResult isString
ifTrue: [resultText append: (
(topicToResult, String cr) asText
addAttribute: (TextColor color: (Color gray: 0.7));
yourself)]
ifFalse: [
resultText append: (
('\----- Matches found in ''', topicToResult key title, ''' -----\\') withCRs asText
addAttribute: (TextColor color: (Color gray: 0.7))).
topicToResult value do: [:entry |
resultText append: (self printResultEntry: entry)]
]]].

^ resultText!

Model subclass: #HelpBrowser
instanceVariableNames: 'rootTopic currentTopic currentParentTopic result searchTopic topicPath toplevelTopics oldTopic'
classVariableNames: 'DefaultHelpBrowser'
poolDictionaries: ''
category: 'HelpSystem-Core-UI'!

!HelpBrowser commentStamp: 'tbn 3/8/2010 09:33' prior: 0!
A HelpBrowser is used to display a hierarchy of help topics and their contents.

Instance Variables
rootTopic: <HelpTopic>
window: <StandardWindow>
treeMorph: <PluggableTreeMorph>
contentMorph: <Morph>

rootTopic
- xxxxx

window
- xxxxx

treeMorph
- xxxxx

contentMorph
- xxxxx

!

----- Method: HelpBrowser class>>defaultHelpBrowser (in category 'accessing') -----
defaultHelpBrowser
DefaultHelpBrowser isNil ifTrue: [DefaultHelpBrowser := self].
^DefaultHelpBrowser
!

----- Method: HelpBrowser class>>defaultHelpBrowser: (in category 'accessing') -----
defaultHelpBrowser: aClass
"Use a new help browser implementation"

DefaultHelpBrowser := aClass
!

----- Method: HelpBrowser class>>initialize (in category 'class initialization') -----
initialize
"Initializes the receiver class"

TheWorldMenu registerOpenCommand: {'Help Browser'. {self. #open}}. !

----- Method: HelpBrowser class>>open (in category 'instance creation') -----
open
^self openOn: CustomHelp!

----- Method: HelpBrowser class>>openOn: (in category 'instance creation') -----
openOn: aHelpTopic
"Open the receiver on the given help topic or any other object that can be transformed into
a help topic by sending #asHelpTopic."

^(self defaultHelpBrowser new)
open;
rootTopic: aHelpTopic;
yourself!

----- Method: HelpBrowser>>accept: (in category 'actions') -----
accept: text
"Accept edited text. Compile it into a HelpTopic"

| code parent topicClass topicMethod |
(self currentParentTopic isNil or: [self currentParentTopic isEditable not])
ifTrue: [^ self inform: 'This help topic cannot be edited.'].

parent := self currentParentTopic.
topicClass := parent helpClass.
topicMethod := self currentTopic key.

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: text]) storeString.
s nextPutAll:' readStream nextChunkText'.
].

topicClass class
compile: code
classified: ((topicClass class organization categoryOfElement: topicMethod) ifNil:['pages']).

parent refresh.
self currentTopic: (parent subtopics detect: [:t | t key = topicMethod]).!

----- Method: HelpBrowser>>buildWith: (in category 'toolbuilder') -----
buildWith: builder

| windowSpec treeSpec textSpec searchSpec |
windowSpec := builder pluggableWindowSpec new.
windowSpec
model: self;
children: OrderedCollection new;
label: #label.

searchSpec := builder pluggableInputFieldSpec new.
searchSpec
model: self;
getText: #searchTerm;
setText: #searchTerm:;
help: 'Search...';
frame: (LayoutFrame
fractions: (0@0 corner: 1@0)
offsets: (0@0 corner: 0@ (Preferences standardDefaultTextFont height * 2))).
windowSpec children add: searchSpec.

treeSpec := builder pluggableTreeSpec new.
treeSpec
model: self;
nodeClass: HelpTopicListItemWrapper;
roots: #toplevelTopics;
getSelected: #currentTopic;
setSelected: #currentTopic:;
getSelectedPath: #currentTopicPath;
setSelectedParent: #currentParentTopic:;
autoDeselect: false;
frame: (LayoutFrame
fractions: (0@0 corner: 0.3@1)
offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0@0)).
windowSpec children add: treeSpec.

textSpec := builder pluggableTextSpec new.
textSpec
model: self;
getText: #topicContents;
setText: #accept:;
menu: #codePaneMenu:shifted:;
frame: (LayoutFrame
fractions: (0.3@0.0 corner: 1@1)
offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0@0)).
windowSpec children add: textSpec.

^ builder build: windowSpec!

----- Method: HelpBrowser>>codePaneMenu:shifted: (in category 'events') -----
codePaneMenu: aMenu shifted: shifted
^ StringHolder basicNew codePaneMenu: aMenu shifted: shifted
!

----- Method: HelpBrowser>>currentParentTopic (in category 'accessing') -----
currentParentTopic

^ currentParentTopic!

----- Method: HelpBrowser>>currentParentTopic: (in category 'accessing') -----
currentParentTopic: aHelpTopic

currentParentTopic := aHelpTopic.!

----- Method: HelpBrowser>>currentTopic (in category 'accessing') -----
currentTopic

^ currentTopic!

----- Method: HelpBrowser>>currentTopic: (in category 'accessing') -----
currentTopic: aHelpTopic

self currentTopic == aHelpTopic ifTrue: [^ self].

currentTopic := aHelpTopic.
topicPath := nil.

self changed: #currentTopic.
self changed: #topicContents.!

----- Method: HelpBrowser>>currentTopicPath (in category 'accessing') -----
currentTopicPath
"Only used for dynamic dispatch. Should be nil or empty on manual evaluation. See #topic:."

^ topicPath ifNil: [#()]!

----- Method: HelpBrowser>>currentTopicPath: (in category 'accessing') -----
currentTopicPath: someTopics
"Use the tree structure to select a nested topic."

topicPath := someTopics.
self changed: #currentTopicPath.!

----- Method: HelpBrowser>>find (in category 'actions') -----
find
"Prompt the user for a string to search for, and search the receiver from the current selection onward for it."

| reply |
reply := UIManager default request: 'Find what? ' initialAnswer: ''.
reply size = 0 ifTrue: [
^ self].
self findStringInHelpTopic: reply
!

----- Method: HelpBrowser>>find: (in category 'actions') -----
find: aString
^SystemNavigation allMethodsSelect: [:method |
method hasLiteralSuchThat: [:lit |
(lit isString and: [lit isSymbol not]) and:
[lit includesSubstring: aString caseSensitive: false]]]
localTo: CustomHelp
!

----- Method: HelpBrowser>>findAgain (in category 'actions') -----
findAgain
| i |
(i := result indexOf: currentTopic) ~= 0
ifTrue: [i = result size
ifTrue: [(self confirm: 'Start over?')
ifTrue: [i := 1]
ifFalse: [^ self]].
self
onItemClicked: (result at: i + 1)]!

----- Method: HelpBrowser>>findStringInHelpTopic: (in category 'actions') -----
findStringInHelpTopic: aString

result := OrderedCollection new.
self inSubtopic: self rootTopic find: aString.
result ifNotEmpty: [self topic: result first].
!

----- Method: HelpBrowser>>inSubtopic:find: (in category 'actions') -----
inSubtopic: aTopic find: aString
((aTopic title asString includesSubstring: aString caseSensitive: false)
or: [aTopic contents asString includesSubstring: aString caseSensitive: false])
ifTrue: [result addIfNotPresent: aTopic].
aTopic subtopics
do: [:sub | self inSubtopic: sub find: aString]!

----- Method: HelpBrowser>>inTopic:replaceCurrentTopicWith: (in category 'actions') -----
inTopic: parentTopic replaceCurrentTopicWith: aNewTopic

parentTopic subtopics
do: [ :sub | self inTopic: parentTopic replaceSubtopic: sub with: aNewTopic]!

----- Method: HelpBrowser>>inTopic:replaceSubtopic:with: (in category 'actions') -----
inTopic: parentTopic replaceSubtopic: aTopic with: aNewTopic
| i |

(aTopic = oldTopic)
ifTrue: [ i := parentTopic subtopics indexOf: aTopic.
parentTopic subtopics at: i put: aNewTopic. ^self ].

aTopic subtopics
do: [ :sub | self inTopic: aTopic replaceSubtopic: sub with: aNewTopic]!

----- Method: HelpBrowser>>label (in category 'accessing - ui') -----
label

^ self rootTopic
ifNil: ['Help Browser']
ifNotNil: [:topic | topic title]!

----- Method: HelpBrowser>>menu: (in category 'events') -----
menu: aMenu
^aMenu add: 'find...' translated action: #find.

!

----- Method: HelpBrowser>>open (in category 'ui') -----
open

ToolBuilder open: self.!

----- Method: HelpBrowser>>rootTopic (in category 'accessing') -----
rootTopic
^rootTopic!

----- Method: HelpBrowser>>rootTopic: (in category 'accessing') -----
rootTopic: aHelpTopic

rootTopic := aHelpTopic asHelpTopic.

self toplevelTopics: ((self rootTopic ifNil: [#()] ifNotNil: #subtopics) sorted, {self searchTopic}).
self changed: #label.!

----- Method: HelpBrowser>>searchTerm (in category 'searching') -----
searchTerm

^ '' "Reset. Terms are cached in SearchTopic instances."!

----- Method: HelpBrowser>>searchTerm: (in category 'searching') -----
searchTerm: aString
"Spawn a new search topic."

| topic |
topic := self searchTopic subtopics
detect: [:t | t term = aString]
ifNone: [ | newTopic |
newTopic := SearchTopic new
term: aString;
yourself.
self searchTopic addSubtopic: newTopic.
newTopic addDependent: self. "Tell me about your updates."
newTopic].

"self changed: #searchTerm."

"Select results and expand searches node if necessary."
self currentTopicPath: {self searchTopic. topic}.
self assert: self currentTopic == topic.

topic
topicsToSearch: self toplevelTopics allButLast;
startSearch.!

----- Method: HelpBrowser>>searchTopic (in category 'searching') -----
searchTopic

^ searchTopic ifNil: [searchTopic := HelpTopic new
title: 'Search Results';
addDependent: self;
yourself]!

----- Method: HelpBrowser>>topicContents (in category 'accessing - ui') -----
topicContents

^ (self currentTopic ifNil: [self rootTopic]) ifNil: '' ifNotNil: #contents!

----- Method: HelpBrowser>>toplevelTopics (in category 'accessing') -----
toplevelTopics

^ toplevelTopics ifNil: [#()]!

----- Method: HelpBrowser>>toplevelTopics: (in category 'accessing') -----
toplevelTopics: someTopics

toplevelTopics := someTopics.
self changed: #toplevelTopics.!

----- Method: HelpBrowser>>update:with: (in category 'updating') -----
update: aspect with: object

aspect == #contents ifTrue: [
object == self currentTopic ifTrue: [self changed: #topicContents]].
aspect == #searchResultSelected ifTrue: [
self currentTopicPath: object].!

----- Method: HelpBrowser>>windowIsClosing (in category 'updating') -----
windowIsClosing

super windowIsClosing.

self searchTopic subtopics do: [:topic |
topic stopSearch].!

PluggableListItemWrapper subclass: #HelpTopicListItemWrapper
instanceVariableNames: 'parent'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-UI'!

!HelpTopicListItemWrapper commentStamp: 'tbn 3/8/2010 09:30' prior: 0!
This class implements a list item wrapper for help topics.

Instance Variables
!

----- Method: HelpTopicListItemWrapper class>>with:model:parent: (in category 'as yet unclassified') -----
with: anObject model: aModel parent: aParent

^self new
setItem: anObject model: aModel parent: aParent
!

----- Method: HelpTopicListItemWrapper>>asString (in category 'accessing') -----
asString
"Returns a string used as a label"

^ self item title!

----- Method: HelpTopicListItemWrapper>>balloonText (in category 'accessing') -----
balloonText
"Returns a string used for fly by help"

^self item title!

----- Method: HelpTopicListItemWrapper>>contents (in category 'accessing') -----
contents

^self item subtopics sorted collect: [ :each |
HelpTopicListItemWrapper with: each model: self model parent: self]
!

----- Method: HelpTopicListItemWrapper>>hasContents (in category 'accessing') -----
hasContents

^ self item hasSubtopics!

----- Method: HelpTopicListItemWrapper>>icon (in category 'accessing') -----
icon
"Either return the icon for the given topic"

| symbol |
self item icon ifNotNil: [:icon | ^ icon].
symbol := self item hasSubtopics
ifTrue: [#bookIcon]
ifFalse: [#pageIcon].
^HelpIcons iconNamed: symbol!

----- Method: HelpTopicListItemWrapper>>item (in category 'accessing') -----
item

^ super item ifNil: [HelpTopic new]!

----- Method: HelpTopicListItemWrapper>>parent (in category 'accessing') -----
parent

^ parent!

----- Method: HelpTopicListItemWrapper>>parent: (in category 'accessing') -----
parent: aWrapper

parent := aWrapper.!

----- Method: HelpTopicListItemWrapper>>setItem:model:parent: (in category 'initialization') -----
setItem: anObject model: aModel parent: itemParent

self parent: itemParent.
self setItem: anObject model: aModel.!

----- Method: HelpTopicListItemWrapper>>update: (in category 'accessing') -----
update: aspect

super update: aspect.

"Map the domain-specific aspect to a framework-specific one."
aspect = #subtopicsUpdated ifTrue: [
self changed: #contents].!

----- Method: HelpTopicListItemWrapper>>update:with: (in category 'accessing') -----
update: aspect with: object

super update: aspect with: object.

"Map the domain-specific aspect to a framework-specific one."
aspect = #subtopicAdded ifTrue: [
self changed: #contents].!

Object subclass: #CustomHelp
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Utilities'!

!CustomHelp commentStamp: 'tbn 3/29/2010 13:23' prior: 0!
This is a common superclass for custom help. Subclasses of this class are automatically included into the system help.

By default the informations provided on the receiver class are converted into help topics by a specific builder
- here the CustomHelpHelpBuilder. Note that you can provide an own custom builder by overriding the #builder method

!

----- Method: CustomHelp class>>accept:title:contents: (in category 'editing') -----
accept: aSelector title: title contents: text
"Accept edited text. Compile it into a HelpTopic"

| code |
code := String streamContents:[:s|
s nextPutAll: aSelector.
s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'.
s crtab; nextPutAll: '"', self name,' edit: ', aSelector storeString,'"'.
s crtab; nextPutAll: '^HelpTopic'.
s crtab: 2; nextPutAll: 'title: ', title storeString.
s crtab: 2; nextPutAll: 'contents: '.
s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: text]) storeString.
s nextPutAll:' readStream nextChunkText'.
].

self class
compile: code
classified: ((self class organization categoryOfElement: aSelector) ifNil:['pages']).
!

----- Method: CustomHelp class>>asHelpTopic (in category 'converting') -----
asHelpTopic
"Convert the receiver to a help topic"

^ ClassBasedHelpTopic new helpClass: self!

----- Method: CustomHelp class>>bookName (in category 'accessing') -----
bookName
"Returns the name of the custom help book"

^'Help'!

----- Method: CustomHelp class>>edit: (in category 'editing') -----
edit: aSelector
"Open a Workspace on the text in the given selector.
When accepted, compile the result as a help topic."

| topic window |
topic := (self respondsTo: aSelector)
ifTrue:[self perform: aSelector]
ifFalse:[HelpTopic title: 'Untitled' contents: 'Please edit this topic.
To change the topic title, edit the window label.'].
window := UIManager default
edit: topic contents
label: topic title
accept: [:text| self accept: aSelector title: window label contents: text].
!

----- Method: CustomHelp class>>icon (in category 'accessing') -----
icon
"Returns an icon used for displaying the custom help book"

^HelpIcons iconNamed: #bookIcon!

----- Method: CustomHelp class>>ignore (in category 'accessing') -----
ignore

^ false!

----- Method: CustomHelp class>>pages (in category 'accessing') -----
pages
"Returns a collection of method selectors to return the pages of the custom help book"

^#()!

----- Method: CustomHelp class>>priority (in category 'accessing') -----
priority

^ nil!

CustomHelp subclass: #HelpOnHelp
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Help'!

!HelpOnHelp commentStamp: 'dtl 11/13/2014 19:20' prior: 0!
HelpOnHelp is documentation for the help system!

HelpOnHelp subclass: #HelpAPIDocumentation
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Help'!

!HelpAPIDocumentation commentStamp: 'tbn 4/30/2010 15:12' prior: 0!
This class represents the browsable package API help for the help system.

Instance Variables
!

----- Method: HelpAPIDocumentation class>>asHelpTopic (in category 'defaults') -----
asHelpTopic

^ (HelpTopic named: self bookName)
subtopics: (self packages collect: [:pkgName | PackageAPIHelpTopic new packageName: pkgName]);
yourself!

----- Method: HelpAPIDocumentation class>>bookName (in category 'accessing') -----
bookName
^'API Documentation'!

----- Method: HelpAPIDocumentation class>>packages (in category 'accessing') -----
packages
^#('HelpSystem-Core-Model' 'HelpSystem-Core-Utilities' 'HelpSystem-Core-UI')!

HelpOnHelp subclass: #HelpHowToHelpTopics
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Help'!

----- Method: HelpHowToHelpTopics class>>bookName (in category 'accessing') -----
bookName
^'Implementation'!

----- Method: HelpHowToHelpTopics class>>overview (in category 'pages') -----
overview
^HelpTopic
title: 'Overview'
contents:
'THE IMPLEMENTATION

The help system typically consists of help books including one or more pages. A book or page is therefore a "topic of interest" providing contents for help to a user. A topic has a title and an icon and is able to have subtopics forming a hierarchy of topics. This simple model is reflected in the class HelpTopic.

Since this model forms a hierarchical structure of help topics there is a browser with a tree to display the help contents. This browser is implemented in class HelpBrowser.

You can open this browser programmatically using:

HelpBrowser open
' !

----- Method: HelpHowToHelpTopics class>>page1 (in category 'pages') -----
page1
^HelpTopic
title: '1. Simple help topics'
contents: 'The help browser usually operates on a hierarchy of help topics with one help topic at the root level. Evaluate the following expression in a workspace to contruct a simple help topic and open it as a root topic in the help browser.

|root|
root := HelpTopic
title: ''My first topic''
contents: ''A simple topic of interest''.

HelpBrowser openOn: root

Note that the help browser displays the contents of our topic in the right page and uses the topics title as the title for the help browser window.
'!

----- Method: HelpHowToHelpTopics class>>page2 (in category 'pages') -----
page2
^HelpTopic
title: '2. Forming a hierarchy'
contents: 'To form a hierarchy we just have to add new subtopics on our root topic.

|root sub1 sub2|
root := HelpTopic
title: ''My first topic''
contents: ''A simple topic of interest''.
sub1 := HelpTopic
title: ''My first subtopic''
contents: ''First subsection''.
sub2 := HelpTopic
title: ''My second subtopic''
contents: ''Second subsection''.
root
addSubtopic: sub1;
addSubtopic: sub2.
HelpBrowser openOn: root

'!

----- Method: HelpHowToHelpTopics class>>page3 (in category 'pages') -----
page3
^HelpTopic
title: '3. Adding icons'
contents: 'If you dont like the default icon you can add own custom icons to the topics. See the class HelpIcons for more details.

|root sub1 sub2|
root := HelpTopic
title: ''My first topic''
contents: ''A simple topic of interest''.
sub1 := HelpTopic
title: ''My first subtopic''
contents: ''First subsection''.
sub2 := HelpTopic
title: ''My second subtopic''
icon: (HelpIcons iconNamed: #packageIcon)
contents: ''Second subsection''.
root
addSubtopic: sub1;
addSubtopic: sub2.
HelpBrowser openOn: root

'!

----- Method: HelpHowToHelpTopics class>>page4 (in category 'pages') -----
page4
^HelpTopic
title: '4. Own help objects'
contents:
'You can open this help browser directly on an instance of HelpTopic, but it is more common to open it on any object that understands the message #asHelpTopic.

So you can write for instance:

HelpBrowser openOn: Integer

opening a short API help/system reference on the Integer class.
The above expression is the short form for:

HelpBrowser openOn: (SystemReference forClass: Integer)

If you want you can include the subclasses:

HelpBrowser openOn: (SystemReference hierarchyFor: Integer)

or even methods

HelpBrowser openOn: (SystemReference hierarchyWithMethodsFor: Integer)

You can browse the whole system reference documentation using:

HelpBrowser openOn: SystemReference

But these are only a few examples what we can extract from the
system.

However - the major goal is NOT an API browser, the idea is to
provide a simple architecture to provide browsable help contents
depending on the context. For instance it should also be possible
to use the help system to provide end user help on any commercial
application that is written with the Smalltalk system.

' !

----- Method: HelpHowToHelpTopics class>>page5 (in category 'pages') -----
page5
^HelpTopic
title: '5. Help sources'
contents:
'Since the underlying model is very simple you can easily fill it with nearly any information from different sources. Try this:

|topic day url sub|
topic := HelpTopic named: ''Last week on Squeak IRC''.
0 to: 7 do: [:index |
day := (Date today subtractDays: index) printFormat: #(3 2 1 $. 1 2 2).
url := ''http://tunes.org/~nef/logs/squeak/'' , day.
sub := HelpTopic
title: day contents: (HTTPLoader default retrieveContentsFor: url) contents.
topic addSubtopic: sub.
].
HelpBrowser openOn: topic

' !

----- Method: HelpHowToHelpTopics class>>pages (in category 'accessing') -----
pages
^#(overview page1 page2 page3 page4 page5)!

HelpHowToHelpTopics subclass: #HelpHowToHelpTopicsFromCode
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Help'!

----- Method: HelpHowToHelpTopicsFromCode class>>bookName (in category 'accessing') -----
bookName
^'Custom help from code'!

----- Method: HelpHowToHelpTopicsFromCode class>>overview (in category 'pages') -----
overview
^HelpTopic
title: 'Overview'
contents:
'OVERVIEW

The help system allows you to provide own books and help texts. You can open the help browser on any object that is able to understand #asHelpTopic.

This method returns the root node of the displayed topic hierarchy:

HelpBrowser openOn: myObject

Typically the object does not convert itself to a help topic structure, usually it dispatches to a builder (see HelpBuilder and subclasses) who does all this.

A much more convenient and reproducable way is to implement custom help classes. This allows you to implement and manage your help texts using the standard development and code management tools. These custom help classes are subclasses of "CustomHelp" and are automatically included into the standard help browser. '!

----- Method: HelpHowToHelpTopicsFromCode class>>pages (in category 'accessing') -----
pages
^#(overview step1 step2 step3 step4 step5 step6 step7)!

----- Method: HelpHowToHelpTopicsFromCode class>>step1 (in category 'pages') -----
step1
^HelpTopic
title: 'Step 1 - Create a class for the book'
contents:
'STEP 1 - CREATE A CLASS FOR THE BOOK

There is a predefined class CustomHelp which you have to subclass for a custom help book to show up as a book in the Help browser:

CustomHelp subclass: #MyAppHelp
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''MyApp-Help''

Class methods on this class can reflect pages and if you want to provide nested help books just subclass your own help class to form a hierarchy. Any new subclass of MyAppHelp will then be a new book in your hierarchy.

The class category used should end with "-Help" so it is easy to recognize that it includes the help support of your project.'
!

----- Method: HelpHowToHelpTopicsFromCode class>>step2 (in category 'pages') -----
step2
^HelpTopic
title: 'Step 2 - Provide a book name'
contents:
'STEP 2 - PROVIDE A BOOK NAME

Now implement the class method #bookName to return the name of your help book.

bookName
^''My App help''

By implementing this method the system knows how you would like to name your book and uses the given string as a label in the HelpBrowser later.'
!

----- Method: HelpHowToHelpTopicsFromCode class>>step3 (in category 'pages') -----
step3
^HelpTopic
title: 'Step 3 - Implement pages using methods'
contents:
'STEP 3 - IMPLEMENT PAGES USING METHODS

Implement a page by defining a method that returns an instance of HelpPage defining a page title and a help text displayed in the help browser.

firstPage
^HelpTopic
title: ''First Page''
contents: ''Hello world''

Define a new method for each page of your book. Please group the pages in a method category called "pages".
You can also define an icon for the specific page:

secondPage
^HelpTopic
title: ''Second Page''
icon: (HelpIcons iconNamed: #packageIcon)
contents: ''More to come''

Note:
=====
Later we may add support for better help contents than just plain text (markup descriptions, active morphs, ...) '
!

----- Method: HelpHowToHelpTopicsFromCode class>>step4 (in category 'pages') -----
step4
^HelpTopic
title: 'Step 4 - Defining the page order'
contents:
'STEP 4 - DEFINING THE PAGE ORDER

By implementing the class method #pages you return a collection of method selectors to define the order in which the pages appear in your book:

pages
^#(firstPage secondPage)

'
!

----- Method: HelpHowToHelpTopicsFromCode class>>step5 (in category 'pages') -----
step5
^HelpTopic
title: 'Step 5 - Test your help'
contents:
'STEP 5 - TEST YOUR HELP

By using

HelpBrowser open

'
!

----- Method: HelpHowToHelpTopicsFromCode class>>step6 (in category 'pages') -----
step6
^HelpTopic
title: 'Step 6 - Add more structure'
contents:
'STEP 6 - ADD MORE STRUCTURE

If you add a new subclass to your custom help class and repeating step 2 to 4 you can
profide new substructures (subbooks) since the help books are mapped to the
class hierarchy. Example:

MyAppHelp subclass: #MyAppTutorial
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''MyApp-Help''

then implement a #bookName, the pages and a #pages method as before on this new
class and reopen the help browser.
'
!

----- Method: HelpHowToHelpTopicsFromCode class>>step7 (in category 'pages') -----
step7
^HelpTopic
title: 'Step 7 - Tips and Tricks'
contents:
'STEP 7 - TIPS AND TRICKS

Tip1:
If you implement the #pages method you can also
use the name of a custom help class that should be
integrated between the specific pages:

#pages
^(firstPage MyAppTutorial secondPage)

Tip2:
You can easily edit the help contents of a page by
using the #edit: message. For our example just evaluate:

MyAppHelp edit: #firstPage

This will open a workspace with the help contents and
when you accept it it will be saved back to the help
method defining the topic.

'
!

----- Method: HelpOnHelp class>>bookName (in category 'accessing') -----
bookName
^'Help on Help'!

----- Method: HelpOnHelp class>>introduction (in category 'pages') -----
introduction
"This method was automatically generated. Edit it using:"
"HelpOnHelp edit: #introduction"
^HelpTopic
title: 'Introduction'
contents:
'WELCOME TO THE HELP SYSTEM

The help system is a simple user interface to display help contents to the user. It can be accessed from the world menu using "Tools" -> "Help Browser" or by evaluating ''HelpBrowser open'' in a workspace.

There is a predefined mechanism allowing you to have help contents stored as source code using methods in specific help provider classes. This allows you to manage the help texts using the standard development tools. But this is only one possible representation.
!!' readStream nextChunkText!

----- Method: HelpOnHelp class>>pages (in category 'accessing') -----
pages
^#(introduction HelpHowToHelpTopics HelpAPIDocumentation)!

----- Method: HelpOnHelp class>>priority (in category 'accessing') -----
priority

^ 9999 "at the bottom"!

Object subclass: #HelpBuilder
instanceVariableNames: 'topicToBuild rootToBuildFrom'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Builders'!

!HelpBuilder commentStamp: 'tbn 2/12/2010 14:54' prior: 0!
This is an utility class that builds the books for a help system.

Instance Variables
rootTopics: <OrderedCollection>

rootTopics
- a collection of books
!

HelpBuilder subclass: #ClassAPIHelpBuilder
instanceVariableNames: 'addSubclasses addMethods subclassesAsSeparateTopic'
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Builders'!

!ClassAPIHelpBuilder commentStamp: 'tbn 4/30/2010 15:37' prior: 0!
A builder to build the API Help for a class

Instance Variables
addMethods: <Boolean>
addSubclasses: <Boolean>
subclassesAsSeparateTopic: <Boolean>

addMethods
- When true the builder will include method help

addSubclasses
- When true the builder will recursively go through and add subclasses

subclassesAsSeparateTopic
- xxxxx
!

----- Method: ClassAPIHelpBuilder class>>buildHierarchicalHelpTopicFrom:withSubclasses:withMethods: (in category 'building') -----
buildHierarchicalHelpTopicFrom: aClass withSubclasses: aBoolean withMethods: anotherBoolean
"Start building from the given class"

^(self new)
addSubclasses: aBoolean;
addMethods: anotherBoolean;
rootToBuildFrom: aClass;
build;
topicToBuild !

----- Method: ClassAPIHelpBuilder>>addMethods (in category 'accessing') -----
addMethods
^ addMethods!

----- Method: ClassAPIHelpBuilder>>addMethods: (in category 'accessing') -----
addMethods: anObject
addMethods := anObject!

----- Method: ClassAPIHelpBuilder>>addSubclasses (in category 'accessing') -----
addSubclasses
^ addSubclasses!

----- Method: ClassAPIHelpBuilder>>addSubclasses: (in category 'accessing') -----
addSubclasses: anObject
addSubclasses := anObject!

----- Method: ClassAPIHelpBuilder>>build (in category 'building') -----
build

CurrentReadOnlySourceFiles cacheDuring: [
topicToBuild := (HelpTopic named: rootToBuildFrom name).
topicToBuild icon: (HelpIcons iconNamed: #pageIcon).
topicToBuild contents: rootToBuildFrom comment.

addMethods ifTrue: [ self buildSubnodesForMethods ].
addSubclasses ifTrue: [ self buildSubnodesForSubclasses ] ].
!

----- Method: ClassAPIHelpBuilder>>buildMethodTopicsOn:for: (in category 'private building') -----
buildMethodTopicsOn: topic for: aClass

topic contents: (String streamContents: [ :stream |
aClass selectors sort do: [ :selector |
stream
nextPutAll: aClass name;
nextPutAll: '>>';
nextPutAll: selector asString;
cr;
nextPutAll: (
(aClass commentsAt: selector)
at: 1
ifAbsent: [ 'Method has no comment.' ]);
cr; cr ] ])!

----- Method: ClassAPIHelpBuilder>>buildSubclassTopicFor: (in category 'private building') -----
buildSubclassTopicFor: aSubclass

^(self class new)
rootToBuildFrom: aSubclass;
addSubclasses: addSubclasses;
addMethods: addMethods;
subclassesAsSeparateTopic: subclassesAsSeparateTopic;
build;
topicToBuild
!

----- Method: ClassAPIHelpBuilder>>buildSubnodesForMethods (in category 'private building') -----
buildSubnodesForMethods

| instanceSide classSide |
instanceSide := HelpTopic named: 'Instance side'.
classSide := HelpTopic named: 'Class side'.
topicToBuild icon: (HelpIcons iconNamed: #bookIcon).
topicToBuild
addSubtopic: instanceSide;
addSubtopic: classSide.
self buildMethodTopicsOn: instanceSide for: rootToBuildFrom.
self buildMethodTopicsOn: classSide for: rootToBuildFrom class. !

----- Method: ClassAPIHelpBuilder>>buildSubnodesForSubclasses (in category 'private building') -----
buildSubnodesForSubclasses

| topic |
rootToBuildFrom subclasses isEmpty ifTrue: [^self].
topicToBuild icon: (HelpIcons iconNamed: #bookIcon).
topic := subclassesAsSeparateTopic
ifTrue: [topicToBuild addSubtopic: (HelpTopic named: 'Subclasses')]
ifFalse: [topicToBuild ].
rootToBuildFrom subclasses
do: [:subclass | topic addSubtopic: (self buildSubclassTopicFor: subclass)].
topic sortSubtopicsByTitle.

!

----- Method: ClassAPIHelpBuilder>>initialize (in category 'initialize-release') -----
initialize
"Initializes the receiver"

super initialize.
addSubclasses := false.
addMethods := true.
subclassesAsSeparateTopic := true.!

----- Method: ClassAPIHelpBuilder>>subclassesAsSeparateTopic (in category 'accessing') -----
subclassesAsSeparateTopic
^ subclassesAsSeparateTopic!

----- Method: ClassAPIHelpBuilder>>subclassesAsSeparateTopic: (in category 'accessing') -----
subclassesAsSeparateTopic: anObject
subclassesAsSeparateTopic := anObject!

HelpBuilder subclass: #CustomHelpHelpBuilder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Builders'!

!CustomHelpHelpBuilder commentStamp: 'tbn 3/29/2010 13:30' prior: 0!
This builder builds help topics from a help topic description (which is typically stored
in a class).

The help topic description object has to understand the following messages:

#bookName - should return the name of the help book
#icon - should return the icon of the help book
#key - should return a unique key to identify the book
#pages - should return an array of method selectors to call to get the books pages
!

----- Method: CustomHelpHelpBuilder>>build (in category 'building') -----
build
"Start building a help topic from a code description"

topicToBuild := self createTopicFrom: rootToBuildFrom
!

----- Method: CustomHelpHelpBuilder>>createTopicFrom: (in category 'private') -----
createTopicFrom: aDescription
"Create a topic from a description stored on a class.
aDescription can specify (via #pages) the name of a class and not
only a selector. This allows for hierarchies with 'subtrees in the middle'"

|topic page pageClasses |
topic := HelpTopic named: aDescription bookName.
topic key: aDescription key.
topic icon: aDescription icon.
pageClasses := Set new.
aDescription pages do: [:pageSelectorOrClass|
page:= (Smalltalk hasClassNamed: pageSelectorOrClass asString)
ifFalse: [aDescription perform: pageSelectorOrClass]
ifTrue: [pageClasses add: (Smalltalk classNamed: pageSelectorOrClass asString).
(Smalltalk classNamed: pageSelectorOrClass asString) asHelpTopic].
topic addSubtopic: page.
].
((aDescription subclasses asSet)
removeAllFoundIn: pageClasses;
yourself) do: [:subclass | topic subtopics add: subclass asHelpTopic ].
^topic!

----- Method: HelpBuilder class>>buildHelpTopicFrom: (in category 'building') -----
buildHelpTopicFrom: aHelpTopicDescription
"Start building from the given help topic description"

^(self new)
rootToBuildFrom: aHelpTopicDescription;
build;
topicToBuild !

----- Method: HelpBuilder>>build (in category 'building') -----
build
self subclassResponsibility
!

----- Method: HelpBuilder>>initialize (in category 'initialize-release') -----
initialize
"Initializes the receiver"

super initialize.
topicToBuild := self topicClass new.
!

----- Method: HelpBuilder>>rootToBuildFrom: (in category 'accessing') -----
rootToBuildFrom: anObject
rootToBuildFrom := anObject!

----- Method: HelpBuilder>>topicClass (in category 'private accessing') -----
topicClass
^HelpTopic!

----- Method: HelpBuilder>>topicToBuild (in category 'accessing') -----
topicToBuild
^topicToBuild!

HelpBuilder subclass: #PackageAPIHelpBuilder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Builders'!

----- Method: PackageAPIHelpBuilder>>build (in category 'building') -----
build
|pTopic|
topicToBuild := (HelpTopic named: rootToBuildFrom bookName).
rootToBuildFrom packages do: [:package|
pTopic := HelpTopic named: package.
topicToBuild addSubtopic: pTopic.
self buildPackageTopic: pTopic.

]
!

----- Method: PackageAPIHelpBuilder>>buildPackageTopic: (in category 'building') -----
buildPackageTopic: pTopic

| classTopic classes |
classes := (PackageInfo named: pTopic title) classes asSortedCollection: [:cl1 :cl2 | cl1 name < cl2 name].
classes
do: [:aClass|
classTopic := ClassAPIHelpBuilder buildHierarchicalHelpTopicFrom: aClass withSubclasses: false withMethods: true.
pTopic addSubtopic: classTopic
]

!

Object subclass: #HelpIcons
instanceVariableNames: ''
classVariableNames: 'Icons'
poolDictionaries: ''
category: 'HelpSystem-Core-UI'!

!HelpIcons commentStamp: 'tbn 3/8/2010 09:29' prior: 0!
This class is used to store help icons for the help browser.

Typically one implements a method returning a 12x12 Form instance which
should not be called directly.

Since the class provides an internal icon cache (so the icons can be reused without
creating too many new instances) the icons should be accessed using the #iconNamed:
message with the method selector as argument.

To create a form from an icon file stored on disk you can use the following code:

| image stream |
image := ColorForm fromFileNamed: '/path/to/icon.png'.
stream := WriteStream with: String new.
image storeOn: stream.
stream contents inspect.!

----- Method: HelpIcons class>>blankIcon (in category 'private icons') -----
blankIcon
^Form extent: 12 @ 1 depth:8!

----- Method: HelpIcons class>>bookIcon (in category 'private icons') -----
bookIcon
^(Form
extent: 12@12
depth: 32
fromArray: #( 0 0 0 0 0 284817913 552924404 0 0 0 0 0 0 0 0 0 817149108 3747766882 4287730065 2679749049 549766340 0 0 0 0 0 0 1086110908 4016202338 4287137928 4288914339 4288914339 4289111718 3216290996 1086505666 0 0 0 816754350 4014952271 4287137928 4289309097 4289769648 4289111718 4288453788 4288453788 4288453788 2947658161 0 814846353 4283782485 4287072135 4288059030 4288059030 4288387995 4289243304 4289309097 4287927444 4287598479 2411050421 1081900156 4283585106 4286611584 4287532686 4287532686 4287466893 4287466893 4287401100 4287401100 4287401100 4288716960 2946868645 3211290728 4288651167 4287269514 4287006342 4287006342 4287006342 4286940549 4286940549 4287203721 4289177511 3483213213 281725642 2677183122 4293190884 4292861919 4289177511 4286874756 4286611584 4286611584 4287006342 4289638062 4020084125 549042617 0 282054607 2677643673 4289572269 4293256677 4292796126 4288980132 4287137928 4290164406 4020215711 816754350 0 0 0 0 551082200 2677643673 4289572269 4293256677 4292401368 4289177511 1085584564 0 0 0 0 0 0 0 551213786 2677643673 4288651167 1623244992 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
offset: 0@0)!

----- Method: HelpIcons class>>iconNamed: (in category 'accessing') -----
iconNamed: aSymbol

^self icons at: aSymbol ifAbsentPut: [self perform: aSymbol]!

----- Method: HelpIcons class>>icons (in category 'accessing') -----
icons
Icons isNil ifTrue: [Icons := Dictionary new].
^Icons!

----- Method: HelpIcons class>>packageIcon (in category 'private icons') -----
packageIcon
^(Form
extent: 12@12
depth: 32
fromArray: #( 0 0 0 0 1075649821 3744937783 3208395836 807016986 0 0 0 0 0 0 537857807 2939368243 4283256141 4284045657 4284572001 4284111450 2671524924 269488144 0 0 0 2150575919 4014820685 4284111450 4284374622 4284769380 4285098345 4285295724 4286216826 4017057647 1883456323 0 1076505130 4283848278 4284769380 4284966759 4285624689 4285690482 4285887861 4286611584 4287269514 4287861651 4287269514 1074597133 1076965681 4283914071 4283848278 4285953654 4286216826 4286414205 4286940549 4287466893 4287335307 4286808963 4286743170 1074399754 1077163060 4284637794 4284045657 4284835173 4285887861 4287269514 4287335307 4286282619 4286216826 4286874756 4287006342 1074465547 1077294646 4284835173 4284703587 4285361517 4285624689 4286414205 4285624689 4286085240 4286677377 4287269514 4287401100 1074465547 1077426232 4285098345 4285032552 4286019447 4285822068 4286743170 4286348412 4286677377 4287203721 4287730065 4287795858 1074531340 1077492025 4285229931 4285427310 4286808963 4286216826 4287137928 4287072135 4287401100 4287795858 4288256409 4288190616 1074531340 269356558 2672051268 4285493103 4287598479 4286940549 4287532686 4287795858 4287993237 4288387995 4287006342 2404668500 268501249 0 0 1075912993 3479726184 4287598479 4287927444 4288453788 4287993237 2943118444 539371046 0 0 0 0 0 0 1615086660 4017781370 3749148535 1078347334 0 0 0 0)
offset: 0@0)!

----- Method: HelpIcons class>>pageIcon (in category 'private icons') -----
pageIcon
^(Form
extent: 12@12
depth: 32
fromArray: #( 0 221196079 1366981242 1366915449 1366915449 1366849656 1366783863 1128876361 33554432 0 0 0 0 726552142 4294309365 4294243572 4294111986 4294046193 4293914607 4292861919 2843705215 319885585 0 0 0 726551886 4294177779 4294111986 4293980400 4293914607 4293848814 4293717228 4292138196 3734147730 269619730 0 0 726486349 4294046193 4293980400 4293914607 4293783021 4293717228 4293585642 4293454056 4291085508 639705377 0 0 726420557 4293980400 4293848814 4293783021 4293651435 4293585642 4293519849 4293388263 4292993505 640034342 0 0 726420556 4293848814 4293717228 4293651435 4293585642 4293454056 4293388263 4293256677 4293190884 623322919 0 0 726354764 4293717228 4293651435 4293519849 4293454056 4293322470 4293256677 4293125091 4293059298 623257126 0 0 726354507 4293585642 4293519849 4293388263 4293322470 4293190884 4293125091 4293059298 4292993505 623191333 0 0 726288970 4293454056 4293388263 4293256677 4293190884 4293125091 4292993505 4292993505 4292993505 623191333 0 0 726223178 4293322470 4293256677 4293190884 4293059298 4292993505 4292993505 4292993505 4292993505 623191333 0 0 726223177 4293256677 4293125091 4293059298 4292993505 4292993505 4292993505 4292993505 4292993505 623191333 0 0 490092087 3080033685 3079967892 3079967892 3079967892 3079967892 3079967892 3079967892 3079967892 454629657 0)
offset: 0@0)!

----- Method: HelpIcons class>>refreshIcon (in category 'private icons') -----
refreshIcon
^(Form
extent: 16@16
depth: 32
fromArray: #( 0 0 0 0 0 0 0 895969127 526080859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1884706390 4168710521 2288675434 271330348 0 0 0 0 0 0 0 0 0 828465505 2609087363 3615917702 4269439610 4285887861 4285624689 3899156584 1766607948 67569415 0 0 0 0 0 50529027 2306242166 4237069452 4286940549 4286611584 4286282619 4285887861 4285558896 4285229931 4268189543 2235514687 0 0 0 0 0 2590862701 4287598479 4287269514 4270097540 3329652342 3312217196 4285887861 4285558896 3345179491 1011567435 0 0 0 0 0 1263423054 4287532686 4287532686 3867378563 1096835168 0 1885166941 3681579120 1549227863 50923785 0 0 0 0 0 0 3061545851 4287795858 4236937866 811951461 0 0 641547581 137441585 0 0 0 0 0 0 0 34936085 4102720138 4287795858 3011016824 0 0 0 0 0 0 0 0 0 0 0 0 272317243 4287861651 4287795858 2489607268 0 0 0 0 0 0 0 0 68095759 0 0 0 204682035 4287730065 4287795858 2658432116 0 0 0 0 0 0 0 34014983 3965146967 4283979864 3125694030 0 0 3767044232 4287795858 3884287365 137244206 0 0 0 0 0 0 1129863256 4284769380 4284506208 2739423304 0 0 2189459584 4287795858 4287532686 2541123190 16843009 0 0 0 0 305805882 3597166696 4284703587 4250885983 910114623 0 0 273698896 3834218889 4287532686 4287335307 3094442353 1094532413 101255433 286199567 1582124365 3731318631 4284966759 4284703587 2689946965 0 0 0 0 879126118 3985082247 4287269514 4286940549 4286611584 4285624689 4285558896 4285624689 4285229931 4284966759 3227212635 220998700 0 0 0 0 0 509698401 2977659771 4286743170 4286545791 4286282619 4285887861 4285558896 4100417383 2170116441 103295016 0 0 0 0 0 0 0 0 575820370 1734895720 2121298032 2037017194 1448564567 255013683 0 0 0 0 0)
offset: 0@0)!

Object subclass: #SystemReference
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HelpSystem-Core-Utilities'!

!SystemReference commentStamp: 'tbn 4/30/2010 15:35' prior: 0!
This class defines the full reference help for the system.
(contents for the full API Help).

Just run "HelpBrowser openOn: SystemReference".

!

----- Method: SystemReference class>>all (in category 'help topic creation') -----
all
"HelpBrowser openOn: self all "

^(ClassAPIHelpTopic new)
theClass: ProtoObject;
withSubclasses: true;
withMethods: true;
subclassesAsSeparateTopic: false!

----- Method: SystemReference class>>asHelpTopic (in category 'help topic creation') -----
asHelpTopic
"HelpBrowser openOn: SystemReference"

^self hierarchyFor: ProtoObject

!

----- Method: SystemReference class>>forClass: (in category 'help topic creation') -----
forClass: aClass
|root topic |
root := HelpTopic named: 'System reference for ', aClass name.
topic := ClassAPIHelpTopic new theClass: aClass; withSubclasses: true; withMethods: true;
subclassesAsSeparateTopic: false.
root addSubtopic: topic.
^root!

----- Method: SystemReference class>>hierarchyFor: (in category 'help topic creation') -----
hierarchyFor: aClass

| root topic |
root := HelpTopic named: 'System reference for ', aClass name.
topic := (ClassAPIHelpTopic new)
theClass: aClass;
withSubclasses: true;
withMethods: false;
subclassesAsSeparateTopic: false.
root addSubtopic: topic.
^ root!

----- Method: SystemReference class>>hierarchyWithMethodsFor: (in category 'help topic creation') -----
hierarchyWithMethodsFor: aClass

| root topic |
root := HelpTopic named: 'System reference for ', aClass name.
topic := (ClassAPIHelpTopic new)
theClass: aClass;
withSubclasses: true;
withMethods: true;
subclassesAsSeparateTopic: true.
root addSubtopic: topic.
^ root!

----- Method: Class>>asHelpTopic (in category '*HelpSystem-Core') -----
asHelpTopic
^SystemReference forClass: self!