--- a/NewSystemBrowser.st	Wed Feb 09 20:40:50 2011 +0100
+++ b/NewSystemBrowser.st	Thu Feb 10 16:57:37 2011 +0100
@@ -5212,7 +5212,7 @@
 
     <resource: #menu>
 
-    ^
+    ^ 
      #(Menu
         (
          (MenuItem
@@ -5289,9 +5289,9 @@
             isVisible: hasNonProjectDefinitionSelectedHolder
           )
          (MenuItem
-            enabled: hasApplicationOrHTTPServiceClassSelectedHolder
-            label: 'Application Code'
-            itemValue: classMenuGenerateApplicationCode
+            enabled: hasLoadedClassSelectedHolder
+            label: 'Singleton Pattern'
+            itemValue: classMenuGenerateSingletonPatternInstanceCreationMethods
             translateLabel: true
             isVisible: hasNonProjectDefinitionSelectedHolder
           )
@@ -5310,13 +5310,23 @@
             isVisible: hasNonProjectDefinitionSelectedHolder
           )
          (MenuItem
+            label: '-'
+            isVisible: hasNonProjectDefinitionSelectedHolder
+          )
+         (MenuItem
+            enabled: hasApplicationOrHTTPServiceClassSelectedHolder
+            label: 'Application Code'
+            itemValue: classMenuGenerateApplicationCode
+            translateLabel: true
+            isVisible: hasNonProjectDefinitionSelectedHolder
+          )
+         (MenuItem
             enabled: hasLoadedClassSelectedHolder
             label: 'Class Initialization Code'
             itemValue: classMenuGenerateClassInitializationCode
             translateLabel: true
             isVisible: hasNonProjectDefinitionSelectedHolder
           )
-
          (MenuItem
             enabled: hasLoadedClassSelectedHolder
             label: 'Required Protocol'
@@ -20434,6 +20444,48 @@
         lazyInitialization:false
 !
 
+classMenuGenerateSingletonPatternInstanceCreationMethods
+    "create instance creation methods for singleton"
+
+    |singletonVarName|
+
+    self
+        generateUndoableChangeOverSelectedClasses:'Singleton Pattern for %(singleClassNameOrNumberOfClasses)'
+        via:[:generator :eachClass |
+            |theClass vars defaultNameForSingleton singletonVar|
+
+            "/ if any of the selected classes is a subclass of one of the previously processed,
+            "/ and we have added a class-instvar in the previous loop cycle,
+            "/ we have top refetch, because the class is now obsolete (stupid consequence of not having a
+            "/ good become).
+            "/ refetch to get the present class (sigh)
+            theClass := Smalltalk at:(eachClass theNonMetaclass name).
+
+            vars := theClass theMetaclass allInstanceVariableNames asSet.
+            vars removeAll:(Class allInstanceVariableNames).
+
+            (singletonVarName notNil and:[vars includes:singletonVarName]) ifTrue:[
+                defaultNameForSingleton := singletonVarName
+            ] ifFalse:[
+                defaultNameForSingleton := 'theOneAndOnlyInstance'.
+                "/ vars add:'theOneAndOnlyInstance'.
+            ].
+            singletonVar := Dialog  
+                request:'Class-Instvar to keep Singleton in?'
+                initialAnswer:defaultNameForSingleton
+                list:(vars asSortedCollection).
+            singletonVar isEmptyOrNil ifTrue:[^ self].
+
+            (theClass theMetaclass allInstanceVariableNames asSet includes:singletonVar) ifFalse:[
+                theClass theMetaclass addInstVarName:singletonVar.
+                theClass := Smalltalk at:(eachClass theNonMetaclass name).
+            ].
+            generator createSingletonPatternInstanceCreationMethodsIn:theClass usingVariable:singletonVar
+        ].
+
+    "Created: / 10-02-2011 / 16:28:36 / cg"
+!
+
 classMenuGenerateStandardPrintOnMethod
     self
         generateUndoableChangeOverSelectedClasses:'Generate PrintOn Method for %(singleClassNameOrNumberOfClasses)'
@@ -45032,11 +45084,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1514 2011-02-09 13:03:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1515 2011-02-10 15:57:37 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1514 2011-02-09 13:03:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1515 2011-02-10 15:57:37 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!