| package | package := Package name: 'CJDPresenterGenerator'. package paxVersion: 0; basicComment: 'Release 0.0.2 Alpha (6-12-2002) By: Christopher J. Demers Copyright 2002 (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. It preserves 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 entries (if the instance variables exist) but append new entries. DIRECTIONS: A context menu item ''Generate Presenter Code'' should be added to the class menu by evaluating the following code: CJDPresenterGenTool addContextMenu. The context menu can be removec by evaluating: CJDPresenterGenTool removeContextMenu. or uninstalling the class. Updates: cdemers - 5/14/2002 Added enhancement to support customizable presenter instance variable name postfixes (see CJDPresenterGenTool class< #generatePresenterSkeleton; yourself. package binaryGlobalNames: (Set new yourself). package globalAliases: (Set new yourself). package allResourceNames: (Set new yourself). package setPrerequisites: (IdentitySet new add: '..\..\Object Arts\Dolphin\IDE\Base\Development System'; add: '..\..\Object Arts\Dolphin\Base\Dolphin'; add: '..\..\Object Arts\Dolphin\MVP\Views\Common Controls\Dolphin Common Controls'; add: '..\..\Object Arts\Dolphin\MVP\Base\Dolphin MVP Base'; add: '..\..\Object Arts\Dolphin\IDE\Standard Edition\Standard Edition Tools'; yourself). package! "Class Definitions"! Object subclass: #CJDPresenterGenTool instanceVariableNames: 'targetClass targetViewName targetView namedSubViews existingIVarNames' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: 'presenterIvarNamePostFix'! "Global Aliases"! "Loose Methods"! !ClassBrowserAbstract methodsFor! generatePresenterSkeleton "CJD 6-19-2001 Generate a Presenter Skeleton for the selected class." | class resources default | (class := self selectedClass) isNil ifTrue: [^self]. CJDPresenterGenTool generateClass: class viewName: nil! ! !ClassBrowserAbstract categoriesFor: #generatePresenterSkeleton!commands!private! ! "End of package definition"! "Source Globals"! "Classes"! CJDPresenterGenTool guid: (GUID fromString: '{64421FB4-7CBF-4F1C-B86B-C07B3C99FEEA}')! 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 entries (if the instance variables exist) but append new entries. cdemers - 5/14/2002 Add enhancement to support customizable presenter instance variable name postfixes (see presenterIvarNamePostFix on the class side).'! !CJDPresenterGenTool categoriesForClass!Unclassified! ! !CJDPresenterGenTool methodsFor! generateClassDef "Private - 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 := self getNamedSubViews. "targetView subViews select: [:sv | sv name notNil]." namedSubViews := namedSubViews reject: [ :sv | (self viewClassesToIgnore includes: sv class name) or: [existingIVarNames includes: (self presenterIVarNameFor: sv name)]]. presenterNames := namedSubViews collect: [:sv | self presenterIVarNameFor: sv name]. 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 "Private - 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 | | presenterIVarName | presenterIVarName := self presenterIVarNameFor: sv name. (existingIVarNames includes: presenterIVarName) ifFalse: [str := str , tab , presenterIVarName , ' := self add: ' , (presenterMap at: sv class ifAbsent: [Presenter]) printString , ' new name: ' , sv name printString , '.' , cr]]. targetClass compile: str.! getNamedSubViews "Private - CJD 7-18-2001 Return an collection of named subViews." | unNamedSubViews | namedSubViews := targetView subViews select: [:sv | sv name notNil]. unNamedSubViews := targetView subViews select: [:sv | sv name isNil]. unNamedSubViews do: [:each | (each isKindOf: CardContainer) ifTrue: [each subViews do: [:container | namedSubViews addAll: (container subViews select: [:subView | subView name notNil])]] ]. ^namedSubViews.! hasTrailingStatementSeperator: aMethodCodeString "Private - 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.! isValidPresenterIvarName: aString "Private - cdemers - 5/14/2002 Make sure aString is valid for use as instance variable name." ^(#('model' 'super' 'self' 'view' 'parentPresenter' 'events' 'subPresenters' 'names' 'caption' 'commandHistory' 'confirmed' 'ownerView') includes: aString) not! presenterIVarNameFor: viewName "Private - cdemers - 5/14/2002 Return the presenter instance variable name based on viewName . The default behavior is just to add 'Presenter' to the end of the view name. Some people prefer not to have this postifx and can remove it." | name | name := viewName , self class presenterIvarNamePostFix. ^(self isValidPresenterIvarName: name) ifTrue: [name] ifFalse: [name , 'Presenter']! presenterTypeMap "Private - 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. dict at: MultilineTextEdit put: TextPresenter. dict at: ListView put: ListPresenter. dict at: ListBox put: ListPresenter. "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 default | ^targetViewName isNil ifTrue: [viewNames := (SmalltalkSystem current viewResourcesForClass: self targetClass) keys asSortedCollection. default := targetClass defaultView. (viewNames includes: default) ifFalse: [default := nil]. targetViewName := ChoicePrompter on: default asValue choices: viewNames caption: 'Choose a view'] ifFalse: [targetViewName].! targetViewName: aViewName "Private - CJD Set the view to work on." targetViewName := aViewName! viewClassesToIgnore "Private - 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!private! ! !CJDPresenterGenTool categoriesFor: #generateCreateComponents!private! ! !CJDPresenterGenTool categoriesFor: #getNamedSubViews!private! ! !CJDPresenterGenTool categoriesFor: #hasTrailingStatementSeperator:!private! ! !CJDPresenterGenTool categoriesFor: #isValidPresenterIvarName:!private! ! !CJDPresenterGenTool categoriesFor: #presenterIVarNameFor:!private! ! !CJDPresenterGenTool categoriesFor: #presenterTypeMap!private! ! !CJDPresenterGenTool categoriesFor: #targetClass!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetClass:!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetViewName!accessing!private! ! !CJDPresenterGenTool categoriesFor: #targetViewName:!accessing!private! ! !CJDPresenterGenTool categoriesFor: #viewClassesToIgnore!private! ! !CJDPresenterGenTool class methodsFor! addContextMenu " self addContextMenu. " self classBrowserClasses do: [:each | each when: #viewOpened: send: #onBrowserOpened: to: self]! classBrowserClasses ^Array with: ClassBrowserShell with: SystemBrowserShell! extendClassContextMenu: aClassBrowserAbstract | classContextMenu | "This is needed because the class context menu is in different places, on the SystemBrowserShell I have to do some contortions because it is in an unnamed card view." classContextMenu := (aClassBrowserAbstract isKindOf: SystemBrowserShell) ifTrue: [((aClassBrowserAbstract presenterNamed: 'classes') presenterNamed: 'classes') view parentView parentView contextMenu] ifFalse: [((aClassBrowserAbstract presenterNamed: 'classes') presenterNamed: 'classes') view contextMenu]. classContextMenu addSeparator; addCommandDescription: (ClosedCommandDescription command: #generatePresenterSkeleton description: 'Generate Presenter Code' queryBlock: [:query | query receiver: aClassBrowserAbstract. query isEnabled: (aClassBrowserAbstract selectedClass includesBehavior: Presenter)] receiver: aClassBrowserAbstract)! 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.! onBrowserOpened: aClassBrowserAbstract self extendClassContextMenu: aClassBrowserAbstract! presenterIvarNamePostFix "cdemers - 5/14/2002 Return the Presenter instance variable postfix string. This string is stuck on the end of all presenter instance variable names. The default vaule is 'Presenter' if it is nil. This can be customized." ^presenterIvarNamePostFix isNil ifTrue: ['Presenter'] ifFalse: [presenterIvarNamePostFix]! presenterIvarNamePostFix: anObject "cdemers - 5/14/2002 Set the Presenter instance variable postfix string. This string is stuck on the end of all presenter instance variable names. The default vaule is 'Presenter' if it is nil. This can be customized. self presenterIvarNamePostFix: ''. Sets the postfix to nothing. " presenterIvarNamePostFix := anObject! removeContextMenu " self removeContextMenu. " self classBrowserClasses do: [:each | each removeEventsTriggeredFor: self]! uninitialize "Private - self uninitialize " self removeContextMenu.! ! !CJDPresenterGenTool class categoriesFor: #addContextMenu!initializing!public! ! !CJDPresenterGenTool class categoriesFor: #classBrowserClasses!constants!private! ! !CJDPresenterGenTool class categoriesFor: #extendClassContextMenu:!event handling!private! ! !CJDPresenterGenTool class categoriesFor: #generateClass:viewName:!public! ! !CJDPresenterGenTool class categoriesFor: #onBrowserOpened:!event handling!private! ! !CJDPresenterGenTool class categoriesFor: #presenterIvarNamePostFix!accessing!public! ! !CJDPresenterGenTool class categoriesFor: #presenterIvarNamePostFix:!accessing!public! ! !CJDPresenterGenTool class categoriesFor: #removeContextMenu!initializing!public! ! !CJDPresenterGenTool class categoriesFor: #uninitialize!initializing!private! ! "Binary Globals"! "Resources"!