UIHelpTool.st
changeset 1973 58e2df779faa
parent 1777 fbf082828db6
child 1982 a60283327f16
equal deleted inserted replaced
1972:c1b9c7d9e8f4 1973:58e2df779faa
    85 
    85 
    86 openOnClass:aClass
    86 openOnClass:aClass
    87     "opens a Help Tool on aClass
    87     "opens a Help Tool on aClass
    88     "
    88     "
    89     ^ self openOnClass:aClass andSelector:#helpSpec
    89     ^ self openOnClass:aClass andSelector:#helpSpec
    90 !
       
    91 
       
    92 openOnClass:aClass andSelector: aSelector
       
    93     "opens a Help Tool on aClass and aSelector
       
    94     "
       
    95     ^ self new openOnClass:aClass andSelector:aSelector
       
    96 ! !
    90 ! !
    97 
    91 
    98 !UIHelpTool class methodsFor:'constants'!
    92 !UIHelpTool class methodsFor:'constants'!
    99 
    93 
   100 label
    94 label
   187         window: 
   181         window: 
   188        (WindowSpec
   182        (WindowSpec
   189           label: 'UIHelpTool'
   183           label: 'UIHelpTool'
   190           name: 'UIHelpTool'
   184           name: 'UIHelpTool'
   191           min: (Point 10 10)
   185           min: (Point 10 10)
   192           bounds: (Rectangle 14 46 475 339)
   186           bounds: (Rectangle 0 0 461 293)
   193         )
   187         )
   194         component: 
   188         component: 
   195        (SpecCollection
   189        (SpecCollection
   196           collection: (
   190           collection: (
   197            (VariableVerticalPanelSpec
   191            (VariableVerticalPanelSpec
   198               name: 'PanelVrt'
   192               name: 'PanelVrt'
   199               layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
   193               layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
       
   194               activeHelpKey: foo
   200               component: 
   195               component: 
   201              (SpecCollection
   196              (SpecCollection
   202                 collection: (
   197                 collection: (
   203                  (VariableHorizontalPanelSpec
   198                  (VariableHorizontalPanelSpec
   204                     name: 'PanelHrz'
   199                     name: 'PanelHrz'
   450             translateLabel: true
   445             translateLabel: true
   451             submenu: 
   446             submenu: 
   452            (Menu
   447            (Menu
   453               (
   448               (
   454                (MenuItem
   449                (MenuItem
       
   450                   label: 'New'
       
   451                   itemValue: doNew
       
   452                   translateLabel: true
       
   453                 )
       
   454                (MenuItem
       
   455                   label: '-'
       
   456                 )
       
   457                (MenuItem
   455                   activeHelpKey: fileLoad
   458                   activeHelpKey: fileLoad
   456                   label: 'Load...'
   459                   label: 'Load...'
   457                   itemValue: doLoad
   460                   itemValue: doLoad
   458                   translateLabel: true
   461                   translateLabel: true
   459                 )
   462                 )
   460                (MenuItem
   463                (MenuItem
   461                   activeHelpKey: fileSave
   464                   activeHelpKey: fileSave
   462                   label: 'Save'
   465                   label: 'Save'
   463                   itemValue: doSave
   466                   itemValue: doSave
   464                   translateLabel: true
       
   465                 )
       
   466                (MenuItem
       
   467                   label: 'New'
       
   468                   itemValue: doNew
       
   469                   translateLabel: true
   467                   translateLabel: true
   470                 )
   468                 )
   471                (MenuItem
   469                (MenuItem
   472                   label: '-'
   470                   label: '-'
   473                 )
   471                 )
   481               nil
   479               nil
   482               nil
   480               nil
   483             )
   481             )
   484           )
   482           )
   485          (MenuItem
   483          (MenuItem
   486             label: 'History'
       
   487             translateLabel: true
       
   488             submenuChannel: menuHistory
       
   489           )
       
   490          (MenuItem
       
   491             label: 'Edit'
   484             label: 'Edit'
   492             translateLabel: true
   485             translateLabel: true
   493             submenuChannel: keyItemMenu
   486             submenuChannel: keyItemMenu
   494             keepLinkedMenu: true
   487             keepLinkedMenu: true
       
   488           )
       
   489          (MenuItem
       
   490             label: 'History'
       
   491             translateLabel: true
       
   492             submenuChannel: menuHistory
   495           )
   493           )
   496          (MenuItem
   494          (MenuItem
   497             label: 'Help'
   495             label: 'Help'
   498             translateLabel: true
   496             translateLabel: true
   499             startGroup: right
   497             startGroup: right
   674      |root mergeItems|
   672      |root mergeItems|
   675 
   673 
   676      root := classItemList first.
   674      root := classItemList first.
   677 
   675 
   678      root isUnspecified ifTrue:[ mergeItems := root children ]
   676      root isUnspecified ifTrue:[ mergeItems := root children ]
   679 		       ifFalse:[ mergeItems := nil ].
   677                        ifFalse:[ mergeItems := nil ].
   680 
   678 
   681      self buildFromClass:aClass.
   679      self loadFromClass:aClass.
   682 
   680 
   683      mergeItems size ~~ 0 ifTrue:[
   681      mergeItems size ~~ 0 ifTrue:[
   684 	root := classItemList first.
   682         root := classItemList first.
   685 
   683 
   686 	mergeItems do:[:anItem| |item hkey|
   684         mergeItems do:[:anItem| |item hkey|
   687 	    hkey := anItem helpKey.
   685             hkey := anItem helpKey.
   688 	    item := root detectItemWithKey:hkey.
   686             item := root detectItemWithKey:hkey.
   689 
   687 
   690 	    item isNil ifTrue:[
   688             item isNil ifTrue:[
   691 		item := KeyItem helpKey:hkey helpText:(anItem helpText).
   689                 item := KeyItem helpKey:hkey helpText:(anItem helpText).
   692 		root add:item sortBlock:[:a :b| a label < b label ].
   690                 root add:item sortBlock:[:a :b| a label < b label ].
   693 	    ] ifFalse:[
   691             ] ifFalse:[
   694 		item helpText:(anItem helpText).
   692                 item helpText:(anItem helpText).
   695 	    ]
   693             ]
   696 	]
   694         ]
   697     ].
   695     ].
   698 !
   696 !
   699 
   697 
   700 buildFromClass:aClass
   698 loadFromClass:aClass
   701     "reads the help dictionary from aClass and find remaining classes 
   699     "reads the help dictionary from aClass and find remaining classes 
   702      'between' aClass and ApplicationModel
   700      'between' aClass and ApplicationModel
   703     " 
   701     " 
   704     |lastContents root list resource helpSpecSelector|
   702     |lastContents root list helpSpecSelector|
   705 
   703 
   706     helpSpecSelector := self specSelector.
   704     helpSpecSelector := self specSelector.
   707     specClass := self getHelpSpecClassFromClass:aClass.
   705     specClass := self getHelpSpecClassFromClass:aClass.
   708 
   706 
   709     list := OrderedCollection new.
   707     list := OrderedCollection new.
   710 
   708 
   711     (specClass isClass and:[specClass isLoaded]) ifTrue:[
   709     (specClass isClass and:[specClass isLoaded]) ifTrue:[
   712         lastContents := nil.
   710         lastContents := nil.
   713         resource := specClass name, ' ', helpSpecSelector.
   711 
   714         self addToHistory:(Association key:resource value:#'loadFromMessage:').
   712         self addHistoryEntryForClass:specClass selector:helpSpecSelector.
   715 
   713 
   716         specClass withAllSuperclasses reverse do:[:aClass| |value name|
   714         specClass withAllSuperclasses reverse do:[:aClass| |value name|
   717             lastContents isNil ifTrue:[
   715             lastContents isNil ifTrue:[
   718                 aClass == ApplicationModel ifTrue:[ 
   716                 aClass == ApplicationModel ifTrue:[ 
   719                     lastContents := IdentityDictionary new
   717                     lastContents := IdentityDictionary new
   720                 ].
   718                 ].
   721             ] ifFalse:[
   719             ] ifFalse:[
   722                 root := ClassItem onClass:aClass.
   720                 root := ClassItem onClass:aClass.
   723 
   721 
   724                 (aClass class includesSelector:helpSpecSelector) ifTrue:[
   722                 (aClass respondsTo: helpSpecSelector) ifTrue:[ 
   725                     value := aClass perform:helpSpecSelector.
   723                     value := aClass perform: helpSpecSelector.
   726 
   724                 ].
       
   725 
       
   726                 value notNil ifTrue:[
   727                     value keysAndValuesDo:[:k :v| |cval|
   727                     value keysAndValuesDo:[:k :v| |cval|
   728                         cval := lastContents at:k ifAbsent:self.
   728                         cval := lastContents at:k ifAbsent:self.
   729                         cval = v ifFalse:[ root add:(KeyItem helpKey:k helpText:v) ].
   729                         cval = v ifFalse:[ root add:(KeyItem helpKey:k helpText:v) ].
   730                     ].
   730                     ].
   731                     lastContents := value.
   731                     lastContents := value.
   745         self updateIcons.
   745         self updateIcons.
   746         classItemModel value:(list last)
   746         classItemModel value:(list last)
   747     ].
   747     ].
   748 !
   748 !
   749 
   749 
   750 buildFromClass: aClass andSelector: aSelector
   750 loadFromClass:aClass andSelector:aSelector
   751     "sets aSelector and reads the help dictionary from aClass
   751     "reads the help dictionary from aClass"
   752     "
   752 
       
   753     self assert:(aClass isNil or:[aClass isClass]).
       
   754 
   753     specSelector := aSelector.
   755     specSelector := aSelector.
   754     self buildFromClass:aClass
   756     self loadFromClass:aClass
   755 !
   757 !
   756 
   758 
   757 buildFromHelpTool:aHelpTool
   759 loadFromHelpTool:aHelpTool
   758     "build from another helpTool
   760     "build from another helpTool
   759     "
   761     "
   760     specClass     := aHelpTool specClass.
   762     specClass     := aHelpTool specClass.
   761     specSelector  := aHelpTool specSelector.
   763     specSelector  := aHelpTool specSelector.
   762     classItemList := aHelpTool classItemListHolder value.
   764     classItemList := aHelpTool classItemListHolder value.
   863     ^ aBlock ensure:[modifiedHolder := holder]
   865     ^ aBlock ensure:[modifiedHolder := holder]
   864 ! !
   866 ! !
   865 
   867 
   866 !UIHelpTool methodsFor:'private'!
   868 !UIHelpTool methodsFor:'private'!
   867 
   869 
   868 extractResourceFrom:aString
   870 getHelpSpecClassFromClass:aClass
   869     "extracts class and selector from a resource string. On success
   871     |cls|
   870      an association with the key a class and the selector as value
   872 
   871      is returned. Otherwise nil is returned
   873     aClass isNil ifTrue:[^ nil].
   872     "
   874 
   873     |words newClass newSel|
   875     cls := self resolveName:aClass.
   874 
   876     cls isNil ifTrue:[ ^ nil ].
   875     aString size ~~ 0 ifTrue:[
   877 
   876 	words := aString asCollectionOfWords.
   878     cls := cls perform:#helpSpecClass ifNotUnderstood:cls.
   877 
   879 
   878 	words size == 2 ifTrue:[
   880     (cls isBehavior and:[cls isLoaded]) ifTrue:[
   879 	    newClass := self resolveName:(words first).
   881         ^ cls
   880 
       
   881 	    (newClass isClass and:[newClass isLoaded]) ifTrue:[
       
   882 		newSel := words last asSymbol.
       
   883 
       
   884 		(newClass class includesSelector:newSel) ifTrue:[
       
   885 		    ^ Association key:newClass value:newSel            
       
   886 		].
       
   887 	    ].
       
   888 	].
       
   889     ].
   882     ].
   890     ^ nil
   883     ^ nil
   891 !
   884 !
   892 
   885 
   893 getHelpSpecClassFromClass:aClass
   886 loadFromMessage:classAndSelector
   894     "oops
       
   895     "
       
   896     |cls|
       
   897 
       
   898     aClass notNil ifTrue:[
       
   899 	cls := self resolveName:aClass.
       
   900 
       
   901 	cls notNil ifTrue:[
       
   902 	    cls := cls perform:#helpSpecClass ifNotUnderstood:cls.
       
   903 
       
   904 	    (cls isClass and:[cls isLoaded]) ifTrue:[
       
   905 		^ cls
       
   906 	    ].
       
   907 	].
       
   908     ].
       
   909     ^ nil
       
   910 !
       
   911 
       
   912 loadFromMessage:aString
       
   913     "Set and rebuild the specClass and specSelector from a resource string.
   887     "Set and rebuild the specClass and specSelector from a resource string.
   914      On success true is returned otherwise false. If the current spec is
   888      On success true is returned otherwise false. If the current spec is
   915      modified, a dialog is launched.
   889      modified, a dialog is launched."
   916     "
   890 
   917     |association|
   891     self askForModification ifFalse:[ ^ false].
   918 
   892 
   919     association := self extractResourceFrom:aString.
   893     classAndSelector notNil ifTrue:[
   920 
   894         self loadFromClass:(classAndSelector methodClass) andSelector:(classAndSelector methodSelector).
   921     association notNil ifTrue:[
   895         ^ true
   922 	self askForModification ifTrue:[
       
   923 	    self buildFromClass:(association key) andSelector:(association value).
       
   924 	    ^ true
       
   925 	].
       
   926     ].
       
   927     ^ false
       
   928 !
       
   929 
       
   930 resourceMessage:aString
       
   931     "Set the specClass and specSelector from a resource string. On
       
   932      success true is returned otherwise false.
       
   933     "
       
   934     |association|
       
   935 
       
   936     association := self extractResourceFrom:aString.
       
   937 
       
   938     association notNil ifTrue:[
       
   939 	specClass    := association key.
       
   940 	specSelector := association value.
       
   941 	^ true
       
   942     ].
   896     ].
   943     ^ false
   897     ^ false
   944 !
   898 !
   945 
   899 
   946 updateIcons
   900 updateIcons
  1016     helpTextView modifiedChannel:contentsModifiedChannel.
   970     helpTextView modifiedChannel:contentsModifiedChannel.
  1017 
   971 
  1018     editModel := nil asValue.
   972     editModel := nil asValue.
  1019     editModel addDependent:self.
   973     editModel addDependent:self.
  1020 
   974 
  1021     self buildFromClass:nil.
   975     self loadFromClass:nil.
  1022 !
       
  1023 
       
  1024 openInterface:aSymbol
       
  1025     "do not open as stand alone
       
  1026     "
       
  1027 !
   976 !
  1028 
   977 
  1029 openOnClass:aClass
   978 openOnClass:aClass
  1030     "opens the UIHelpTool on aClass
   979     "opens the UIHelpTool on aClass
  1031     "
   980     "
  1033 !
   982 !
  1034 
   983 
  1035 openOnClass:aClass andSelector: aSelector
   984 openOnClass:aClass andSelector: aSelector
  1036     "opens the UIHelpTool on aClass and aSelector"
   985     "opens the UIHelpTool on aClass and aSelector"
  1037 
   986 
  1038     super openInterface:#windowSpecForStandAlone.
   987     self openInterface:#windowSpecForStandAlone.
  1039 
   988 
  1040     builder window label: 'Help Tool'.
   989     builder window label:'Help Tool'.
  1041     self buildFromClass:aClass andSelector:aSelector
   990     self loadFromClass:aClass andSelector:aSelector
  1042 ! !
   991 ! !
  1043 
   992 
  1044 !UIHelpTool methodsFor:'user actions'!
   993 !UIHelpTool methodsFor:'user actions'!
  1045 
   994 
  1046 accept
   995 accept
  1102     ].    
  1051     ].    
  1103     editModel value:nil.
  1052     editModel value:nil.
  1104 !
  1053 !
  1105 
  1054 
  1106 doLoad
  1055 doLoad
  1107     "opens a Resource Selection Browser in order to get a resource message
  1056     "opens a Resource Selection Browser in order to get a resource message"
  1108     "
  1057 
  1109     self loadFromMessage: 
  1058     self loadFromMessage: 
  1110         (ResourceSelectionBrowser
  1059         (ResourceSelectionBrowser
  1111             request: 'Load Help Spec From Class'
  1060             request: 'Load Help Spec From Class'
  1112             onSuperclass: nil
  1061             onSuperclass: nil
  1113             andClass: specClass
  1062             andClass: specClass
  1120 doNew
  1069 doNew
  1121     "reset all to empty
  1070     "reset all to empty
  1122     "
  1071     "
  1123     contentsModifiedChannel value:false.
  1072     contentsModifiedChannel value:false.
  1124     self helpKey:nil.
  1073     self helpKey:nil.
  1125     self buildFromClass:nil.
  1074     self loadFromClass:nil.
  1126 !
  1075 !
  1127 
  1076 
  1128 doSave
  1077 doSave
  1129     "save the help spec to the spec-class(es)
  1078     "save the help spec to the spec-class(es)"
  1130     "
  1079 
  1131     specClass isNil ifTrue:[
  1080     specClass isNil ifTrue:[
  1132         self information:(resources string:'No class specified !!').
  1081         self information:(resources string:'No class specified !!').
  1133         ^ nil
  1082         ^ nil
  1134     ].
  1083     ].
  1135 "/ cg: the following test is rubbish !!
  1084 "/ cg: the following test is rubbish !!