Tools__Inspector2.st
author Claus Gittinger <cg@exept.de>
Mon, 05 Sep 2011 07:05:15 +0200
changeset 10664 a3c3b49e35ff
parent 10636 5a678905e63a
child 10875 2bcc9f486e55
permissions -rw-r--r--
fix class/meta selection

"
 COPYRIGHT (c) 2006 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

ApplicationModel subclass:#Inspector2
	instanceVariableNames:'tabViewAspect navigationHistoryHolder navigationStateAspect
		browser currentObjectHolder'
	classVariableNames:'LastExtent'
	poolDictionaries:''
	category:'Interface-Inspector2'
!

Model subclass:#NavigationState
	instanceVariableNames:'theObject index tabs selectionIndex displayString'
	classVariableNames:''
	poolDictionaries:''
	privateIn:Inspector2
!

!Inspector2 class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

description
"
    an application for a multitab inspector
    extendable by the inspected object itself, by providing additional
    tabs via the inspector2XXX methods

    [author:]
        Jan Vrani
"
! !

!Inspector2 class methodsFor:'help specs'!

flyByHelpSpec
    "This resource specification was automatically generated
     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIHelpTool may not be able to read the specification."

    "
     UIHelpTool openOnClass:Tools::Inspector2    
    "

    <resource: #help>

    ^ super flyByHelpSpec addPairsFrom:#(

#backwardInVisitingHistory
'Move backward in the history of previously visited objects'

#browseClassOfShownObject
'Open a Systembrowser on the shown object''s class'

#browseFile
'Open a Filebrowser on the file represented by the shown object'

#forwardInVisitingHistory
'Move forward in the history of previously visited objects'


)

    "Created: / 19-08-2011 / 08:52:33 / cg"
! !

!Inspector2 class methodsFor:'interface specs'!

windowSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::Inspector2 andSelector:#windowSpec
     Tools::Inspector2 new openInterface:#windowSpec
     Tools::Inspector2 open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'Inspector2'
          name: 'Inspector2'
          labelChannel: windowTitleAspect
          min: (Point 0 0)
          bounds: (Rectangle 0 0 388 421)
        )
        component: 
       (SpecCollection
          collection: (
           (MenuPanelSpec
              name: 'ToolBar'
              layout: (LayoutFrame 0 0 0 0 0 1 40 0)
              menu: toolbarMenu
              textDefault: true
            )
           (NoteBookViewSpec
              name: 'NoteBook'
              layout: (LayoutFrame 0 0 40 0 0 1 0 1)
              model: tabSelectionIndexAspect
              menu: tabLabelsAspect
              useIndex: true
              fitLastRow: false
              canvas: tabViewAspect
              keepCanvasAlive: true
            )
           )
         
        )
      )
! !

!Inspector2 class methodsFor:'menu specs'!

toolbarMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::Inspector2 andSelector:#toolbarMenu
     (Menu new fromLiteralArrayEncoding:(Tools::Inspector2 toolbarMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            activeHelpKey: backwardInVisitingHistory
            enabled: backButtonEnabledHolder
            label: 'Back'
            itemValue: backButtonAction
            translateLabel: true
            isButton: true
            hideMenuOnActivated: false
            submenuChannel: backButtonMenuChannel
            labelImage: (ResourceRetriever ToolbarIconLibrary historyBackIcon)
          )
         (MenuItem
            activeHelpKey: forwardInVisitingHistory
            enabled: forwardButtonEnabledHolder
            label: 'Forward'
            itemValue: forwardButtonAction
            translateLabel: true
            isButton: true
            hideMenuOnActivated: false
            submenuChannel: forwardButtonMenuChannel
            labelImage: (ResourceRetriever ToolbarIconLibrary historyForwardIcon)
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            activeHelpKey: browseClassOfShownObject
            enabled: browseButtonEnabledHolder
            label: 'Browse'
            itemValue: browseClassAction
            translateLabel: true
            isButton: true
            hideMenuOnActivated: false
            labelImage: (ResourceRetriever ToolbarIconLibrary startNewSystemBrowserIcon)
          )
         (MenuItem
            activeHelpKey: browseFile
            label: 'Browse File'
            itemValue: browseFileAction
            translateLabel: true
            isButton: true
            isVisible: currentObjectIsFilename
            hideMenuOnActivated: false
            labelImage: (ResourceRetriever ToolbarIconLibrary startNewFileBrowserIcon)
          )
         (MenuItem
            label: 'Refresh for Changed Object'
            itemValue: refreshTabs
            translateLabel: true
            isButton: true
            startGroup: right
            labelImage: (ResourceRetriever ToolbarIconLibrary reloadIcon)
          )
         )
        nil
        nil
      )
! !

!Inspector2 class methodsFor:'startup'!

openOn: anObject

    self new 
        openOn: anObject.

    "Modified: / 17-02-2008 / 10:29:45 / janfrog"
    "Modified (format): / 11-07-2011 / 22:28:03 / cg"
! !

!Inspector2 class methodsFor:'testing'!

testSimpleShow
    |ins|

    ins := Inspector2 openOn:4.
    ins inspect:10.
    ins inspect:42.
    ins inspect:'dead one'.
    ins inspect:'rolled back'.
    
    "/ins inspectItem: (ins history at: 3).  "/ Rollback history, zustanou jen prvni 3
    
    ins inspect:'xFuj'.

    "Modified: / 11-01-2008 / 20:36:37 / janfrog"
! !

!Inspector2 methodsFor:'accessing'!

backButtonEnabled:value 
    ^ self backButtonEnabledHolder value:value

    "Created: / 12-01-2008 / 19:14:35 / janfrog"
    "Modified (format): / 19-08-2011 / 08:59:41 / cg"
!

currentObject
    ^ self navigationState theObject

    "Created: / 13-01-2008 / 10:14:47 / janfrog"
    "Modified: / 17-02-2008 / 09:49:01 / janfrog"
!

currentState
    ^ self navigationHistoryHolder currentItem

    "Created: / 21-02-2008 / 19:39:45 / janfrog"
    "Modified: / 27-02-2008 / 11:56:55 / janfrog"
!

forwardButtonEnabled:value 
    ^ self forwardButtonEnabledHolder value:value

    "Created: / 12-01-2008 / 19:14:48 / janfrog"
    "Modified (format): / 19-08-2011 / 08:59:45 / cg"
!

navigationState
    ^ self navigationHistoryHolder value currentItem

    "Created: / 17-02-2008 / 09:49:01 / janfrog"
    "Modified: / 21-02-2008 / 19:34:14 / janfrog"
    "Modified: / 22-07-2011 / 19:13:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

navigationState:historyItem 
    self navigationHistoryHolder "subjectChannel:" value currentItem:historyItem.

    "/self fixNavigation. "Nevola se kvuli problemu s prekreslovanim"
    "/self updateTabs.

    "Created: / 17-02-2008 / 09:49:11 / janfrog"
    "Modified: / 21-02-2008 / 19:47:26 / janfrog"
    "Modified: / 22-07-2011 / 19:13:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 19-08-2011 / 09:16:38 / cg"
! !

!Inspector2 methodsFor:'aspects'!

backButtonEnabledHolder
    "return/create the 'backButtonEnabledHolder' value holder (automatically generated)"

    ^(AspectAdaptor forAspect:#canGoBack)
        subjectChannel: self navigationHistoryHolder

    "Created: / 12-01-2008 / 19:13:49 / janfrog"
    "Modified: / 27-02-2008 / 12:11:30 / janfrog"
!

browseButtonEnabledHolder
    ^ BlockValue
        with:[:m | m notNil]
        argument:self navigationStateAspect

    "Created: / 19-08-2011 / 09:22:47 / cg"
!

currentObjectHolder
    currentObjectHolder isNil ifTrue:[
        currentObjectHolder := ValueHolder new
    ].
    ^ currentObjectHolder

    "Created: / 27-02-2008 / 12:05:22 / janfrog"
    "Created: / 19-08-2011 / 08:58:48 / cg"
!

currentObjectIsFilename
    ^ BlockValue
        with:[:o | o isFilename ]
        argument:self currentObjectHolder

    "Created: / 19-08-2011 / 08:56:27 / cg"
!

forwardButtonEnabledHolder
    "return/create the 'backButtonEnabledHolder' value holder (automatically generated)"

    ^(AspectAdaptor forAspect:#canGoForward)
        subjectChannel: self navigationHistoryHolder

    "Created: / 12-01-2008 / 19:13:49 / janfrog"
    "Modified: / 27-02-2008 / 12:11:26 / janfrog"
!

navigationHistoryHolder
    "return/create the 'currentItemHolder' value holder (automatically generated)"
    
    navigationHistoryHolder isNil ifTrue:[
        navigationHistoryHolder := Tools::NavigationHistory new.
    ].
    ^ navigationHistoryHolder

    "Created: / 21-02-2008 / 19:34:14 / janfrog"
!

navigationStateAspect
    navigationStateAspect isNil ifTrue:[
        navigationStateAspect := (AspectAdaptor forAspect:#currentItem) 
                    subjectChannel:self navigationHistoryHolder
    ].
    ^ navigationStateAspect

    "Created: / 27-02-2008 / 12:05:22 / janfrog"
    "Modified (format): / 19-08-2011 / 08:59:10 / cg"
!

tabLabelsAspect
    ^ (AspectAdaptor forAspect:#tabLabels) 
        subjectChannel:self navigationStateAspect

    "Created: / 16-01-2008 / 17:29:52 / janfrog"
    "Modified: / 27-02-2008 / 12:05:32 / janfrog"
    "Modified (format): / 19-08-2011 / 08:59:21 / cg"
!

tabSelectionIndexAspect
    ^ ((AspectAdaptor forAspect:#selectionIndex) 
        subjectChannel:self navigationStateAspect)
        onChangeEvaluate:[ self tabViewAspect changed ];
        yourself

    "Created: / 16-01-2008 / 17:29:29 / janfrog"
    "Modified: / 27-02-2008 / 12:06:05 / janfrog"
!

tabViewAspect
    tabViewAspect isNil ifTrue:[
        tabViewAspect := (AspectAdaptor forAspect:#selectionView) 
                    subjectChannel:self navigationStateAspect
    ].
    ^ tabViewAspect

    "Created: / 16-01-2008 / 17:30:05 / janfrog"
    "Modified: / 27-02-2008 / 12:05:46 / janfrog"
    "Modified (format): / 19-08-2011 / 08:59:35 / cg"
!

windowTitleAspect
    ^ (AspectAdaptor forAspect:#displayString) 
        subjectChannel:self navigationStateAspect

    "Created: / 17-02-2008 / 08:42:21 / janfrog"
    "Modified: / 27-02-2008 / 12:05:56 / janfrog"
! !

!Inspector2 methodsFor:'menu'!

backButtonMenuChannel
    ^ [ self navigationHistoryHolder goBackMenu ]

    "Created: / 12-01-2008 / 18:57:08 / janfrog"
    "Modified: / 22-02-2008 / 16:57:46 / janfrog"
!

forwardButtonMenuChannel
    ^ [ self navigationHistoryHolder goForwardMenu ]

    "Created: / 12-01-2008 / 18:57:30 / janfrog"
    "Modified: / 22-02-2008 / 16:58:11 / janfrog"
! !

!Inspector2 methodsFor:'menu actions'!

backButtonAction
    self navigationHistoryHolder goBack.
    self updateWindowLabel

    "Modified: / 21-02-2008 / 19:40:23 / janfrog"
    "Modified: / 15-07-2011 / 16:26:28 / cg"
!

browseClassAction
    "open a class browser, or try to add a tab to the previously opened class browser"

    | class |

    class := self currentObject class.

    browser notNil ifTrue:[
        "/ try to add a tab to the already opened browser
        (browser isKindOf:Tools::NewSystemBrowser) ifTrue:[
            browser spawnClassBrowserFor:(Array with:class) in:#newBuffer.
            "/ browser spawnSingleClassBrowserFor:class in:#newBuffer.
            browser window raise.
            ^ self.
        ].
    ].
    "/ if that fails, open a new one

    browser := UserPreferences current systemBrowserClass openInClass:class selector:nil "/ browseSingleClass: class

    "Modified: / 23-07-2011 / 11:28:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 21-08-2011 / 08:37:59 / cg"
!

browseFileAction
    "open a filebrowser on the file represented by the current object"

    | fn |

    fn := self currentObject asFilename.
    UserPreferences current fileBrowserClass openOn:fn

    "Created: / 19-08-2011 / 09:29:44 / cg"
!

forwardButtonAction
    self navigationHistoryHolder goForward.
    self updateWindowLabel

    "Created: / 21-02-2008 / 19:52:03 / janfrog"
    "Modified: / 15-07-2011 / 16:26:33 / cg"
!

refreshTabs
    self navigationHistoryHolder currentItem refreshTabs.
    self tabViewAspect changed.

"/    sel := selectionIndex.
"/    self selectionIndex:nil.
"/    self selectionIndex:sel.

    "Created: / 21-08-2011 / 08:23:00 / cg"
! !

!Inspector2 methodsFor:'opening'!

closeDownViews
    LastExtent := self window extent.
    super closeDownViews.

    "Created: / 11-07-2011 / 22:33:47 / cg"
!

historyTryPush: anObject
    <resource: #obsolete>

  "/ Pokud uz na anObject byl tak tam skocit, jinak pridat na konec
  self history do: [:item |
    item theObject == anObject ifTrue:[ ^item ]
  ].

  ^ self history push:anObject.

    "Modified: / 16-01-2008 / 14:25:30 / janfrog"
!

inspect:anObject 
    self navigationHistoryHolder currentItem:(NavigationState for:anObject).
    self window notNil ifTrue:[
        self updateWindowLabel
    ].

    "Modified: / 27-02-2008 / 12:06:52 / janfrog"
    "Modified: / 15-07-2011 / 16:26:03 / cg"
    "Modified (format): / 19-08-2011 / 09:01:20 / cg"
!

openOn: anObject
    self inspect: anObject.    
    self openWithExtent:(LastExtent ? nil).

    "Modified: / 13-01-2008 / 13:55:27 / janfrog"
    "Modified: / 11-07-2011 / 22:31:42 / cg"
!

postBuildWith:aBuilder
    self updateWindowLabel

    "Created: / 15-07-2011 / 16:25:36 / cg"
!

updateWindowLabel
    |currentItem object|

    (currentItem := self navigationHistoryHolder currentItem) notNil ifTrue:[
        object := currentItem theObject.
    ].
    self currentObjectHolder value:object.
    self window label:(InspectorView commonLabelFor:object).

    "Created: / 15-07-2011 / 16:25:42 / cg"
! !

!Inspector2::NavigationState class methodsFor:'creating classes'!

for:anObject 
    |item|

    item := self new.
    item theObject:anObject.
    ^ item.

    "Modified (format): / 19-08-2011 / 09:24:40 / cg"
! !

!Inspector2::NavigationState class methodsFor:'documentation'!

version
    ^'$Id: Tools__Inspector2.st,v 1.19 2011-09-05 05:05:15 cg Exp $'
!

version_SVN
    ^'§Id: Tools__Inspector2.st 115 2009-04-16 12:47:07Z vranyj1 §'
! !

!Inspector2::NavigationState methodsFor:'accessing'!

index
    ^ index
!

index:something
    index := something.
!

selectionIndex
    selectionIndex ifNil:[^1].
    selectionIndex < 1 ifTrue:[^1].
    selectionIndex > tabs size ifTrue:[^tabs size].
    ^selectionIndex

    "Created: / 16-01-2008 / 17:24:27 / janfrog"
    "Modified: / 17-02-2008 / 10:20:35 / janfrog"
!

selectionIndex: anInteger
    selectionIndex := anInteger.
    self changed:#selectionIndex

    "Created: / 16-01-2008 / 17:27:52 / janfrog"
    "Modified: / 17-02-2008 / 09:46:45 / janfrog"
!

selectionView

    |tab|

    tab := self tabs at: self selectionIndex.
    ^tab 
        ifNil:[nil]
        ifNotNil:[tab view].

    "Created: / 16-01-2008 / 17:31:19 / janfrog"
!

tabLabels

    ^self tabs collect:[:tab | tab label]

    "Created: / 16-01-2008 / 17:14:07 / janfrog"
!

tabViews

    ^self tabs collect:[:tab | tab view]

    "Created: / 16-01-2008 / 17:14:13 / janfrog"
!

tabs

    tabs ifNil:[self initializeTabs].
    ^tabs

    "Created: / 16-01-2008 / 16:51:53 / janfrog"
!

theObject
    ^ theObject
!

theObject:anObject
    theObject := anObject.
    self changed

    "Modified: / 17-02-2008 / 08:38:44 / janfrog"
    "Modified: / 19-08-2011 / 09:16:25 / cg"
! !

!Inspector2::NavigationState methodsFor:'comparing'!

= anotherState

    ^self class == anotherState class 
        and:[self theObject == anotherState theObject]

    "Created: / 21-02-2008 / 19:39:01 / janfrog"
!

hash

    ^theObject hash

    "Created: / 21-02-2008 / 19:38:08 / janfrog"
! !

!Inspector2::NavigationState methodsFor:'displaying'!

displayString

    displayString isNil ifTrue:[
        displayString := theObject printString contractAtEndTo:15.
        displayString := displayString , ' [', theObject class name , ']'
    ].
    ^ displayString

    "Created: / 21-02-2008 / 19:53:07 / janfrog"
    "Modified: / 25-07-2011 / 10:50:52 / cg"
! !

!Inspector2::NavigationState methodsFor:'initialization'!

initializeClassBrowserTab
    | browser spec |

    spec := #singleClassBrowserSpec.
    "/spec := #multipleClassBrowserSpec.
    browser := Tools::NewSystemBrowser new.
    browser createBuilder.
    browser navigationState canvasType:spec.
    browser browserCanvasType:spec.
    browser browserCanvas value builder:(browser builder).
    browser navigationState canvas:browser browserCanvas value.
    browser showInheritedMethods.
    browser classListGenerator value:(Array with:theObject class theNonMetaclass).
    browser selectClass: theObject class theNonMetaclass.

    tabs add:
        (Tools::Inspector2Tab new
            priority: 0;
            label:'Class';
            view: (ApplicationSubView new
                        client: browser spec: spec))

    "Created: / 22-07-2011 / 18:48:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 05-09-2011 / 05:24:16 / cg"
!

initializeCommonTabs

    "Unfinished code"
    self initializeClassBrowserTab

"/    tabs add:
"/        (Tools::Inspector2Tab new
"/            priority: 50;
"/            label:'Object';
"/            view: ((theObject inspectorClass new inspect:theObject)
"/                        yourself))

    "Created: / 16-01-2008 / 16:56:48 / janfrog"
    "Modified: / 17-02-2008 / 10:29:54 / janfrog"
    "Modified: / 21-08-2011 / 10:03:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializeExtraTabs

    "/ cg: I prefer using explicit getter - so I find them in the browser
    theObject inspector2Tabs do: [:selector|
            | tab |
            tab := [ theObject perform: selector ] 
                        on: Error do:[:ex|
                            "/ for debugging:  ex reject.
                            Tools::Inspector2Tab new 
                                label: selector;
                                text:
                                    (ex description, Character cr, Character cr,
                                     ex suspendedContext fullPrintAllString)].
            (tab notNil and:[tab isKindOf: Tools::Inspector2Tab])
                ifTrue:[tabs add: tab]].

    "Created: / 16-01-2008 / 17:25:24 / janfrog"
    "Modified: / 17-02-2008 / 10:30:43 / janfrog"
    "Modified: / 07-11-2008 / 08:40:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified (format): / 21-08-2011 / 08:01:34 / cg"
!

initializeTabs

    tabs := OrderedCollection new.
    self initializeCommonTabs.
    self initializeExtraTabs.
    tabs := tabs asSortedCollection:[:a :b|a priority > b priority].

    "Created: / 16-01-2008 / 16:54:28 / janfrog"
    "Modified: / 17-02-2008 / 10:08:04 / janfrog"
!

refreshTabs
    tabs := nil.
    self initializeTabs.

    "Created: / 21-08-2011 / 08:23:11 / cg"
! !

!Inspector2 class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.19 2011-09-05 05:05:15 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.19 2011-09-05 05:05:15 cg Exp $'
!

version_CVS_jvrany
    ^ '§Header: /opt/data/cvs/stx/goodies/libtool3/Inspector2.st,v 1.6 2008-02-27 13:45:23 vranyj1 Exp §'
!

version_SVN
    ^ '§Id: Tools__Inspector2.st 7486 2009-10-26 22:06:24Z vranyj1 §'
! !