Marcel Taeumel uploaded a new version of HelpSystem-Core to project The Trunk: http://source.squeak.org/trunk/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.
=============== Diff against HelpSystem-Core-kfr.77 ===============
Item was added: + ----- Method: AbstractHelpTopic>>isEditable (in category 'testing') ----- + isEditable + + ^ false!
Item was added: + ----- Method: AbstractHelpTopic>>refresh (in category 'updating') ----- + refresh + "Do nothing."!
Item was added: + ----- Method: ClassBasedHelpTopic>>isEditable (in category 'testing') ----- + isEditable + ^ true!
Item was added: + ----- Method: ClassBasedHelpTopic>>refresh (in category 'updating') ----- + refresh + + self updateSubtopics. + self changed: #subtopicsUpdated.!
Item was changed: ----- 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] - ifFalse: [(self helpClass perform: pageSelectorOrClass) priority: priority - pages size; yourself] ifTrue: [pageSelectorOrClass asHelpTopic]]!
Item was changed: Model subclass: #HelpBrowser + instanceVariableNames: 'rootTopic currentTopic currentParentTopic result searchTopic topicPath toplevelTopics oldTopic' - instanceVariableNames: 'rootTopic currentTopic 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
!
Item was changed: ----- 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 topicClass topicMethod updatedTopic | - (self find: (self currentTopic contents copyFrom: 1 to: 20)) asArray - ifNotEmpty: [:refs | - topicClass := refs first actualClass theNonMetaClass. - topicMethod := refs first selector]. - topicClass = nil ifTrue:[^self inform: 'This help topic can not be edited here']. 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]).! - updatedTopic := topicClass perform: topicMethod. - oldTopic := currentTopic. - "self inTopic: self rootTopic replaceCurrentTopicWith: updatedTopic". - self toplevelTopics do:[ :each | self inTopic: each replaceCurrentTopicWith: updatedTopic]. - self changed: #toplevelTopics.. - self changed: #currentTopic. - self changed: #topicContents. - !
Item was changed: ----- 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!
Item was added: + ----- Method: HelpBrowser>>currentParentTopic (in category 'accessing') ----- + currentParentTopic + + ^ currentParentTopic!
Item was added: + ----- Method: HelpBrowser>>currentParentTopic: (in category 'accessing') ----- + currentParentTopic: aHelpTopic + + currentParentTopic := aHelpTopic.!
Item was added: + ----- Method: HelpTopic>>key (in category 'accessing') ----- + key + + ^ key!
Item was added: + ----- Method: HelpTopic>>key: (in category 'accessing') ----- + key: aSymbol + + key := aSymbol.!
Item was changed: PluggableListItemWrapper subclass: #HelpTopicListItemWrapper + instanceVariableNames: 'parent' - instanceVariableNames: '' 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 !
Item was added: + ----- 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 + !
Item was changed: ----- Method: HelpTopicListItemWrapper>>contents (in category 'accessing') ----- contents ^self item subtopics sorted collect: [ :each | + HelpTopicListItemWrapper with: each model: self model parent: self] - HelpTopicListItemWrapper with: each model: self model] !
Item was added: + ----- Method: HelpTopicListItemWrapper>>parent (in category 'accessing') ----- + parent + + ^ parent!
Item was added: + ----- Method: HelpTopicListItemWrapper>>parent: (in category 'accessing') ----- + parent: aWrapper + + parent := aWrapper.!
Item was added: + ----- Method: HelpTopicListItemWrapper>>setItem:model:parent: (in category 'initialization') ----- + setItem: anObject model: aModel parent: itemParent + + self parent: itemParent. + self setItem: anObject model: aModel.!
Item was added: + ----- 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].!
packages@lists.squeakfoundation.org