[squeak-dev] The Trunk: HelpSystem-Core-mt.98.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Aug 22 07:56:06 UTC 2016


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 at 0.0 corner: 1 at 1)
  			offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0 at 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!



More information about the Squeak-dev mailing list