UIHelpTool.st
author Claus Gittinger <cg@exept.de>
Mon, 28 Jul 1997 10:33:58 +0200
changeset 242 3d2caf5bf279
parent 204 8dcd7f22e4d1
child 261 deaa4815065c
permissions -rw-r--r--
*** empty log message ***

"
 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:'dictionary list model'
	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:'help specs'!

helpSpec
    "return a dictionary filled with helpKey -> helptext associations.
     These are used by the activeHelp tool.
    "
  ^ super helpSpec addPairsFrom:#(

#activeHelpAccessKey
'This ID is used to access an active
help text for the selected component'

)

! !

!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:' 'uIPainterView'
              #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
              #'label:' 'unnamed canvas'
              #'bounds:' #(#Rectangle 0 0 286 272)
          )
          #'component:' 
           #(#SpecCollection
              #'collection:' 
               #(
                 #(#TextEditorSpec
                    #'name:' 'textView'
                    #'layout:' #(#LayoutFrame 46 0 25 0.0 0 1.0 0 1.0)
                    #'model:' #textChannel
                    #'hasHorizontalScrollBar:' true
                    #'hasVerticalScrollBar:' true
                    #'miniScrollerHorizontal:' true
                    #'miniScrollerVertical:' true
                )
                 #(#LabelSpec
                    #'name:' 'keyLabel'
                    #'layout:' #(#LayoutFrame 0 0.0 1 0.0 41 0 21 0)
                    #'label:' 'Key:'
                    #'adjust:' #left
                    #'resizeForLabel:' false
                )
                 #(#ComboBoxSpec
                    #'name:' 'comboBox'
                    #'layout:' #(#LayoutFrame 46 0 1 0 0 1.0 21 0)
                    #'activeHelpKey:' #activeHelpAccessKey
                    #'tabable:' true
                    #'comboList:' #listChannel
                )
                 #(#LabelSpec
                    #'name:' 'textLabel'
                    #'layout:' #(#LayoutFrame 0 0.0 25 0.0 41 0 45 0)
                    #'label:' 'Text:'
                    #'adjust:' #left
                    #'resizeForLabel:' false
                )
              )
          )
      )
! !

!UIHelpTool class methodsFor:'misc'!

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

    aClass notNil ifTrue:[
        aClass isBehavior ifFalse:[cls := Smalltalk at:aClass asSymbol]
                           ifTrue:[cls := aClass].

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

! !

!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) notNil ifTrue:[
        list := dictionary keys asOrderedCollection
    ] ifFalse:[
        dictionary := IdentityDictionary new.
        list := nil
    ].
!

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

    cls := self class applicationClassAssociatedWith:aClass.

    (cls respondsTo:#helpSpec) ifTrue:[
        help := cls helpSpec
    ].
    self dictionary:help
!

key
    "get the key from the edit field as symbol or nil
    "
    |key|

    key := model value.

    (     key size ~~ 0
     and:[(key indexOfSeparatorStartingAt:1) == 0
      or:[(key := key withoutSeparators) notEmpty]]
    ) ifTrue:[
        ^ key asSymbol
    ].
  ^ nil
!

model:aKeyHolder
    "set the model on the edit field
    "
    model notNil ifTrue:[
        model removeDependent:self
    ].
    (model := aKeyHolder) notNil ifTrue:[
        model addDependent:self
    ].
    (builder componentAt:#comboBox) model:model.
    self update:nil with:#model from:model.
! !

!UIHelpTool methodsFor:'actions'!

accept
    "accept the text
    "
    |key txt|

    key := self key.
    txt := self textChannel.

    key notNil ifTrue:[
        txt dependentsDo:[:edt| edt accept].

        (dictionary at:key ifAbsent:nil) isNil ifTrue:[
            list add:key.
            self listChannel value:list
        ].
        dictionary at:key put:(txt value)
    ] ifFalse:[
        key := nil.
        txt value:nil.
    ].

    model notNil ifTrue:[
        model value:key
    ]
!

installHelpSpecInto:aClass
    "install help text
    "
    |cls src|

    cls := self class applicationClassAssociatedWith:aClass.

    cls isNil ifTrue:[
        ^ self information:'no application class defined'.
    ].
    dictionary isEmpty ifTrue:[
        ^ self information:'no help text defined'
    ].
    src  := '' writeStream.

    src nextPutAll:

'helpSpec
    "return a dictionary filled with helpKey -> helptext associations.
     These are used by the activeHelp tool.
    "
  ^ super helpSpec addPairsFrom:#(

'.

    dictionary keysAndValuesDo:[:key :txt|
        |t|
        src nextPutLine:key storeString.

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

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

! !

!UIHelpTool methodsFor:'aspects'!

listChannel
    "automatically generated by UIPainter ..."

    |holder|

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

textChannel
    "automatically generated by UIPainter ..."

    |holder|

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

!UIHelpTool methodsFor:'change & update'!

update:something with:aParameter from:someObject
    "model might change
    "
    |text key|

    (key := self key) notNil ifTrue:[
        (text := dictionary at:key ifAbsent:nil) notNil ifTrue:[
            self textChannel value:text
        ]
    ]
! !

!UIHelpTool methodsFor:'initialization'!

initialize
    "setup instance attributes
    "
    super initialize.
    dictionary  := IdentityDictionary new.
    list        := OrderedCollection new.
! !

!UIHelpTool class methodsFor:'documentation'!

version
    ^ '$Header$'
! !