[squeak-dev] The Trunk: HelpSystem-Core-mt.133.mczcommits at source.squeak.org commits at source.squeak.orgFri Dec 18 15:45:21 UTC 2020
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 at 0 corner: 0.3 at 1) offsets: (0@ (Preferences standardDefaultTextFont height * 2) corner: 0 at 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!
More information about the Squeak-dev mailing list |