| package | package := Package name: 'CJDPresenterGenerator'. package paxVersion: 0; basicComment: 'By: Christopher J. Demers Copyright 2001 (Freeware) The code may be freely used and freely modified, but please don''t redistributed modified versions. Use this code at your own risk. see: http://www.mitchellscientific.com/smalltalk/ for much more information. This class is used to generate Presenter skeleton code. It will add instance variables for the sub-presenters. We preserve existing variables and will not create duplicates (even from super classes). It will also create or append to a createComponents method that will initialize the presenters. This will not create duplicate entrys (if the instance variables exist) but append new entries. You can add a context menu item to the class browser by evaluating: CJDPresenterGenTool addContextMenu. or remove it by evaluating: CJDPresenterGenTool removeContextMenu. This code will open a view and programmatically add the menu and then save the new view. It will make a backup view. This is an experimental concept, and is even more alpha than the rest of the code.'. package basicPackageVersion: '0.007'. "Add the package scripts" "Add the class names, loose method names, global names, resource names" package classNames add: #CJDMenuManager; add: #CJDPresenterGenTool; yourself. package methodNames add: #ClassHierarchyPresenter -> #generatePresenterSkeleton; yourself. package globalNames yourself. package resourceNames yourself. "Binary Global Names" package binaryGlobalNames: (Set new yourself). "Resource Names" package allResourceNames: (Set new yourself). "Add the prerequisite names" package setPrerequisites: (IdentitySet new add: 'Development System'; add: 'Dolphin'; yourself). package! "Class Definitions"! Object subclass: #CJDMenuManager instanceVariableNames: 'targetClass targetView targetViewName menusDict' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! Object subclass: #CJDPresenterGenTool instanceVariableNames: 'targetClass targetViewName targetView namedSubViews existingIVarNames' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! "Loose Methods"! !ClassHierarchyPresenter methodsFor! generatePresenterSkeleton "CJD 6-19-2001 Generate a Presenter Skeleton for the selected class." | class resources default | (class := self selection) isNil ifTrue: [^self]. CJDPresenterGenTool generateClass: class viewName: nil! ! !ClassHierarchyPresenter categoriesFor: #generatePresenterSkeleton!commands!private! ! "End of package definition"! CJDMenuManager comment: 'CJD This is NOT used by default, however it is used to support the optional adding of a context menu item for the Presenter Generator. This has to be initiated manually via: CJDPresenterGenTool addContextMenu. It can also remove the context menu item via CJDPresenterGenTool removeContextMenu. This code will open a view and programmatically add the menu and then save the new view. It will make a backup view. This is an experimental concept, and is even more alpha than the rest of the code. My intent here was to provide an easy way to add or remove menu commands in system view with out replacing the view, and with out replacing system methods. For now it only supports context menus, but I intend to eventually add support for menu bars as well. Please give me feedback regarding this approach.'! CJDMenuManager guid: (GUID fromString: '{5564DE91-64F1-11D5-80E4-006008C07585}')! !CJDMenuManager categoriesForClass!Unclassified! ! !CJDMenuManager methodsFor! addCommand: aCommand toContextMenuFor: aMenuOwnerName after: aMenuCommandName "CJD 6-19-2001 Add aCommand to aMenuOwnerName after aMenuCommandName." | menu predecessor | [menu := (targetView viewNamed: aMenuOwnerName) contextMenu. predecessor := menu find: aMenuCommandName] on: NotFoundError do: [:error | ^nil]. ^menu insertItem: aCommand after: predecessor command.! addCommand: aCommand toContextMenuFor: aMenuOwnerName before: aMenuCommandName "CJD 6-21-2001 Add aCommand to aMenuOwnerName before aMenuCommandName." | menu predecessor | [menu := (targetView viewNamed: aMenuOwnerName) contextMenu. predecessor := menu find: aMenuCommandName] on: NotFoundError do: [:error | ^nil]. ^menu insertItem: aCommand before: predecessor command.! findMenus "CJD 6-19-2001 Return all menus found in the view." | menus menu | menus := Dictionary new. ((targetView respondsTo: #menuBar) and: [(menu := targetView menuBar) notNil]) ifTrue: [menus at: 'mainMenu' put: menu]. targetView allSubViews do: [ :sv | ((sv respondsTo: #contextMenu) and: [(menu := sv contextMenu) notNil]) ifTrue: [menus at: sv name displayString put: menu]]. menusDict := menus.! menusDict "Answer the value of the receiver's ''menusDict'' instance variable." ^menusDict! openView "CJD 6-19-2001 Open the target view." targetView := (ResourceIdentifier class: targetClass name: self targetViewName) resource load.! removeCommand: aMenuCommandName fromContextMenuFor: aMenuOwnerName "CJD 6-22-2001 Remove aMenuCommandName from aMenuOwnerName." | menu command | [menu := (targetView viewNamed: aMenuOwnerName) contextMenu. command := menu find: aMenuCommandName] on: NotFoundError do: [:error | ^nil]. ^menu removeItem: command.! saveBackupView "CJD 6-27-2001 Save a backup of the current view." | resourceID resource | resourceID := (ResourceIdentifier class: targetClass name: self targetViewName , ' BackUp' ). resource := ViewResource defaultWritable. SessionManager current resourceManager at: resourceID put: resource. resourceID save: self targetView. "Log to the change log so the change can be restored if necessary" SourceManager default logChanged: resourceID. ! saveView "CJD 6-19-2001 Save the target view." (ResourceIdentifier class: targetClass name: self targetViewName) save: targetView.! targetClass "Private - Answer the value of the receiver's ''targetClass'' instance variable." ^targetClass! targetClass: anObject "Set the value of the receiver's ''targetClass'' instance variable to the argument, anObject." targetClass := anObject! targetView "Private - Answer the value of the receiver's ''targetView'' instance variable." ^targetView! targetViewName "Private - CJD Return the view name, if it is nil return the default view name for theClass." ^targetViewName isNil ifTrue: [self targetClass defaultView] ifFalse: [targetViewName]. ! targetViewName: anObject "Set the value of the receiver's ''targetViewName'' instance variable to the argument, anObject." targetViewName := anObject! ! !CJDMenuManager categoriesFor: #addCommand:toContextMenuFor:after:!*-unclassified!public! ! !CJDMenuManager categoriesFor: #addCommand:toContextMenuFor:before:!*-unclassified!public! ! !CJDMenuManager categoriesFor: #findMenus!*-unclassified!public! ! !CJDMenuManager categoriesFor: #menusDict!accessing!public! ! !CJDMenuManager categoriesFor: #openView!*-unclassified!public! ! !CJDMenuManager categoriesFor: #removeCommand:fromContextMenuFor:!*-unclassified!public! ! !CJDMenuManager categoriesFor: #saveBackupView!*-unclassified!public! ! !CJDMenuManager categoriesFor: #saveView!*-unclassified!public! ! !CJDMenuManager categoriesFor: #targetClass!accessing!private! ! !CJDMenuManager categoriesFor: #targetClass:!accessing!public! ! !CJDMenuManager categoriesFor: #targetView!accessing!private! ! !CJDMenuManager categoriesFor: #targetViewName!accessing!private! ! !CJDMenuManager categoriesFor: #targetViewName:!accessing!public! ! CJDPresenterGenTool comment: 'CJD 5-9-2001 This class is used to generate Presenter skeleton code. It will add instance variables for the sub-presenters. We preserve existing variables and will not create duplicates (even from super classes). It will also create or append to a createComponents method that will initialize the presenters. This will not create duplicate entrys (if the instance variables exist) but append new entries.'! CJDPresenterGenTool guid: (GUID fromString: '{64421FB4-7CBF-4F1C-B86B-C07B3C99FEEA}')! !CJDPresenterGenTool categoriesForClass!Unclassified! ! !CJDPresenterGenTool methodsFor! generateClassDef "CJD 5-8-2001 Generate the class definition, this will add instance variables for the presenters. We preserve existing variables and will not create duplicates (even from super classes)." | ivNames ivStr presenterNames | existingIVarNames := targetClass allInstVarNames. targetView := (ResourceIdentifier class: targetClass name: self targetViewName) resource load. namedSubViews := targetView subViews select: [:sv | sv name notNil]. namedSubViews := namedSubViews reject: [ :sv | (self viewClassesToIgnore includes: sv class name) or: [existingIVarNames includes: sv name , 'Presenter']]. presenterNames := namedSubViews collect: [:sv | sv name , 'Presenter']. ivNames := (targetClass instVarNames asOrderedCollection addAll: presenterNames; yourself ) asSet. ivStr := ''. ivNames do: [ :each | ivStr := ivStr , ' ' , each]. "targetClass superclass subclass: targetClass name instanceVariableNames: ivStr classVariableNames: targetClass classVariableString poolDictionaries: targetClass sharedVariableString classInstanceVariableNames: targetClass class instanceVariableString." Compiler evaluate: (targetClass name , ' superclass subclass: ' , targetClass name printString , ' instanceVariableNames: ' , ivStr printString , ' classVariableNames: ' , targetClass classVariableString printString , ' poolDictionaries: ' , targetClass sharedVariableString printString , ' classInstanceVariableNames: ' , targetClass class instanceVariableString printString). ! generateCreateComponents "CJD 5-8-2001 Create or append to a createComponents method that will create the presenters. This will not create duplicate entrys but add new entries." | str presenterNames presenterMap cr tab | cr := (Character value: 13) asString , (Character value: 10) asString. tab := (Character value: 9) asString. str := [(targetClass sourceCodeAt: #createComponents) trimBlanks] on: Error do: [:error | error return: 'createComponents " (AutoGenerated) Create the presenters contained by the receiver." super createComponents.']. (self hasTrailingStatementSeperator: str) ifFalse: [str := str , '.']. str := str, cr , tab , '"(AutoGenerated on ' , TimeStamp current displayString , ')"' , cr. presenterMap := self presenterTypeMap. namedSubViews do: [:sv | (existingIVarNames includes: sv name , 'Presenter') ifFalse: [str := str , tab , sv name , 'Presenter := self add: ' , (presenterMap at: sv class ifAbsent: [Presenter]) printString , ' new name: ' , sv name printString , '.' , cr]]. targetClass compile: str.! hasTrailingStatementSeperator: aMethodCodeString "CJD 7-2-2001 Check aString to see if it has a trailing statement seperator. This may be overkill, I had been using a much simpler approach to check this, but I suppose I should do this more robust check for the sake of completeness. Returns true if aMethodCodeString ends with a statement seperator (.) or false if it does not." | inComment inString lastSeperator lastStatement | "Find the last statement seperator." inString := inComment := false. lastSeperator := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch = $. & (inString | inComment) not]. "Now see if there is another statement after it." inString := inComment := false. lastStatement := aMethodCodeString findLast: [:ch | ch = $" ifTrue: [inComment := inComment not]. ch = $' ifTrue: [inString := inString not]. ch isAlphaNumeric & (inString | inComment) not]. ^lastSeperator - lastStatement > 0.! presenterTypeMap "CJD 5-8-2001 These are how we determin which presenter to default to for a given view. The view class is the key, and the presenter class is the value. If a default mapping is not provided here it will map to Presenter as a way of indicating that a manual change needs to be made." | dict | dict := Dictionary new. dict at: TextEdit put: TextPresenter. dict at: StaticText put: TextPresenter. dict at: ComboBox put: ChoicePresenter. dict at: CheckBox put: BooleanPresenter. dict at: RadioButton put: BooleanPresenter. dict at: RichTextEdit put: RichTextPresenter. "A method called presenterTypeMapCustom can be added to self to support custom view - presenter maps." (self respondsTo: #presenterTypeMapCustom) ifTrue: [dict addAll: (self presenterTypeMapCustom) associations]. ^dict. ! targetClass "CJD Return the targetClass." ^targetClass! targetClass: aClass "CJD Set the targetClass." targetClass := aClass.! targetViewName "Private - CJD Return the view name, if it is nil prompt for a view name from targetClass." | viewNames | ^targetViewName isNil ifTrue: [viewNames := (SmalltalkSystem current viewResourcesForClass: self targetClass) keys asSortedCollection. targetViewName := ChoicePrompter on: self targetClass defaultView asValue choices: viewNames caption: 'Choose a view'] ifFalse: [targetViewName].! targetViewName: aViewName "CJD Set the view to work on." targetViewName := aViewName! viewClassesToIgnore "CJD Return an Array of the view classes to ignore. These are views for which we do not need a presenter." ^#(PushButton).! ! !CJDPresenterGenTool categoriesFor: #generateClassDef!*-unclassified!public! ! !CJDPresenterGenTool categoriesFor: #generateCreateComponents!*-unclassified!public! ! !CJDPresenterGenTool categoriesFor: #hasTrailingStatementSeperator:!*-unclassified!public! ! !CJDPresenterGenTool categoriesFor: #presenterTypeMap!*-unclassified!public! ! !CJDPresenterGenTool categoriesFor: #targetClass!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetClass:!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetViewName!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetViewName:!accessing!public! ! !CJDPresenterGenTool categoriesFor: #viewClassesToIgnore!*-unclassified!public! ! !CJDPresenterGenTool class methodsFor! addContextMenu "CJD 6-27-2001 Add a context menu item." | mm cmd | mm := CJDMenuManager new. mm targetClass: ClassBrowserShell. mm targetViewName: 'Default view'. mm openView. mm saveBackupView. cmd := CommandMenuItem command: #generatePresenterSkeleton description: 'Generate Presenter Code'. mm addCommand: cmd toContextMenuFor: 'classes' after: 'Views'. mm saveView. ! generateClass: aPresenterClass viewName: aViewName "CJD 5-8-2001 Generate generic sub-Presenter code for aViewName in aClass Presenter. This will add instance variables from the sub presenters, and create or add to a createComponents method." | pgen | (aPresenterClass includesBehavior: Presenter) ifFalse: [^MessageBox notify: aPresenterClass name , ' is not a Presenter.']. pgen := self new. pgen targetClass: aPresenterClass; targetViewName: aViewName. pgen generateClassDef. pgen generateCreateComponents. ^pgen.! removeContextMenu "CJD 6-27-2001 Remove a context menu item." | mm | mm := CJDMenuManager new. mm targetClass: ClassBrowserShell. mm targetViewName: 'Default view'. mm openView. mm removeCommand: 'Generate Presenter Code' fromContextMenuFor: 'classes'. mm saveView. ! ! !CJDPresenterGenTool class categoriesFor: #addContextMenu!*-unclassified!public! ! !CJDPresenterGenTool class categoriesFor: #generateClass:viewName:!*-unclassified!public! ! !CJDPresenterGenTool class categoriesFor: #removeContextMenu!*-unclassified!public! ! "Binary Globals"! "Resources"!