LinkButton.st
branchjv
changeset 5115 a12ef0cc7ce0
parent 5097 5fbbb3dbef78
parent 5111 ce09771c85a9
child 6247 a1272bf7ae91
--- a/LinkButton.st	Sun May 15 06:58:51 2016 +0200
+++ b/LinkButton.st	Tue May 17 14:38:21 2016 +0100
@@ -40,7 +40,7 @@
 "
     Looks like a Label, but behaves like a button with individually clickable text components.
     Can be used to create html-page-look-alike links in a view,
-    especially to make label-looking action buttons.
+    especially to make label-looking action buttons (as in the browser's info view).
 
     [author:]
         cg (cg@CG-VOSTRO)
@@ -138,6 +138,57 @@
 
 !LinkButton methodsFor:'accessing'!
 
+actionAt:aPoint
+    |pressAction emphasis pointInLabel|
+
+    pressAction := self pressAction ifNil:[ self releaseAction ].
+    pressAction isNil ifTrue:[
+        pressAction := self pressChannel ifNil:[ self releaseChannel ].
+    ].
+    labelsAndActions isNil ifTrue:[
+        "take action from logo, which is normally a text with an action-emphasis"
+        logo notNil ifTrue:[
+            pointInLabel := (aPoint - (labelOriginX@labelOriginY)).
+            logo isStringCollection ifTrue:[
+                |lineIndex line pointInLine|
+
+                lineIndex := (pointInLabel y // self font height) + 1.
+                line := logo at:lineIndex ifAbsent:nil.
+                line notNil ifTrue:[
+                    pointInLine := pointInLabel - (0 @ ((lineIndex - 1) * self font height)).
+                    emphasis := line emphasisAtPoint:pointInLine on:self. 
+                ].    
+            ] ifFalse:[    
+                emphasis := logo emphasisAtPoint:pointInLabel on:self. 
+            ].
+            (emphasis isNil or:[emphasis isSymbol]) ifTrue:[
+                ^ pressAction.
+            ].
+            emphasis isAssociation ifTrue:[
+                emphasis key == #actionBlock ifTrue:[
+                    ^ emphasis value.
+                ].
+                ^ pressAction.
+            ].
+            emphasis do:[:eachElement|
+                eachElement isAssociation ifTrue:[
+                    eachElement key == #actionBlock ifTrue:[
+                        ^ eachElement value.
+                    ].
+                ].
+            ].
+        ].    
+        ^ pressAction.
+    ].
+
+    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
+        (aPoint x between:leftX and:rightX) ifTrue:[
+            ^ labelsAndActions notNil ifTrue:action ifFalse:pressAction
+        ].
+    ].
+    ^ nil
+!
+
 labelsAndActions
     "returns the collection of label->action associations. 
      For display, the label strings are drawn as one concatenated string (add separating spaces, if you have to).
@@ -198,49 +249,10 @@
     self enableMotionEvents
 ! !
 
-!LinkButton methodsFor:'redrawing'!
-
-actionAt:aPoint
-    |pressAction emphasis|
-
-    pressAction := self pressAction ifNil:[ self releaseAction ].
-    pressAction isNil ifTrue:[
-        pressAction := self pressChannel ifNil:[ self releaseChannel ].
-    ].
-    labelsAndActions isNil ifTrue:[
-        "take action from logo, which is normally a text"
-        logo notNil ifTrue:[
-            emphasis := logo emphasisAtPoint:(aPoint - (labelOriginX@labelOriginY)) on:self. 
-            (emphasis isNil or:[emphasis isSymbol]) ifTrue:[
-                ^ pressAction.
-            ].
-            emphasis isAssociation ifTrue:[
-                emphasis key == #actionBlock ifTrue:[
-                    ^ emphasis value.
-                ].
-                ^ pressAction.
-            ].
-            emphasis do:[:eachElement|
-                eachElement isAssociation ifTrue:[
-                    eachElement key == #actionBlock ifTrue:[
-                        ^ eachElement value.
-                    ].
-                ].
-            ].
-        ].    
-        ^ pressAction.
-    ].
-
-    self labelsAndActionsWithPositionsDo:[:lbl :action :leftX :rightX |
-        (aPoint x between:leftX and:rightX) ifTrue:[
-            ^ labelsAndActions notNil ifTrue:action ifFalse:pressAction
-        ].
-    ].
-    ^ nil
-!
+!LinkButton methodsFor:'private'!
 
 actionEmphasisIn:aText atPoint:aPoint
-    "check for a actionBlock emphasis in aString at aPoint.
+    "check for an actionBlock-emphasis in aString at aPoint.
      Answer an Array with the whole emphasis and the actionBlock,
      or nil"
     
@@ -266,6 +278,40 @@
     ^ #(nil nil).
 !
 
+labelsAndActionsWithPositionsDo:aFourArgBlock
+    |leftX rightX w|
+
+    leftX := labelOriginX.
+    labelsAndActions isNil ifTrue:[
+        w := (self font widthOf:logo on:device).
+        rightX := leftX + w-1.
+        aFourArgBlock 
+            value:logo
+            value:self pressAction
+            value:leftX
+            value:rightX.
+        ^ self
+    ].
+
+    labelsAndActions do:[:assoc | 
+        |lbl wEach|
+
+        lbl := assoc key.
+        wEach := (self font widthOf:lbl on:device).
+        rightX := leftX + wEach-1.
+        aFourArgBlock 
+            value:assoc key
+            value:assoc value
+            value:leftX
+            value:rightX.
+
+        leftX := rightX+1.
+    ].
+    ^ nil
+! !
+
+!LinkButton methodsFor:'redrawing'!
+
 drawFocusFrame
     "/ intentionally ignored
     ^ self
@@ -325,38 +371,6 @@
 
 is3D
     ^ false.
-!
-
-labelsAndActionsWithPositionsDo:aFourArgBlock
-    |leftX rightX w|
-
-    leftX := labelOriginX.
-    labelsAndActions isNil ifTrue:[
-        w := (self font widthOf:logo on:device).
-        rightX := leftX + w-1.
-        aFourArgBlock 
-            value:logo
-            value:self pressAction
-            value:leftX
-            value:rightX.
-        ^ self
-    ].
-
-    labelsAndActions do:[:assoc | 
-        |lbl wEach|
-
-        lbl := assoc key.
-        wEach := (self font widthOf:lbl on:device).
-        rightX := leftX + wEach-1.
-        aFourArgBlock 
-            value:assoc key
-            value:assoc value
-            value:leftX
-            value:rightX.
-
-        leftX := rightX+1.
-    ].
-    ^ nil
 ! !
 
 !LinkButton class methodsFor:'documentation'!