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

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