# HG changeset patch # User Claus Gittinger # Date 1485356555 -3600 # Node ID 4f93c9ff29e5210191b1fdd6c97522cf6a52f4cc # Parent 0374afe33b72be5f330f1584d3d8ac0431d4e011 image inspector shows new tab diff -r 0374afe33b72 -r 4f93c9ff29e5 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 + + + |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| - - 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 " ! !