ResourceSpecEditor.st
author Claus Gittinger <cg@exept.de>
Sun, 29 Jan 2017 02:26:51 +0100
changeset 3853 5a78ffcf69de
parent 3823 544c7521c6d2
child 3876 500a45596c1c
permissions -rw-r--r--
#FEATURE by cg class: TypeConverter changed: #timeOfClass:withFormat:orDefault:language:

"
 COPYRIGHT (c) 1997-1998 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:libview2' }"

"{ NameSpace: Smalltalk }"

ToolApplicationModel subclass:#ResourceSpecEditor
	instanceVariableNames:'specClass specClassName specSelector aspects modified hasSaved
		tabSelection isEmbeddedInBrowser'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Framework'
!

!ResourceSpecEditor class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997-1998 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.
"




!

documentation
"
    Abstract super class for the MenuEditor, HierarchicalListEditor, 
    and the TabListEditor.
    It provides common behavior for initializing, loading, saving, and
    asking for modifications of the resource specs (#menu, #hierarchicalList, 
    #tabList) for the concrete subclasses.

    [instance variables:]
        specClass       <Symbol>                class implementing the resource spec
        specSelector    <Symbol>                selector returning the resource spec
        aspects         <IdentityDictionary>    dictionary with the attributes of the resource spec
        modified        <Boolean>               flag whether the resource spec was modified
        hasSaved        <Boolean>               flag whether the resource spec was saved
        tabSelection    <Integer>               index of the tab selection

    [see also:]
        MenuEditor
        HierarchicalListEditor
        TabListEditor

    [author:]
         Thomas Zwick, eXept Software AG
"
! !

!ResourceSpecEditor class methodsFor:'instance creation'!

openModalOnClass:aClass andSelector:aSelector
    "opens modal the Resource Spec Editor on aClass and aSelector"

    ^self new openModalOnClass:aClass andSelector:aSelector

!

openOnClass:aClass andSelector:aSelector
    "opens the Resource Spec Editor on aClass and aSelector"

    ^ self new openOnClass:aClass andSelector:aSelector
! !

!ResourceSpecEditor class methodsFor:'accessing'!

codeGenerationComment
    "returns a comment for the method code generated by myself"

    ^self codeGenerationCommentForClass: self




!

codeGenerationCommentForClass: generatingClass
    "returns a comment for the method code generated by generatingClass"

    |generatingClassName|

    generatingClassName := generatingClass name.

    ^'    "This resource specification was automatically generated\',
     '     by the ', generatingClassName, ' of ST/X."\\',

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

resourceType
    "returns the type of resource of the method generated by the Resource Spec Editor;
     concrete subclasses has to reimplement this method"

    ^self subclassResponsibility
! !

!ResourceSpecEditor class methodsFor:'aspects'!

aspects
    "returns the aspects for the attributes of the resource spec components;
     concrete subclasses might reimplement this method in order to return an array"

    ^#()
! !

!ResourceSpecEditor class methodsFor:'help spec'!

helpSpec
    "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:ToolApplicationModel
    "

    <resource: #help>

    ^ super helpSpec addPairsFrom:#(
#fileShowStoreString
'Show the Smalltalk storeString (to be pasted into code)'

)
! !

!ResourceSpecEditor class methodsFor:'queries'!

isVisualStartable
    "return true, if this application can be started via #open.
     (to allow start of a change browser via double-click in the browser)"

    self == ResourceSpecEditor ifTrue:[^false].
    ^super isVisualStartable
!

resourcePackage
    ^ #'stx:libtool2'
! !

!ResourceSpecEditor class methodsFor:'startup & release'!

preSnapshot
    "before a snapshot; updates the channels,
     because the clipboard has removed"

    super preSnapshot.

    instances notNil ifTrue:[
        instances do:[:inst |
            inst updateChannels. 
            inst enablingCommitButtonsHolder value: false.
            inst modifiedChannel value: false. 
        ]
    ]

    "Modified: / 4.2.1999 / 15:32:17 / cg"
! !

!ResourceSpecEditor methodsFor:'accessing'!

alternativeSpecSelectors
    "returns an alternative method selector of the resource spec"

    ^ nil
!

clearModified       
    self modified:false
!

isEmbeddedInBrowser
    ^ isEmbeddedInBrowser ? false
!

isEmbeddedInBrowser:something
    isEmbeddedInBrowser := something.
!

modified       
    "returns whether the resource spec was modified"

    ^ modified
!

modified: aBoolean         
    "sets the resource spec modified as aBoolean"

    modified := aBoolean
!

setModified       
    self modified:true
!

specClass
    "return the class where the resource spec is implemented"

    ^ specClass
!

specClass:aClassOrClassName
    "sets the class (or name) where the resource spec is (or should be) implemented"

    aClassOrClassName isBehavior 
        ifTrue: [ specClass := aClassOrClassName ]
        ifFalse:[ specClass := Smalltalk classNamed:aClassOrClassName ].

    "Modified: / 14-01-2008 / 17:38:54 / cg"
!

specClassName
    "return the classes name where the resource spec is implemented"

    ^ specClass name
!

specSelector
    "returns the method selector of the resource spec"

    ^specSelector

!

specSelector:aSelector
    "sets the method selector of the resource spec.
     That is the spec method being edited (i.e. #helpSpec, #windowSpec, #menuSpec, etc.)"

    specSelector := aSelector
! !

!ResourceSpecEditor methodsFor:'aspects'!

aspectAt:aKey put:aValueHolder
    aspects at: aKey put:aValueHolder
!

aspectFor:aKey
    "returns the aspect for a aKey or nil"

    ^ aspects at: aKey ifAbsent: [super aspectFor:aKey]
!

autoAcceptOnSelectionChange
    ^ builder valueAspectFor:#autoAcceptOnSelectionChange initialValue:true
!

canPasteHolder
    "returns whether the application can paste; as value holder"

    |holder|

    holder := super canPasteHolder.
    holder value:(self class clipboard notNil).
    ^ holder
!

enableMovingInAboveHolder
    "returns whether the selected item can move into the previous item as child;
     as a value holder"

    ^builder booleanValueAspectFor: #valueOfEnableMovingInAbove
!

enableMovingInHolder
    "returns whether the selected item can move into next item as child; as value holder"

    ^builder booleanValueAspectFor: #valueOfEnableMovingIn
!

enableMovingOutHolder
    "returns whether the selected item can move out from its parent item; as value holder"

    ^builder booleanValueAspectFor: #valueOfEnableMovingOut
!

enableMovingUpOrDownHolder
    "returns whether the selected item can move up or down; as value holder"

    ^builder booleanValueAspectFor: #valueOfEnableMovingUpOrDown
!

tabModel
    "returns the value holder for the tab selection"

    |holder|
    (holder := builder bindingAt:#tabModel) isNil ifTrue:[
        holder := AspectAdaptor new subject:self; forAspect:#tabSelection.
        builder aspectAt:#tabModel put:holder.
    ].
    ^ holder
!

valueOfEnableMovingIn
    <resource: #obsolete>
    "returns whether the selected item can move into next item as child; as value holder"

    self obsoleteMethodWarning:'stupid name - use #enableMovingInHolder'.
    ^ self enableMovingInHolder
!

valueOfEnableMovingInAbove
    <resource: #obsolete>
    "returns whether the selected item can move into the previous item as child;
     as a value holder"

    self obsoleteMethodWarning:'stupid name - use #enableMovingInAboveHolder'.
    ^ self enableMovingInAboveHolder
!

valueOfEnableMovingOut
    <resource: #obsolete>
    "returns whether the selected item can move out from its parent item; as value holder"

    self obsoleteMethodWarning:'stupid name - use #enableMovingOutHolder'.
    ^ self enableMovingOutHolder
!

valueOfEnableMovingUpOrDown
    <resource: #obsolete>
    "returns whether the selected item can move up or down; as value holder"

    self obsoleteMethodWarning:'stupid name - use #enableMovingUpOrDownHolder'.
    ^ self enableMovingUpOrDownHolder
! !

!ResourceSpecEditor methodsFor:'building'!

buildFromClass: aClass andSelector: aSelector
    ^ self loadFromClass: aClass andSelector: aSelector
!

buildFromResourceSpec: aResourceSpec
    "concrete subclass has to reimplement this method
     in order to build its resource spec from aResourceSpec"

    ^ self loadFromResourceSpec:aResourceSpec
!

loadFromClass: aClass andSelector: aSelector
    ^ self subclassResponsibility
!

loadFromResourceSpec: aResourceSpec
    "concrete subclass has to reimplement this method
     in order to build its resource spec from aResourceSpec"

    ^ self subclassResponsibility
! !

!ResourceSpecEditor methodsFor:'change & update'!

update:something with:aParameter from:changedObject
    "one of my aspects has changed; update modified channel for the commit buttons"

    |enableCommitButtonsHolder|

    enableCommitButtonsHolder := self enablingCommitButtonsHolder.

    changedObject ~~ enableCommitButtonsHolder ifTrue:[ 
        enableCommitButtonsHolder value: true 
    ]
!

updateAllToolInstances
    "updates the channels of all other instances of my class"

    self allToolInstances do: [:inst| inst updateChannels]

!

updateChannels
    "updates my channels"

"/    self valueOfCanPaste
! !

!ResourceSpecEditor methodsFor:'help'!

defaultInfoLabel
    "returns the default label for the info bar"

    specClass isBehavior ifTrue:[
        (specClass respondsTo:specSelector) ifTrue:[
            ^ specClass name, ' >> ', specSelector
        ].
        specSelector isNil ifTrue:[
            ^ specClass name, ' >> ? (no selector defined)'
        ].
        ^ specClass name, ' >> ', specSelector, ' (not implemented)'
    ].
    ^ 'No class and selector defined.'
! !

!ResourceSpecEditor methodsFor:'initialization'!

initialize
    "initialize the flags and the aspects"

    super initialize.

    hasSaved     := modified := false.
    aspects      := IdentityDictionary new.
    tabSelection := 0.

    self class aspects do:[:aKey|
        |holder|
        aspects at:aKey put: (holder := ValueHolder new).
        holder addDependent: self
    ]

    "Modified: / 25-10-2010 / 10:31:32 / cg"
! !

!ResourceSpecEditor methodsFor:'private'!

askForItemModification
    "asks for resource item modification"

    |anythingChangedHolder anythingChanged answer|

    anythingChangedHolder := self enablingCommitButtonsHolder.
    anythingChanged := anythingChangedHolder value.
    anythingChanged ifFalse:[^ true].

    self autoAcceptOnSelectionChange value ifTrue:[
        self accept.
        ^ true
    ].

    answer := Dialog 
                    confirmWithCancel:(resources string:'Item was modified !!\Save it ?\' withCRs)
                    labels:(resources array:#('Cancel' 'No' 'Yes'))
                    default:3.
    answer isNil ifTrue:[
        ^ false
    ].

    answer ifTrue:[
        self accept
    ] ifFalse:[
        anythingChangedHolder value: false. 
        self clearModifiedFlag. 
        self clearModified.
    ].
    ^ true

    "Modified: / 05-09-2006 / 18:41:11 / cg"
!

askForListModification
    "asks for resource modification"

    self modified ifTrue:
    [
        ((YesNoBox title:(resources string:'Modified %1 spec was not saved. Proceed?' with:self class resourceType asUppercaseFirst))        
            noText:(resources string:'Cancel');
            yesText:(resources string:'Discard Changes and Proceed');
            showAtPointer;
            accepted) ifFalse: [^ false].
        self clearModified
    ].
    ^ true

    "Modified: / 17-10-2006 / 17:43:53 / cg"
!

askForModification
    "asks first for item and then for resource modification"

    ^self askForItemModification and: [self askForListModification]

!

extractClassAndSelectorFrom:aString
    "extracts class and selector from a resource string. On success
     an association with the key a class and the selector as value
     is returned. Otherwise nil is returned
    "
    |words newClass newSel|

    aString size ~~ 0 ifTrue:[
        words := aString asCollectionOfWords.

        words size == 2 ifTrue:[
            newClass := self resolveName:(words first).

            (newClass isClass and:[newClass isLoaded]) ifTrue:[
                newSel := words last asSymbol.

                (newClass class includesSelector:newSel) ifTrue:[
                    ^ Association key:newClass value:newSel            
                ].
            ].
        ].
    ].
    ^ nil
!

updateHistory
    "updates the history, if there was loaded a resource spec"

    specClass notNil ifTrue:[
        self addHistoryEntryForClass:specClass selector:specSelector
    ]
!

xxresourceMessage:aString
    "extracts the specClass and the specSelector from aString "

    |msg cls|

    (aString notNil and:[self askForModification]) ifTrue:[            
        msg := aString asCollectionOfWords.
        (msg size == 2 
        and: [ (cls := self resolveName:(msg at:1)) notNil ])
        ifTrue:[
            specClass := cls.
            specSelector := (msg at: 2) asSymbol.
            ^true
        ]
    ].
    ^false
! !

!ResourceSpecEditor methodsFor:'queries'!

hasSaved
    "returns true if the resource spec was saved"

    ^ hasSaved
!

isModified
    ^ self modified
!

isNotStandAlone
    "returns true if the editor was NOT started from or in another tool"

    ^ self masterApplication notNil
!

isStandAlone
    "returns true if the editor was started from or in another tool"

    ^ self masterApplication isNil
! !

!ResourceSpecEditor methodsFor:'selection'!

selectionChangeAllowed:newSelection
    self isModified ifFalse:[^ true].

    self autoAcceptOnSelectionChange value ifTrue:[
        self accept
    ] ifFalse:[
        self askForUnsavedModifications ifFalse:[^ false].
    ].
    ^ true
!

tabSelection
    "returns selected tab index or 0"

    ^tabSelection

! !

!ResourceSpecEditor methodsFor:'startup & release'!

closeRequest
    "asks for permission before closing"

    self askForModification ifTrue: [
        super closeRequest
    ]
!

loadFromMessage:classAndSelector
    "builds by evaluating aString the resource spec for editing"

    |cls sel|

    self askForModification ifFalse:[ ^ false].
    classAndSelector isNil ifTrue:[^ false].

    cls := classAndSelector methodClass.
    sel := classAndSelector methodSelector.
    self isStandAlone 
        ifFalse: [self loadFromResourceSpec: (cls perform: sel).]
        ifTrue:  [self loadFromClass:cls andSelector:sel ].
    ^ true

    "Modified: / 21.5.1998 / 02:56:46 / cg"
!

openModalOnClass:aClass andSelector:aSelector
    "sets the specClass and specSelector and opens modal the interface"

    specClass    := aClass isClass ifTrue: [aClass] ifFalse: [ Smalltalk classNamed:aClass].
    specSelector := aSelector.

    self openInterfaceModal.
!

openModalOnResourceSpec: aListSpec
    "builds first from specClass and specSelector the resource spec for editing,
     then opens modal the interface"

    self allButOpen.
    self loadFromResourceSpec:aListSpec.
    self openWindowModal.
!

openOnClass:aClass andSelector:aSelector
    "sets the specClass and specSelector and opens the interface"

    specClass    := aClass isBehavior ifTrue: [aClass] ifFalse: [ Smalltalk classNamed:aClass].
    specSelector := aSelector.

    self openInterface.
!

postBuildWith:aBuilder
    "after creating the views and before opening,
     adds myself to the instances dictionary in the settings"

    super postBuildWith:aBuilder.

    self class rememberInstance:self

    "Modified: / 4.2.1999 / 15:33:23 / cg"
!

postOpenWith:aBuilder
    "after opening, builds from specClass and specSelector the resource spec for editing"

    super postOpenWith:aBuilder.

    specClass notNil ifTrue:[
        self loadFromClass: specClass andSelector: specSelector 
    ]
!

uninitialize
    "uninitializes; removes myself from the instances dictionary in the settings"

    super uninitialize.

    self class forgetInstance:self

    "Modified: / 4.2.1999 / 15:34:25 / cg"
! !

!ResourceSpecEditor methodsFor:'user actions'!

accept
    "invoked by the OK button; disables the commit buttons and sets myself modified"

    self acceptChannel 
        value:false;    
        value:true;      "/ toggle to force inputFields to accept
        value:false.    

    self enablingCommitButtonsHolder value: false.
    self clearModifiedFlag.
    self setModified
!

doBrowseClass
    "opens a System Browser on the specClass and specSelector"

    specClass notNil 
        ifTrue: [specClass browserClass openInClass:specClass class selector: specSelector] 
        ifFalse:[self information:'No class defined!!']
!

doEditImage
    "opens a Image Editor on the resource retriever and the icon selector"

    |resourceClass resourceSelector classAndSelector retrieverName|

    resourceSelector := (aspects at:#icon) value.
    resourceSelector isEmptyOrNil ifTrue:[ resourceSelector := #icon ].

    retrieverName := (aspects at:#retriever) value.
    retrieverName notEmptyOrNil ifTrue:[
        resourceClass := Smalltalk classNamed:retrieverName
    ] ifFalse:[
        specClass notNil ifTrue:[
            resourceClass := specClass withAllSuperclasses 
                                detect:[:cls| cls class includesSelector: resourceSelector] 
                                ifNone:[specClass]
        ]
    ].

    (classAndSelector := ImageEditor openModalOnClass: resourceClass andSelector: resourceSelector) notNil
    ifTrue: [
        resourceClass := classAndSelector at:1.
        resourceSelector := classAndSelector at:2.
        (aspects at:#retriever) value: resourceClass name.
        (aspects at:#icon) value: resourceSelector. 
        self enablingCommitButtonsHolder value: true
    ]

    "Modified: / 21.5.1998 / 02:44:04 / cg"
!

doLoad
    "opens a Resource Selection Browser in order to get a resource message"

    |myResourceType classAndSelector|

    myResourceType := self class resourceType.

    classAndSelector := ResourceSelectionBrowser
            request: 'Load ', myResourceType asUppercaseFirst, ' Spec From Class'
            onSuperclass: nil
            andClass: specClass
            andSelector: specSelector ? myResourceType
            withResourceTypes: (Array with: myResourceType).

    classAndSelector isNil ifTrue:[ ^ self ].
    ^ self loadFromClass:(classAndSelector methodClass) andSelector:(classAndSelector methodSelector) 
!

doNew
    "first ask for modification; then clean specClass and specSelector,
     but only, if the editor is opened as stand alone;
     finally make a build of a resource spec containing no items"

    self askForModification ifTrue:[
        self isStandAlone ifTrue: [specClass := specSelector := nil].
        self loadFromClass:nil andSelector:(self class resourceType).
        ^ true
    ].
    ^ false
!

doSave
    "before saving ask for modification; if no specClass and specSelector
     is defined, do save as"

    self askForItemModification.

    (specClass isNil or:[specSelector isNil]) ifTrue:[
        self doSaveAs.
        ^ false
    ].
    ^ true
!

doSaveAs
    "first ask for modification; 
     then open a ResourceSelectionBrowser; 
     after that extract the resource message;
     finally do save and make a new build"

    |masterApplication resourceMessage myResourceType|  

    masterApplication := self masterApplication.
    masterApplication notNil ifTrue:[
        masterApplication isEditingSpecOnly ifTrue:[
            "/ there is no class to store into  
            ^ true            
        ].
    ].

    self askForItemModification.

    myResourceType := self class resourceType.

    resourceMessage := ResourceSelectionBrowser
            request: 'Save ', myResourceType asUppercaseFirst, ' Spec In Class'
            onSuperclass: #Object
            andClass: specClass name
            andSelector: specSelector ? myResourceType
            withResourceTypes: (Array with: myResourceType).

    resourceMessage isNil ifTrue:[ ^ false ].

    self clearModified.
    specClass := resourceMessage methodClass.
    specSelector := resourceMessage methodSelector.
    self doSave.
    self loadFromClass: specClass andSelector: specSelector.
    ^ true

    "Modified: / 21.5.1998 / 02:59:46 / cg"
! !

!ResourceSpecEditor class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !