[squeak-dev] The Trunk: HelpSystem-Core-ct.122.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 18 15:47:01 UTC 2020


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

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

Name: HelpSystem-Core-ct.122
Author: ct
Time: 3 October 2019, 2:20:52.152682 am
UUID: 71c0495c-bf43-b440-aa1b-1cf195eb6a54
Ancestors: HelpSystem-Core-mt.116

Refines accepting text in HelpBrowser

- Revise use of #clearUserEdits and isUpdating
- Use the right #accept: return pattern (Boolean or False)
- Catch an edge case when you try to write something into a nested ClassBasedHelpTopic
- Mark saved methods with a #generated pragma; ask user before overwriting non-auto-generated methods to avoid discarding manual code (such as in SqueakToolsDebuggerHelp>>#usingTheDebugger)

Depends on Tools-ct.894.

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

Item was changed:
  ----- Method: AbstractHelpTopic>>accept:for: (in category 'editing') -----
  accept: newContents for: subtopic
+ 	"If this topic is editable, this will be the callback to update its contents."
+ 	^ false!
- 	"If this topic is editable, this will be the callback to update its contents."!

Item was changed:
  ----- Method: ClassBasedHelpTopic>>accept:for: (in category 'editing') -----
  accept: newContents for: subtopic
  	"Supports indirect content storage in classes other than helpClass."
  	
  	| topicClass topicMethodSelector code indirect |
+ 	(subtopic respondsTo: #contentsAsIs)
+ 		ifFalse: [^ self inform: 'Cannot store into this topic' translated].
+ 	
  	(indirect := subtopic contentsAsIs isMessageSend)
  		ifFalse: [
  			topicClass := self helpClass.
  			topicMethodSelector := subtopic key asLegalSelector asSymbol]
  		ifTrue: [
  			topicClass := subtopic contentsAsIs receiver.
  			topicMethodSelector := subtopic contentsAsIs selector].
  		
+ 	(topicClass class includesSelector: topicMethodSelector) ==> [self okToWriteSelector: topicMethodSelector]
+ 		ifFalse: [^ false].
+ 	
  	code := String streamContents:[:s|
  		s nextPutAll: topicMethodSelector.
  		s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'.
  		s crtab; nextPutAll: '"', self helpClass name,' edit: ', subtopic key storeString,'"'.
  		
  		indirect ifTrue: [s crtab; nextPutAll: '^ ('] ifFalse: [
+ 			s crtab; nextPutAll: '<generated>'.
  			s crtab; nextPutAll: '^(HelpTopic'.
  			s crtab: 2; nextPutAll: 'title: ', subtopic title storeString.
  			s crtab: 2; nextPutAll: 'contents: '].
  		
  		s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: newContents]) storeString.
  		s nextPutAll:' readStream nextChunkText)'.
  		
  		indirect ifFalse: [
  			subtopic key ifNotNil: [s crtab: 3; nextPutAll: 'key: ', subtopic key storeString; nextPutAll: ';'].
  			subtopic shouldStyle ifNotNil: [s crtab: 3; nextPutAll: 'shouldStyle: ', subtopic shouldStyle storeString; nextPutAll: ';'].
  			s crtab: 3; nextPutAll: 'yourself']
  	].
  
  	topicClass class
  		compile: code
+ 		classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']).
+ 	^ true!
- 		classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']).!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>okToWriteSelector: (in category 'editing') -----
+ okToWriteSelector: aSelector
+ 
+ 	| method |
+ 	method := self helpClass theMetaClass compiledMethodAt: aSelector ifAbsent: [^ true].
+ 	(method hasPragma: #generated) ifTrue: [^ true].
+ 	^ (UIManager default
+ 		chooseFrom: (#('Override it' 'Don''t override, but browse it' 'Cancel') collect: #translated)
+ 		values: { [true]. [method browse. false]. [false] }
+ 		title: ('This will override the existing method\{1}!!\Proceed anyway?' withCRs translated asText
+ 			format: {method reference asText
+ 				addAttribute: (TextLink new classAndMethod: method reference);
+ 				yourself })) value!

Item was changed:
  ----- Method: DirectoryBasedHelpTopic>>accept:for: (in category 'editing') -----
  accept: newContents for: subtopic
  
  	FileStream forceNewFileNamed: subtopic fileEntry fullName do: [:strm |
  		strm nextChunkPutWithStyle: newContents].
+ 	^ true
  	
  	!

Item was changed:
  ----- Method: FileBasedHelpTopic>>accept:for: (in category 'editing') -----
  accept: newContents for: subtopic
  
  	FileStream forceNewFileNamed: self fileEntry fullName do: [:strm |
  		strm nextChunkPutWithStyle: newContents].
+ 	^ true
- 	
  	!

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])
  		or: [self currentTopic isEditable not])
+ 			ifTrue: [^ self inform: 'This help topic cannot be edited.' translated].
- 			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) == true
+ 		ifFalse: [^ false].
+ 	self changed: #clearUserEdits.
- 	isUpdating := true.
- 
- 	parent accept: normalizedText for: self currentTopic.
  	parent refresh.
+ 	parent == self rootTopic ifTrue: [self rootTopic: parent]]
+ 		ensure: [isUpdating := false].
- 	parent == self rootTopic ifTrue: [self rootTopic: parent].
  	
+ 	self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).
+ 	^ true!
- 	isUpdating := false.
- 	
- 	self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).!



More information about the Squeak-dev mailing list