UIHelpTool.st
changeset 196 56f63eb42a34
parent 172 10e8e0510baa
child 204 8dcd7f22e4d1
--- a/UIHelpTool.st	Tue Jul 01 19:20:12 1997 +0200
+++ b/UIHelpTool.st	Thu Jul 03 06:30:55 1997 +0200
@@ -128,6 +128,25 @@
       )
 ! !
 
+!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
@@ -145,6 +164,19 @@
     ].
 !
 
+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
     "
@@ -200,6 +232,49 @@
     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'!
@@ -211,7 +286,7 @@
 
     (holder := builder bindingAt:#listChannel) isNil ifTrue:[
         builder aspectAt:#listChannel put:(holder :=  ValueHolder new).
-        holder value:list
+        holder value:list.
     ].
     ^ holder
 !