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

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

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

Name: HelpSystem-Core-mt.133
Author: mt
Time: 18 December 2020, 4:45:20.673078 pm
UUID: d4ffb843-a333-1e46-a58f-4aeed3e95f49
Ancestors: HelpSystem-Core-mt.121, HelpSystem-Core-ct.117, HelpSystem-Core-ct.118, HelpSystem-Core-ct.122, HelpSystem-Core-ct.132, HelpSystem-Core-ct.125, HelpSystem-Core-ct.126, HelpSystem-Core-ct.127

Merges various contributions from Christoph (ct) for Squeak's Help Browser:
- menu for tree to inspect/explore/browse help topics
- more robust help-topic authoring
- adds #bookBlurbKey to use an existing page as blurb
- adds <generated> pragma to denote generated pages for ClassBasedHelpTopic, which is important to not mess up formatting, which is stand off (i.e. that ]style[)

Also fixes the bug where the window title (path) gets lost after editing a topic.

Thanks Christoph! :-)

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

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 added:
+ ----- Method: AbstractHelpTopic>>browseTopicFromParent: (in category 'tools') -----
+ browseTopicFromParent: parentTopic
+
+ self canBrowseTopic
+ ifTrue: [^ self browseTopic].
+ parentTopic canBrowseSubtopic
+ ifTrue: [^ parentTopic browseSubtopic: self].
+ !

Item was added:
+ ----- Method: AbstractHelpTopic>>canBrowseSubtopic (in category 'testing') -----
+ canBrowseSubtopic
+
+ ^ false!

Item was added:
+ ----- Method: AbstractHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ false!

Item was added:
+ ----- Method: AbstractHelpTopic>>canBrowseTopicFromParent: (in category 'testing') -----
+ canBrowseTopicFromParent: parentTopic
+
+ ^ self canBrowseTopic or: [
+ parentTopic notNil and: [parentTopic canBrowseSubtopic]]!

Item was added:
+ ----- Method: AbstractHelpTopic>>subtopicAt: (in category 'accessing') -----
+ subtopicAt: key
+ "Answer the subtopic that has the given key or nil if no such topic can be found. Always answer nil for the 'nil' key because a topic's key 'nil' means 'unspecified'."
+
+ ^ key ifNotNil: [self subtopics detect: [:topic | topic key = key] ifNone: []]!

Item was added:
+ ----- Method: AbstractHelpTopic>>topicMenu:parentTopic: (in category 'menus') -----
+ topicMenu: aMenu parentTopic: parentTopic
+
+ (self canBrowseTopicFromParent: parentTopic)
+ ifTrue: [
+ aMenu
+ add: 'browse (b)' translated
+ target: self
+ selector: #browseTopicFromParent:
+ argumentList: {parentTopic};
+ addLine ].
+ aMenu
+ add: 'inspect (i)' translated target: self action: #inspect;
+ add: 'explore (I)' translated target: self action: #explore.
+
+ ^ aMenu!

Item was added:
+ ----- Method: AbstractHelpTopic>>topicMenuKey:fromParent: (in category 'menus') -----
+ topicMenuKey: aChar fromParent: parentTopic
+
+ aChar
+ caseOf: {
+ [$b] -> [(self canBrowseTopicFromParent: parentTopic)
+ ifTrue: [ self browseTopicFromParent: parentTopic ]].
+ [$i] -> [self inspect].
+ [$I] -> [self explore] }
+ otherwise: [^ false].
+ ^ true!

Item was added:
+ ----- Method: ClassAPIHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ self theClass theMetaClass browse!

Item was added:
+ ----- Method: ClassAPIHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was added:
+ ----- Method: ClassAPIHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self theClass name!

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>>browseSubtopic: (in category 'tools') -----
+ browseSubtopic: aTopic
+
+ ^ ToolSet browse: self helpClass theMetaClass selector: aTopic key!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ self helpClass theMetaClass browse!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>canBrowseSubtopic (in category 'testing') -----
+ canBrowseSubtopic
+
+ ^ true!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was changed:
  ----- Method: ClassBasedHelpTopic>>contents (in category 'accessing') -----
  contents
 
+ ^ self helpClass bookBlurb ifEmpty: [
+ (self subtopicAt: self helpClass bookBlurbKey)
+ ifNil: [''] ifNotNil: [:topic | topic contents]]!
- ^ helpClass bookBlurb!

Item was added:
+ ----- Method: ClassBasedHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self helpClass name!

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].
+ ^ (Project uiManager
+ 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 == true!

Item was changed:
  ----- Method: CustomHelp class>>bookBlurb (in category 'accessing') -----
  bookBlurb
+ "Returns a short summary of the custom help book. Overrides #bookBlurbKey"
- "Returns a short summary of the custom help book"
 
  ^ self organization classComment!

Item was added:
+ ----- Method: CustomHelp class>>bookBlurbKey (in category 'accessing') -----
+ bookBlurbKey
+ "Key of the page to show as contents if (1) #bookBlurb is empty and (2) no subtopic is selected in the help browser."
+ ^ nil!

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 added:
+ ----- Method: DirectoryBasedHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ FileList openOn: self directoryEntry asFileDirectory!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was added:
+ ----- Method: DirectoryBasedHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self directoryEntry fullName!

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 added:
+ ----- Method: FileBasedHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ FileList openOn: self fileEntry containingDirectory!

Item was added:
+ ----- Method: FileBasedHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was added:
+ ----- Method: HelpBrowser class>>on: (in category 'instance creation') -----
+ on: aHelpTopic
+
+ ^ self defaultHelpBrowser new
+ rootTopic: aHelpTopic;
+ yourself!

Item was changed:
  ----- Method: HelpBrowser class>>openOn: (in category 'instance creation') -----
  openOn: aHelpTopic
+ "Open the receiver on the given help topic or any other object that can be transformed into
+ a help topic by sending #asHelpTopic."
+
+ ^ (self on: aHelpTopic) open!
-         "Open the receiver on the given help topic or any other object that can be transformed into
-          a help topic by sending #asHelpTopic."
-        
-         ^(self defaultHelpBrowser new)
-                 rootTopic: aHelpTopic;
-                 open!

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 showTopicNamed: currentKey.
+ ^ true!
- isUpdating := false.
-
- self currentTopic: (parent subtopics detect: [:t | t key = currentKey]).!

Item was changed:
  ----- Method: HelpBrowser>>buildTreeWith: (in category 'toolbuilder') -----
  buildTreeWith: builder
 
  ^ builder pluggableTreeSpec new
  model: self;
  nodeClass: HelpTopicListItemWrapper;
  roots: #toplevelTopics;
+ menu: #treeMenu:;
+ keyPress: #treeKey:from:event:;
  getSelected: #currentTopic;
  setSelected: #currentTopic:;
  getSelectedPath: #currentTopicPath;
  setSelectedPath: #noteTopicPath:;
  setSelectedParent: #currentParentTopic:;
  autoDeselect: false;
  frame: (LayoutFrame
  fractions: (0@0 corner: 0.3@1)
  offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0@0));
  yourself!

Item was added:
+ ----- Method: HelpBrowser>>treeKey:from:event: (in category 'menus') -----
+ treeKey: aChar from: aView event: anEvent
+
+ anEvent anyModifierKeyPressed ifFalse: [^ false].
+ ^ (self currentTopic topicMenuKey: aChar fromParent: self currentParentTopic)!

Item was added:
+ ----- Method: HelpBrowser>>treeListMenu: (in category 'menus') -----
+ treeListMenu: aMenu
+ <treeListMenu>
+
+ ^ self currentTopic
+ ifNil: [aMenu]
+ ifNotNil: [:topic | topic
+ topicMenu: aMenu
+ parentTopic: self currentParentTopic]!

Item was added:
+ ----- Method: HelpBrowser>>treeMenu: (in category 'menus') -----
+ treeMenu: aMenu
+
+ ^ self menu: aMenu for: #(treeListMenu)!

Item was changed:
  ----- Method: HelpHowToHelpTopicsFromCode class>>step7 (in category 'pages') -----
  step7
+ <generated>
  "This method was automatically generated. Edit it using:"
  "HelpHowToHelpTopicsFromCode edit: #step7"
+ ^(HelpTopic
- ^HelpTopic
  title: 'Step 7 - Tips and Tricks'
+ contents:
+ 'STEP 7 - TIPS AND TRICKS
- contents:
- 'STEP 7 - TIPS AND TRICKS
 
  Tip1:
            If you implement the #pages method you can also
            use the name of a custom help class that should be
            integrated between the specific pages:
   
+ pages
+    ^#(firstPage MyAppTutorial secondPage)
-               #pages
-                    ^(firstPage MyAppTutorial secondPage)
 
  Tip2:
            You can easily edit the help contents of a page by
            using the #edit: message. For our example just evaluate:
 
  MyAppHelp edit: #firstPage
 
      This will open a workspace with the help contents and
      when you accept it it will be saved back to the help
      method defining the topic.  
 
 
+ !!' readStream nextChunkText)
+ key: #step7;
+ shouldStyle: false;
+ yourself!
- '
- !

Item was added:
+ ----- Method: MethodListHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ self theClass browse!

Item was added:
+ ----- Method: MethodListHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was added:
+ ----- Method: MethodListHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self theClass name!

Item was added:
+ ----- Method: PackageAPIHelpTopic>>browseTopic (in category 'tools') -----
+ browseTopic
+
+ ^ (PackageInfo named: packageName) browse!

Item was added:
+ ----- Method: PackageAPIHelpTopic>>canBrowseTopic (in category 'testing') -----
+ canBrowseTopic
+
+ ^ true!

Item was added:
+ ----- Method: PackageAPIHelpTopic>>key (in category 'accessing') -----
+ key
+
+ ^ self packageName!