ProjectBrowser.st
author Claus Gittinger <cg@exept.de>
Tue, 09 Feb 1999 19:47:38 +0100
changeset 1025 33c3db52cdc8
child 1026 ee8a738cd35d
permissions -rw-r--r--
initial checkin

ApplicationModel subclass:#ProjectBrowser
	instanceVariableNames:'knownProjects'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Smalltalk'
!

TreeItem subclass:#ProjectTreeItem
	instanceVariableNames:'action'
	classVariableNames:''
	poolDictionaries:''
	privateIn:ProjectBrowser
!


!ProjectBrowser class methodsFor:'interface specs'!

emptyRightCanvasSpec
    "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:ProjectBrowser andSelector:#emptyRightCanvasSpec
     ProjectBrowser new openInterface:#emptyRightCanvasSpec
    "

    <resource: #canvas>

    ^
     
       #(#FullSpec
          #window: 
           #(#WindowSpec
              #name: 'NewApplication'
              #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
              #label: 'NewApplication'
              #min: #(#Point 10 10)
              #max: #(#Point 1280 1024)
              #bounds: #(#Rectangle 216 173 516 473)
              #usePreferredExtent: false
          )
          #component: 
           #(#SpecCollection
              #collection: 
               #(
                 #(#TextEditorSpec
                    #name: 'TextEditor1'
                    #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
                    #model: #rightCanvasTextHolder
                    #hasHorizontalScrollBar: true
                    #hasVerticalScrollBar: true
                    #miniScrollerHorizontal: true
                    #isReadOnly: true
                )
              )
          )
      )
!

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:ProjectBrowser andSelector:#windowSpec
     ProjectBrowser new openInterface:#windowSpec
     ProjectBrowser open
    "

    <resource: #canvas>

    ^
     
       #(#FullSpec
          #window: 
           #(#WindowSpec
              #name: 'ProjectBrowser'
              #layout: #(#LayoutFrame 16 0 31 0 579 0 353 0)
              #label: 'ProjectBrowser'
              #min: #(#Point 10 10)
              #max: #(#Point 1024 768)
              #bounds: #(#Rectangle 16 31 580 354)
              #menu: #mainMenu
              #usePreferredExtent: false
          )
          #component: 
           #(#SpecCollection
              #collection: 
               #(
                 #(#MenuPanelSpec
                    #name: 'ToolBar1'
                    #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 32 0)
                    #menu: #menu
                    #textDefault: true
                )
                 #(#VariableHorizontalPanelSpec
                    #name: 'VariableHorizontalPanel1'
                    #layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
                    #component: 
                     #(#SpecCollection
                        #collection: 
                         #(
                           #(#SelectionInTreeViewSpec
                              #name: 'TreeList1'
                              #model: #selectedTreeNode
                              #hasHorizontalScrollBar: true
                              #hasVerticalScrollBar: true
                              #miniScrollerHorizontal: true
                              #showRoot: false
                              #showDirectoryIndicatorForRoot: false
                              #showDirectoryIndicator: true
                              #valueChangeSelector: #itemSelected:
                              #hierarchicalList: #projectTreeHolder
                              #highlightMode: #label
                          )
                           #(#SubCanvasSpec
                              #name: 'SubCanvas1'
                              #hasHorizontalScrollBar: false
                              #hasVerticalScrollBar: false
                              #specHolder: #currentCanvasHolder
                          )
                        )
                    )
                    #handles: #(#Any 0.274823 1.0)
                )
              )
          )
      )
! !

!ProjectBrowser class methodsFor:'menu specs'!

mainMenu
    "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:ProjectBrowser andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(ProjectBrowser mainMenu)) startUp
    "

    <resource: #menu>

    ^
     
       #(#Menu
          
           #(
             #(#MenuItem
                #label: 'File'
                #translateLabel: true
                #submenu: 
                 #(#Menu
                    
                     #(
                       #(#MenuItem
                          #label: 'New'
                          #translateLabel: true
                          #value: #newProject
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Open...'
                          #translateLabel: true
                          #value: #openProject
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Save'
                          #translateLabel: true
                          #value: #saveProject
                      )
                       #(#MenuItem
                          #label: 'Save As...'
                          #translateLabel: true
                          #value: #saveProjectAs
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Exit'
                          #translateLabel: true
                          #value: #closeRequest
                      )
                    ) nil
                    nil
                )
            )
             #(#MenuItem
                #label: 'Help'
                #translateLabel: true
                #startGroup: #right
                #submenu: 
                 #(#Menu
                    
                     #(
                       #(#MenuItem
                          #label: 'Documentation'
                          #translateLabel: true
                          #value: #openDocumentation
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'About this Application'
                          #translateLabel: true
                          #value: #openAboutThisApplication
                      )
                    ) nil
                    nil
                )
            )
          ) nil
          nil
      )
!

menu
    "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:ProjectBrowser andSelector:#menu
     (Menu new fromLiteralArrayEncoding:(ProjectBrowser menu)) startUp
    "

    <resource: #menu>

    ^
     
       #(#Menu
          
           #(
             #(#MenuItem
                #label: 'New...'
                #translateLabel: true
                #isButton: true
                #value: #newProject
                #labelImage: #(#ResourceRetriever #Icon #newIcon)
            )
             #(#MenuItem
                #label: 'Open...'
                #translateLabel: true
                #isButton: true
                #value: #openProject
                #labelImage: #(#ResourceRetriever #Icon #loadIcon)
            )
             #(#MenuItem
                #label: 'SaveAs...'
                #translateLabel: true
                #isButton: true
                #value: #saveProject
                #labelImage: #(#ResourceRetriever #Icon #saveIcon)
            )
          ) nil
          nil
      )
! !

!ProjectBrowser methodsFor:'aspects'!

currentCanvasHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept in the browser."

    |holder|

    (holder := builder bindingAt:#currentCanvasHolder) isNil ifTrue:[
        builder aspectAt:#currentCanvasHolder put:(holder :=  ValueHolder new).
    ].
    ^ holder.
!

projectTreeHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept in the browser."

    |holder|

    (holder := builder bindingAt:#projectTree) isNil ifTrue:[
        builder aspectAt:#projectTree put:(holder :=  SelectionInTree new).
        holder root:self projectTree.
    ].
    ^ holder.
!

rightCanvasTextHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept in the browser."

    |holder|

    (holder := builder bindingAt:#rightCanvasTextHolder) isNil ifTrue:[
        builder aspectAt:#rightCanvasTextHolder put:(holder :=  ValueHolder new).
    ].
    ^ holder.
!

selectedTreeNode
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept in the browser."

    |holder|

    (holder := builder bindingAt:#selectedTreeNode) isNil ifTrue:[
        builder aspectAt:#selectedTreeNode put:(holder :=  ValueHolder new).
    ].
    ^ holder.
! !

!ProjectBrowser methodsFor:'initialization'!

postBuildWith:aBuiler
    self setupCanvasForNoSelection
!

setupCanvasForNoSelection
    self currentCanvasHolder value:(self class emptyRightCanvasSpec).
    self rightCanvasTextHolder value:'Please select an existing,
or create a new project.'.
! !

!ProjectBrowser methodsFor:'private'!

nodeFor:aProject
    |projectName pNode 
     propertiesNode docNode classesNode subprojectsNode filesNode
     commentNode|

    projectName := aProject name.
    pNode := ProjectTreeItem name:projectName.
    pNode contents:aProject.

    pNode add:(commentNode := ProjectTreeItem name:'Comment').
    pNode add:(docNode := ProjectTreeItem name:'Documentation').
    pNode add:(propertiesNode := ProjectTreeItem name:'Properties').
    pNode add:(classesNode := ProjectTreeItem name:'Classes').
    pNode add:(subprojectsNode := ProjectTreeItem name:'SubProjects').
    pNode add:(filesNode := ProjectTreeItem name:'Files').

    aProject subProjects do:[:aSubProject |
        subprojectsNode add:(self nodeFor:aSubProject)
    ].

    commentNode action:[:item | self showCommentOf:item].
    docNode contents:nil.
    propertiesNode contents:nil.
    classesNode contents:nil.
    subprojectsNode contents:nil.
    filesNode contents:nil.

    ^ pNode
!

projectTree
    |tree root|

    tree := SelectionInTree new.
    tree root:(root := TreeItem name:'invisibleRoot').

    Project knownProjects do:[:aProject |
        root add:(self nodeFor:aProject).
    ].

    ^ root
!

updateRightCanvas
    |selectedNode nodeContents|

    selectedNode := self selectedTreeNode value.
    selectedNode isNil ifTrue:[
        self setupCanvasForNoSelection.
        ^ self
    ].
    nodeContents := selectedNode contents.
    (nodeContents isMemberOf:Project) ifTrue:[
        self currentCanvasHolder value:(self class emptyRightCanvasSpec).
        self rightCanvasTextHolder value:nodeContents comment.
        ^ self.
    ].

    self currentCanvasHolder value:(self class emptyRightCanvasSpec).
    self rightCanvasTextHolder value:''.

! !

!ProjectBrowser methodsFor:'user actions'!

itemSelected:index
    |item action|

    self updateRightCanvas.

    item := self projectTreeHolder value at:index.
    action := item action.
    action notNil ifTrue:[
        action value:item.
    ].
!

showCommentOf:anItem
    |project|

    project := anItem parent contents.

    self currentCanvasHolder value:(self class emptyRightCanvasSpec).
    self rightCanvasTextHolder value:project comment.

!

showTreeItem:anItem
    anItem contents == #comment ifTrue:[
        self showCommentOf:anItem.
        ^ self
    ].
! !

!ProjectBrowser::ProjectTreeItem methodsFor:'accessing'!

action
    "return the value of the instance variable 'action' (automatically generated)"

    ^ action!

action:something
    "set the value of the instance variable 'action' (automatically generated)"

    action := something.! !

!ProjectBrowser class methodsFor:'documentation'!

version
    ^ '$Header$'
! !