[Pkg] The Trunk: HelpSystem-Core-mt.78.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Jun 4 08:00:47 UTC 2015
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 at 0 corner: 1 at 0)
offsets: (0 at 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 at 0 corner: 0.3 at 1)
offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0 at 0)).
windowSpec children add: treeSpec.
textSpec := builder pluggableTextSpec new.
textSpec
model: self;
getText: #topicContents;
setText: #accept:;
menu: #codePaneMenu:shifted:;
frame: (LayoutFrame
fractions: (0.3 at 0.0 corner: 1 at 1)
offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0 at 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].!
More information about the Packages
mailing list