"
 COPYRIGHT (c) 1995 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.
"



ApplicationModel subclass:#UIHelpTool
	instanceVariableNames:'isModified specClass dictionary dictionaries listSelection
		maxCharsPerLine modifiedHolder'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-UIPainter'
!

!UIHelpTool class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 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
"
    used by the UIPainter to add help text to any component which will be shown
    during runing an application with enabled activeHelp mode.

    [author:]
        Claus Atzkern
"
! !

!UIHelpTool class methodsFor:'instance creation'!

openOnClass:aClass
    "
     UIHelpTool openOnClass:UIPainter
    "
    |helpTool|

    helpTool := UIHelpTool open.
    helpTool helpSpecFrom:aClass.
    helpTool dictionary: aClass helpSpec.

! !

!UIHelpTool class methodsFor:'constants'!

label

    ^'Help'
! !

!UIHelpTool class methodsFor:'help specs'!

helpSpec
    "return a dictionary filled with helpKey -> helptext associations.
     These are used by the activeHelp tool."

    "
    UIHelpTool openOnClass:UIHelpTool    
    "

  ^ super helpSpec addPairsFrom:#(

#addHelpTextKey
'Adds help text key.'

#currentHelpTexts
'Selected help text key.'

#deleteHelpTextKey
'Deletes the help text from the help spec.'

#helpTextView
'Shows the help text.'

#listOfHelpSpecClasses
'List of the classes where help specs can be/are implemented.'

#listOfHelpTexts
'List of the help text keys.'

#removeHelpTextKey
'Removes the help text key from the widget.'

)
! !

!UIHelpTool class methodsFor:'interface specs'!

windowSpec
    "this window spec was automatically generated by the ST/X UIPainter"

    "do not manually edit this - the painter/builder may not be able to
     handle the specification if its corrupted."

    "
     UIPainter new openOnClass:UIHelpTool andSelector:#windowSpec
     UIHelpTool new openInterface:#windowSpec
    "
    "UIHelpTool open"

    <resource: #canvas>

    ^
     
       #(#FullSpec
          #window: 
           #(#WindowSpec
              #name: 'HelpTool'
              #layout: #(#LayoutFrame 59 0 376 0 344 0 646 0)
              #label: 'unnamed canvas'
              #min: #(#Point 10 10)
              #max: #(#Point 1160 870)
              #bounds: #(#Rectangle 59 376 345 647)
              #usePreferredExtent: false
          )
          #component: 
           #(#SpecCollection
              #collection: 
               #(
                 #(#SequenceViewSpec
                    #name: 'listOfHelpKeysView'
                    #layout: #(#LayoutFrame 3 0 2 0 -1 0.5 -1 0.5)
                    #activeHelpKey: #listOfHelpTexts
                    #tabable: true
                    #model: #listModel
                    #hasHorizontalScrollBar: true
                    #hasVerticalScrollBar: true
                    #useIndex: false
                    #sequenceList: #listChannel
                )
                 #(#HorizontalPanelViewSpec
                    #name: 'HorizontalPanelView'
                    #layout: #(#LayoutFrame 1 0.5 2 0 -3 1 26 0)
                    #component: 
                     #(#SpecCollection
                        #collection: 
                         #(
                           #(#ActionButtonSpec
                              #name: 'AddButton'
                              #activeHelpKey: #addHelpTextKey
                              #label: 'Add'
                              #model: #accept
                              #extent: #(#Point 44 24)
                          )
                           #(#ActionButtonSpec
                              #name: 'RemoveButton'
                              #activeHelpKey: #removeHelpTextKey
                              #label: 'Remove'
                              #model: #remove
                              #extent: #(#Point 44 24)
                          )
                           #(#ActionButtonSpec
                              #name: 'DeleteButton'
                              #activeHelpKey: #deleteHelpTextKey
                              #label: 'Delete'
                              #model: #delete
                              #extent: #(#Point 45 24)
                          )
                        )
                    )
                    #horizontalLayout: #fit
                    #verticalLayout: #fit
                    #horizontalSpace: 3
                    #verticalSpace: 3
                )
                 #(#InputFieldSpec
                    #name: 'helpKeyInputField'
                    #layout: #(#LayoutFrame 1 0.5 29 0 -3 1 51 0)
                    #activeHelpKey: #currentHelpTexts
                    #model: #listModel
                )
                 #(#SequenceViewSpec
                    #name: 'listOfHelpSpecClassesView'
                    #layout: #(#LayoutFrame 1 0.5 53 0 -3 1 -1 0.5)
                    #activeHelpKey: #listOfHelpSpecClasses
                    #model: #selectionOfHelpSpecClass
                    #hasHorizontalScrollBar: true
                    #hasVerticalScrollBar: true
                    #valueChangeSelector: #helpSpecClassSelected
                    #useIndex: false
                    #sequenceList: #listOfHelpSpecClasses
                )
                 #(#TextEditorSpec
                    #name: 'helpTextView'
                    #layout: #(#LayoutFrame 3 0.0 1 0.5 -1 1.0 -3 1.0)
                    #activeHelpKey: #helpTextView
                    #hasHorizontalScrollBar: true
                    #hasVerticalScrollBar: true
                    #miniScrollerHorizontal: true
                    #miniScrollerVertical: true
                )
              )
          )
      )
!

windowSpecForStandAlone
    "this window spec was automatically generated by the ST/X UIPainter"

    "do not manually edit this - the painter/builder may not be able to
     handle the specification if its corrupted."

    "
     UIPainter new openOnClass:UIHelpTool andSelector:#windowSpecForStandAlone
     UIHelpTool new openInterface:#windowSpecForStandAlone
    "

    <resource: #canvas>

    ^
     
       #(#FullSpec
          #window: 
           #(#WindowSpec
              #name: 'Help Tool'
              #layout: #(#LayoutFrame 195 0 352 0 694 0 751 0)
              #label: 'Help Tool'
              #min: #(#Point 10 10)
              #max: #(#Point 1160 870)
              #bounds: #(#Rectangle 195 352 695 752)
              #menu: #menu
              #usePreferredExtent: false
          )
          #component: 
           #(#SpecCollection
              #collection: 
               #(
                 #(#UISubSpecification
                    #name: 'UISubSpecification1'
                    #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
                    #minorKey: #windowSpec
                )
              )
          )
      )
! !

!UIHelpTool class methodsFor:'menu specs'!

menu
    "this window spec was automatically generated by the ST/X MenuEditor"

    "do not manually edit this - the builder may not be able to
     handle the specification if its corrupted."

    "
     MenuEditor new openOnClass:UIHelpTool andSelector:#menu
     (Menu new fromLiteralArrayEncoding:(UIHelpTool menu)) startUp
    "

    <resource: #menu>

    ^
     
       #(#Menu
          
           #(
             #(#MenuItem
                #label: 'File'
                #submenu: 
                 #(#Menu
                    
                     #(
                       #(#MenuItem
                          #label: 'Reload'
                          #value: #doReload
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Save'
                          #value: #doInstallHelpSpec
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Define Class...'
                          #value: #doFromClass
                      )
                       #(#MenuItem
                          #label: '-'
                      )
                       #(#MenuItem
                          #label: 'Exit'
                          #value: #closeRequest
                      )
                    ) nil
                    nil
                )
            )
          ) nil
          nil
      )
! !

!UIHelpTool methodsFor:'accessing'!

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

    ^ dictionary!

dictionary:aDictionary
    "set the value of the instance variable 'dictionary' (automatically generated)"

    (dictionary := aDictionary) isNil ifTrue:[
        dictionary := IdentityDictionary new.
    ].
    self updateList
!

helpKey
    listSelection size ~~ 0 ifTrue:[
        ^ listSelection asSymbol
    ].
    ^ nil
!

helpKey:aKey
    |key|

    aKey size ~~ 0 ifTrue:[
        key := aKey asString
    ].
    self listModel value:key

!

helpSpecFrom:aClass
    "read help text from an application associated with the class
    "
    |help|

    isModified := false.
    dictionary   := IdentityDictionary new.
    dictionaries := IdentityDictionary new.
    specClass  := self applicationClassAssociatedWith:aClass.
    specClass isClass 
    ifTrue: 
    [
        self listOfHelpSpecClasses contents: (specClass withAllSuperclasses reverse collect: [:cls| cls name]).
        self listOfHelpSpecClasses removeAll: (ApplicationModel withAllSuperclasses collect: [:cls| cls name]).
        self selectionOfHelpSpecClass value: specClass name. 
        (builder componentAt: #listOfHelpSpecClassesView) selection: 
                (self listOfHelpSpecClasses value indexOf: specClass name).
        self helpSpecClassSelected.
    ].
    (specClass respondsTo:#helpSpec) ifTrue:[
        help := specClass helpSpec
    ] ifFalse:[
        specClass := nil
    ].
    self updateList
!

modifiedHolder:aValueHolder
    "set the value holder set to true in case of modifying attributes
    "
    modifiedHolder notNil ifTrue:[
        modifiedHolder removeDependent:self. 
    ].

    (modifiedHolder := aValueHolder) notNil ifTrue:[
        modifiedHolder addDependent:self.

        self editTextView notNil ifTrue: [
            self editTextView modifiedChannel onChangeSend:#value to:[
                modifiedHolder notNil ifTrue:[
                    self editTextView modifiedChannel value ifTrue:[
                        modifiedHolder value:true
                    ]
                ]
            ]
        ]
    ]


! !

!UIHelpTool methodsFor:'actions'!

accept
    "accept the text
    "
    |view key txt list listChgd|   

    (listSelection size == 0 or:[(view := self editTextView) isNil]) ifFalse:[
        txt    := view contents asString.
        key    := listSelection asSymbol.
        list   := self listChannel value.

        (listChgd := (dictionary at:key ifAbsent:nil) isNil) ifTrue:[
            list add:key.
        ].          
        dictionary at:key put:txt.

        listChgd ifTrue:[
            self updateList.
            (builder componentAt: #listOfHelpKeysView) selection: (list indexOf: key).
        ]. 

        isModified := true.
        modifiedHolder notNil ifTrue: [modifiedHolder value:true]
    ]
!

delete
    "delete selected help key
    "
    listSelection notNil
    ifTrue:
    [
        dictionary removeKey: listSelection asSymbol ifAbsent: nil.
        self remove.

        self updateList.

        isModified := true.
        modifiedHolder notNil ifTrue: [modifiedHolder value:true]
    ]
!

helpSpecClassSelected

    |clsName|
    clsName := self selectionOfHelpSpecClass value.
    (dictionary := dictionaries at: clsName ifAbsent: nil) isNil
    ifTrue:
    [        
        dictionary := dictionaries at: clsName put: (self extractHelpSpecForClass: (Smalltalk at: clsName))
    ].

    self updateList.
    listSelection notNil
        ifTrue: [(dictionary keys includes: listSelection asSymbol)
        ifTrue: [(builder componentAt: #listOfHelpKeysView) selection: 
        (self listChannel value indexOf: (builder componentAt: #helpKeyInputField) contents)]
        ifFalse: [(builder componentAt: #listOfHelpKeysView) selection: nil]].
    self editTextView contents: ''
!

installHelpSpecInto:aClass
    "install help text
    "
    |cls src superHelpSpecKeys helpSpec mayRemoveHelpSpecSelector|

    cls := self applicationClassAssociatedWith:aClass.

    cls isNil ifTrue:[
        ^ self information:'No application class defined!!'.
    ].

    aClass == cls name 
        ifTrue: [cls allSuperclasses value do: [:c| self installHelpSpecInto:c]. isModified := true].

    isModified not ifTrue:[
        ^nil
    ].

    (cls superclass respondsTo: #helpSpec) 
        ifTrue:  [superHelpSpecKeys := cls superclass helpSpec keys. mayRemoveHelpSpecSelector := true]
        ifFalse: [superHelpSpecKeys := IdentityDictionary new. mayRemoveHelpSpecSelector := false].

    helpSpec := dictionaries at: cls name ifAbsent: [^nil].
    helpSpec isEmpty ifTrue:[
        mayRemoveHelpSpecSelector ifTrue: [cls class removeSelector: #helpSpec].
        ^nil
    ].

    src  := '' writeStream.

    src nextPutAll:

'helpSpec
    "return a dictionary filled with helpKey -> helptext associations.
     These are used by the activeHelp tool."

    "
    UIHelpTool openOnClass:', cls name asString ,'    
    "

  ^ super helpSpec addPairsFrom:#(

'.

    helpSpec keys asSortedCollection
    do:[:key |
        |txt t|

        txt := helpSpec at:key.
        src nextPutLine:key storeString.

        t := txt asString replaceAll:(Character cr) with:(Character space).

        (t endsWith:Character space) ifTrue:[
            t := t copyWithoutLast:1
        ].
        src nextPutLine:t storeString; cr.
    ].
    src nextPutLine:')'.

    Compiler compile:(src contents)
            forClass:cls class 
          inCategory:'help specs'.

    isModified := false.

!

remove
    "remove selected help key
    "

    self listModel value: nil.

    self updateList.

    modifiedHolder notNil ifTrue: [modifiedHolder value:true]
! !

!UIHelpTool methodsFor:'aspects'!

listChannel

    |holder|

    (holder := builder bindingAt:#listChannel) isNil ifTrue:[
        builder aspectAt:#listChannel put:(holder :=  OrderedCollection new asValue).
    ].
    ^ holder
!

listModel

    |holder|

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

listOfHelpSpecClasses

    |holder|
    (holder := builder bindingAt:#listOfHelpSpecClasses) isNil ifTrue:[
        builder aspectAt:#listOfHelpSpecClasses put: (holder := List new)
    ].
    ^ holder

!

selectionOfHelpSpecClass

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

! !

!UIHelpTool methodsFor:'initialization'!

initialize
    "setup instance attributes
    "
    super initialize.
    dictionary   := IdentityDictionary new.
    dictionaries := IdentityDictionary new.
    isModified := false.

! !

!UIHelpTool methodsFor:'private'!

editTextView
    "get the editTextView or nil.
    "
    |view|

    (view := builder componentAt:#helpTextView) notNil ifTrue:[
        view := view scrolledView.

        view acceptAction isNil ifTrue:[
            view acceptAction:[:aList| self accept ].
        ].

        view left ~~ 0 ifTrue:[
            (maxCharsPerLine := view extent x // view font width) < 10 ifTrue:[
                maxCharsPerLine := nil
            ]
        ].
    ].       
    ^ view
!

extractHelpSpecForClass: aClass

    |helpSpecSuperClass superHelpSpecKeys helpSpec|

    ((aClass class implements: #helpSpec)
    and: [(helpSpecSuperClass := aClass allSuperclasses detect: [:cls| cls class implements: #helpSpec] ifNone: nil) notNil])
    ifTrue:
    [                  
        superHelpSpecKeys := helpSpecSuperClass helpSpec keys.
        helpSpec := IdentityDictionary new.
        aClass helpSpec associationsDo:
        [:asso|
            (superHelpSpecKeys includes: asso key) ifFalse: [helpSpec at: asso key put: asso value]
        ].          
        ^dictionary := helpSpec
    ].
    ^dictionary := IdentityDictionary new 
!

findHelpSpecForKey: aHelpKey
    "update list from dictionary
    "
    |helpSpecClass superHelpSpecKeys helpSpec|

    aHelpKey isNil ifTrue: [^nil].

    self listOfHelpSpecClasses value do:
    [:clsName|            
        (dictionary := dictionaries at: clsName ifAbsent: nil) isNil
        ifTrue:
        [        
            dictionary := dictionaries at: clsName put: (self extractHelpSpecForClass: (Smalltalk at: clsName))
        ].
        (dictionary includesKey: aHelpKey asSymbol)  
        ifTrue:
        [            
            self updateList.
            ^(builder componentAt: #listOfHelpSpecClassesView) selection: 
                (self listOfHelpSpecClasses value indexOf: clsName).
        ]
    ].


!

updateList
    "update list from dictionary
    "
    self listChannel value: dictionary keys asSortedCollection
! !

!UIHelpTool methodsFor:'queries'!

applicationClassAssociatedWith:aClass
    "get application class keeping the associated help text or nil
    "
    |cls|

    cls := self resolveName:aClass.

    (cls notNil and:[cls includesBehavior:UISpecification]) ifTrue:[
        ^ UISpecificationTool
    ].
  ^ cls


!

isModified
    ^ isModified
! !

!UIHelpTool methodsFor:'selection'!

listSelection
    "returns current selection
    "
    ^ listSelection
!

listSelection:aSelection
    "current selection changed
    "
    |txt view sel|

    aSelection isNil ifTrue: [(builder componentAt: #listOfHelpKeysView) selection: nil].
    self findHelpSpecForKey: aSelection.

    aSelection isNumber ifTrue:[
        aSelection ~~ 0 ifTrue:[
            sel := self listChannel value at:aSelection
        ]
    ] ifFalse:[
        aSelection size ~~ 0 ifTrue:[
            sel := aSelection withoutSeparators.
            sel size == 0 ifTrue:[
                sel := nil
            ]
        ]
    ].

    listSelection = sel ifFalse:[
        listSelection := sel.

        modifiedHolder notNil ifTrue:[
            modifiedHolder value:true.
        ].

        (view := self editTextView) notNil ifTrue:[
            listSelection notNil ifTrue:[
                txt := dictionary at:(listSelection asSymbol) ifAbsent:nil.

                (txt isNil or:[maxCharsPerLine isNil]) ifFalse:[
                    txt := UIPainter convertString:(txt asString) maxLineSize:maxCharsPerLine skipLineFeed:false.
                ]
            ]. 
            view contents:txt.
            view modified:false.
        ]
    ]

! !

!UIHelpTool methodsFor:'startup / release'!

closeRequest

    (isModified and:[self masterApplication isNil]) ifTrue:[
        (self confirm:'Exit without saving your modifications?') ifFalse:[
            ^ self
        ]
    ].
    ^ super closeRequest.
!

openInterface:aSymbol
    "open interface
    "
    super openInterface: #windowSpecForStandAlone
! !

!UIHelpTool methodsFor:'user interactions'!

doFromClass
    "setup new specification from a class accessed through to a dialog
    "
    |cls accepted|

    specClass notNil ifTrue:[cls := specClass name asValue]
                    ifFalse:[cls := '' asValue].

    [true] whileTrue:[
        accepted :=
            (DialogBox new
                addTextLabel:'Class name:';
                addInputFieldOn:cls; 
                addAbortButton; 
                addOkButton; 
                open
            ) accepted.

        accepted ifFalse:[^ self].
        cls := self applicationClassAssociatedWith:cls value.

        cls notNil ifTrue:[
            ^ self helpSpecFrom:cls
        ].
        self warn:'No such class!!'.
    ]
!

doInstallHelpSpec
    "install help spec
    "
    self installHelpSpecInto:specClass
!

doReload
    "reload specification
    "
    |oldSel model|

    model  := self listModel.
    oldSel := model value.
    model value:nil.
    self helpSpecFrom:specClass.
    model value:oldSel.
    isModified := false.

! !

!UIHelpTool class methodsFor:'documentation'!

version
    ^ '$Header$'
! !