image inspector shows new tab
authorClaus Gittinger <cg@exept.de>
Wed, 25 Jan 2017 16:02:35 +0100
changeset 17257 4f93c9ff29e5
parent 17256 0374afe33b72
child 17258 124be7c3fea4
image inspector shows new tab
extensions.st
--- a/extensions.st	Wed Jan 25 14:21:50 2017 +0100
+++ b/extensions.st	Wed Jan 25 16:02:35 2017 +0100
@@ -1317,6 +1317,36 @@
 
 !Image methodsFor:'inspecting'!
 
+inspector2TabImageCreatorClass
+    <inspector2Tab>
+
+    |name className s ownerClass ownerSelector |
+    
+    (name := Icon nameIfKnownIcon:self) isNil ifTrue:[^ nil].
+
+    s := name readStream.
+    className := s upToSeparator.
+    (ownerClass := Smalltalk classNamed: className) isNil ifTrue:[^ nil].
+    s skipSeparators.
+    ownerSelector := s upToSeparator.
+    ownerSelector = 'class' ifTrue:[
+        ownerClass := ownerClass theMetaclass.
+        ownerSelector := ''.
+        s skipSeparators.
+    ].    
+    ownerSelector := ownerSelector , s upToEnd.
+    ownerSelector knownAsSymbol ifFalse:[^ nil].
+    
+    ^ Tools::Inspector2Tab 
+        toBrowseClass:ownerClass selector:ownerSelector asSymbol label:'Creator Class'
+
+    "
+     ToolbarIconLibrary systemBrowserIcon inspect
+    "
+! !
+
+!Image methodsFor:'inspecting'!
+
 inspector2Tabs
     |tabs|
     
@@ -1349,9 +1379,13 @@
 
     d := super inspectorExtraAttributes.
     (name := Icon nameIfKnownIcon:self) notNil ifTrue:[
-        d add:'-name' -> [ name ]
+        d add:'-origin (comes from)' -> [ name ]
     ].    
     ^ d
+
+    "
+     ToolbarIconLibrary systemBrowserIcon inspect
+    "
 ! !
 
 !Image methodsFor:'inspecting'!
@@ -1749,49 +1783,51 @@
 !Object methodsFor:'inspecting'!
 
 inspector2TabClass
-    |makeView|
-
     <inspector2Tab>
 
-    makeView := [
-        |spec view browser navigationState cls canvas|
-
-
-        view isNil ifTrue:[
-            "/ spec := #singleClassBrowserSpec.
-            spec := #multipleClassBrowserSpec.
-
-            browser := Tools::NewSystemBrowser new
-                           isEmbeddedBrowser:true;
-                           createBuilder.
-
-            navigationState := browser navigationState.
-            navigationState canvasType:spec.
-            browser browserCanvasType:spec.
-
-            canvas := browser browserCanvas value.
-            canvas builder:(browser builder).
-            navigationState canvas:canvas.
-            "/ browser switchToClassHierarchyView.
-            "/ browser showInheritedMethods.
-
-            cls := self class theNonMetaclass.
-            browser classListGenerator value:(cls withAllSuperclasses).
-            browser sortByNameAndInheritance value:true.
-            browser
-                selectClass:cls;
-                selectProtocol: (Tools::BrowserList nameListEntryForALL).  
-            view := ApplicationSubView new client: browser spec: spec.
-            navigationState classListApplication addOwnerClasses value:false.
-        ].
-        view
-    ].
-
-    ^  Tools::Inspector2Tab new
-            priority: 0;
-            label:'Class';
-            viewHolder: makeView;
-            yourself
+    ^ Tools::Inspector2Tab toBrowseClass:self class theNonMetaclass selector:nil label:'Class'
+    
+"/    |makeView|
+"/
+"/    makeView := [
+"/        |spec view browser navigationState cls canvas|
+"/
+"/
+"/        view isNil ifTrue:[
+"/            "/ spec := #singleClassBrowserSpec.
+"/            spec := #multipleClassBrowserSpec.
+"/
+"/            browser := Tools::NewSystemBrowser new
+"/                           isEmbeddedBrowser:true;
+"/                           createBuilder.
+"/
+"/            navigationState := browser navigationState.
+"/            navigationState canvasType:spec.
+"/            browser browserCanvasType:spec.
+"/
+"/            canvas := browser browserCanvas value.
+"/            canvas builder:(browser builder).
+"/            navigationState canvas:canvas.
+"/            "/ browser switchToClassHierarchyView.
+"/            "/ browser showInheritedMethods.
+"/
+"/            cls := self class theNonMetaclass.
+"/            browser classListGenerator value:(cls withAllSuperclasses).
+"/            browser sortByNameAndInheritance value:true.
+"/            browser
+"/                selectClass:cls;
+"/                selectProtocol: (Tools::BrowserList nameListEntryForALL).  
+"/            view := ApplicationSubView new client: browser spec: spec.
+"/            navigationState classListApplication addOwnerClasses value:false.
+"/        ].
+"/        view
+"/    ].
+"/
+"/    ^  Tools::Inspector2Tab new
+"/            priority: 0;
+"/            label:'Class';
+"/            viewHolder: makeView;
+"/            yourself
 
     "Created: / 03-02-2015 / 11:00:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !