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

Marcel Taeumel uploaded a new version of HelpSystem-Core to project The Trunk:
http://source.squeak.org/trunk/HelpSystem-Core-mt.98.mcz

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

Name: HelpSystem-Core-mt.98
Author: mt
Time: 22 August 2016, 9:56:00.217917 am
UUID: 16424c54-dde0-5749-80ec-3ffbdadc87b4
Ancestors: HelpSystem-Core-mt.97

Fixes a bug with line endings and search topics in help browser. Fixes another bug with selection reset when editing a help topic. Provide result selection when navigating from search results to the actual search topic. Continue the search then with [CMD]+[G] (i.e. "find again").

=============== Diff against HelpSystem-Core-mt.97 ===============

Item was changed:
  Model subclass: #HelpBrowser
+ instanceVariableNames: 'rootTopic currentTopic currentParentTopic result searchTopic topicPath toplevelTopics oldTopic topicContentsSelection isUpdating'
- 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
 
  !

Item was changed:
  ----- Method: HelpBrowser>>accept: (in category 'actions') -----
  accept: text
  "Accept edited text. Compile it into a HelpTopic"
 
  | parent currentKey normalizedText colorsToRemove |
  (self currentParentTopic isNil or: [self currentParentTopic isEditable not])
  ifTrue: [^ self inform: 'This help topic cannot be edited.'].
 
  self changed: #clearUserEdits.
 
  "Remove default colors for the sake of UI themes."
  normalizedText := text.
  colorsToRemove := {Color black. Color white}.
  normalizedText runs: (normalizedText runs collect: [:attributes | attributes reject: [:attribute |
  (((attribute respondsTo: #color) and: [colorsToRemove includes: attribute color])
  or: [attribute respondsTo: #font])]]).
 
  parent := self currentParentTopic.
  currentKey := self currentTopic key.
 
+ isUpdating := true.
+
  parent accept: normalizedText for: self currentTopic.
-
  parent refresh.
  parent == self rootTopic ifTrue: [self rootTopic: parent].
 
+ isUpdating := false.
+
  self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).!

Item was changed:
  ----- Method: HelpBrowser>>buildContentsWith: (in category 'toolbuilder') -----
  buildContentsWith: builder
 
  ^ builder pluggableTextSpec new
  model: self;
  getText: #topicContents;
  setText: #accept:;
+ selection: #topicContentsSelection;
  menu: #codePaneMenu:shifted:;
  frame: (LayoutFrame
  fractions: (0.3@0.0 corner: 1@1)
  offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0@0));
  yourself!

Item was added:
+ ----- Method: HelpBrowser>>changed: (in category 'updating') -----
+ changed: aspect
+
+ (isUpdating == true and: [aspect == #topicContents]) ifTrue: [^ self].
+ super changed: aspect.!

Item was changed:
  ----- Method: HelpBrowser>>currentTopic: (in category 'accessing') -----
  currentTopic: aHelpTopic
 
  self okToChange ifFalse: [^ self].
  self currentTopic == aHelpTopic ifTrue: [^ self].
+
+ ((self currentTopic notNil
+ and: [aHelpTopic notNil])
+ and: [self currentTopic key ~= aHelpTopic key]) ifTrue: [
+ "Clear selection, we have new contents."
+ self topicContentsSelection: (1 to: 0)].
 
  currentTopic := aHelpTopic.
  topicPath := nil.
+ topicContentsSelection := nil.
 
  self changed: #currentTopic.
  self changed: #topicContents.
  self changed: #showContents.!

Item was added:
+ ----- Method: HelpBrowser>>topicContentsSelection (in category 'accessing - ui') -----
+ topicContentsSelection
+
+ ^ topicContentsSelection!

Item was added:
+ ----- Method: HelpBrowser>>topicContentsSelection: (in category 'accessing - ui') -----
+ topicContentsSelection: anInterval
+
+ topicContentsSelection := anInterval.
+ self changed: #topicContentsSelection.!

Item was changed:
  ----- 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].
+ aspect == #searchResultContentsSelected ifTrue: [
+ self topicContentsSelection: object].!
- self currentTopicPath: object].!

Item was changed:
  ----- 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: 6.
- 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])
- (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;
+ at: 6 put: (index to: index + term size - 1).
- 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]].!

Item was changed:
  ----- 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.
+ self changed: #searchResultContentsSelected with: entry sixth])).
- 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!