added mechanism to reconnect a class (in case its removed from
authorClaus Gittinger <cg@exept.de>
Fri, 24 Jan 1997 18:51:38 +0100
changeset 991 893a4dc659af
parent 990 e206a230a69e
child 992 311227ea4edb
added mechanism to reconnect a class (in case its removed from the smalltalk dictionary).
BrowserView.st
BrwsrView.st
--- a/BrowserView.st	Fri Jan 24 15:48:10 1997 +0100
+++ b/BrowserView.st	Fri Jan 24 18:51:38 1997 +0100
@@ -3629,7 +3629,7 @@
 classSelection:lineNr
     "user clicked on a class line - show method categories"
 
-    |cls nm oldSelector sel|
+    |cls nm oldSelector sel classes key msg globlName|
 
     (currentClassHierarchy notNil
      and:[fullProtocol]) ifTrue:[
@@ -3662,10 +3662,45 @@
         self switchToClass:cls.
         self classSelectionChanged
     ] ifFalse:[
-        self warn:'oops - no class named: ' , nm , ' found in selected namespace(s)'.
+        (self confirm:('oops - no class named: ' , nm , ' found in selected namespace(s)\\Try to reconnect ?') withCRs)
+        ifTrue:[
+            "/ search for all classes by that name ...
+            classes := IdentitySet new.
+            Class allSubInstancesDo:[:aClass |
+                aClass name = nm ifTrue:[
+                    classes add:aClass
+                ]
+            ].
+            classes notEmpty ifTrue:[
+                classes size == 1 ifTrue:[
+                    cls := classes first.
+                    Smalltalk 
+                        keysAndValuesDo:[:key :aClass |
+                                (Smalltalk at:key) == cls ifTrue:[
+                                    globlName := key
+                                ]
+                        ].
+
+                    msg := 'found ' , cls name , ' in category ''' , cls category , '.\'.
+                    globlName notNil ifTrue:[
+                        msg := msg , '(known as ' , globlName , ')\'.
+                    ].
+                    (self confirm:(msg , '\reconnect ?') withCRs)
+                    ifTrue:[
+                        Smalltalk at:cls name asSymbol put:cls
+                    ]
+                ] ifFalse:[
+                    self warn:('found multiple classes with a name of ' , nm , '.\\Select and rename as required') withCRs.
+                     SystemBrowser browseClasses:classes asOrderedCollection
+                                           title:'choose and rename as required'
+                ]
+            ] ifFalse:[
+                self warn:'oops - could not find that class'
+            ]
+        ]
     ]
 
-    "Modified: 3.1.1997 / 11:44:02 / cg"
+    "Modified: 24.1.1997 / 18:49:47 / cg"
 !
 
 classSelectionChanged
@@ -9535,6 +9570,6 @@
 !BrowserView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.263 1997-01-24 14:48:10 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.264 1997-01-24 17:51:38 cg Exp $'
 ! !
 BrowserView initialize!
--- a/BrwsrView.st	Fri Jan 24 15:48:10 1997 +0100
+++ b/BrwsrView.st	Fri Jan 24 18:51:38 1997 +0100
@@ -3629,7 +3629,7 @@
 classSelection:lineNr
     "user clicked on a class line - show method categories"
 
-    |cls nm oldSelector sel|
+    |cls nm oldSelector sel classes key msg globlName|
 
     (currentClassHierarchy notNil
      and:[fullProtocol]) ifTrue:[
@@ -3662,10 +3662,45 @@
         self switchToClass:cls.
         self classSelectionChanged
     ] ifFalse:[
-        self warn:'oops - no class named: ' , nm , ' found in selected namespace(s)'.
+        (self confirm:('oops - no class named: ' , nm , ' found in selected namespace(s)\\Try to reconnect ?') withCRs)
+        ifTrue:[
+            "/ search for all classes by that name ...
+            classes := IdentitySet new.
+            Class allSubInstancesDo:[:aClass |
+                aClass name = nm ifTrue:[
+                    classes add:aClass
+                ]
+            ].
+            classes notEmpty ifTrue:[
+                classes size == 1 ifTrue:[
+                    cls := classes first.
+                    Smalltalk 
+                        keysAndValuesDo:[:key :aClass |
+                                (Smalltalk at:key) == cls ifTrue:[
+                                    globlName := key
+                                ]
+                        ].
+
+                    msg := 'found ' , cls name , ' in category ''' , cls category , '.\'.
+                    globlName notNil ifTrue:[
+                        msg := msg , '(known as ' , globlName , ')\'.
+                    ].
+                    (self confirm:(msg , '\reconnect ?') withCRs)
+                    ifTrue:[
+                        Smalltalk at:cls name asSymbol put:cls
+                    ]
+                ] ifFalse:[
+                    self warn:('found multiple classes with a name of ' , nm , '.\\Select and rename as required') withCRs.
+                     SystemBrowser browseClasses:classes asOrderedCollection
+                                           title:'choose and rename as required'
+                ]
+            ] ifFalse:[
+                self warn:'oops - could not find that class'
+            ]
+        ]
     ]
 
-    "Modified: 3.1.1997 / 11:44:02 / cg"
+    "Modified: 24.1.1997 / 18:49:47 / cg"
 !
 
 classSelectionChanged
@@ -9535,6 +9570,6 @@
 !BrowserView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.263 1997-01-24 14:48:10 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.264 1997-01-24 17:51:38 cg Exp $'
 ! !
 BrowserView initialize!