.
authorclaus
Fri, 19 May 1995 18:40:45 +0200
changeset 77 e846c6f3ac50
parent 76 e4458543dda2
child 78 a708779d798c
.
EventListener.st
Icon.st
Layout.st
LayoutFrame.st
LayoutFrm.st
LayoutOrg.st
LayoutOrigin.st
--- a/EventListener.st	Wed May 17 14:22:21 1995 +0200
+++ b/EventListener.st	Fri May 19 18:40:45 1995 +0200
@@ -1,6 +1,6 @@
 "
  COPYRIGHT (c) 1995 by Claus Gittinger
-              All Rights Reserved
+	      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
@@ -15,30 +15,30 @@
 'From Smalltalk/X, Version:2.10.5 on 25-mar-1995 at 11:44:17 am'!
 
 Object subclass:#EventListener
-	 instanceVariableNames:'helpInfo'
+	 instanceVariableNames:''
 	 classVariableNames:''
 	 poolDictionaries:''
-	 category:'Interface-Help'
+	 category:'Interface-Support'
 !
 
 !EventListener class methodsFor:'documentation'!
 
 version
 "
-$Header: /cvs/stx/stx/libview2/EventListener.st,v 1.1 1995-03-31 03:12:37 claus Exp $
+$Header: /cvs/stx/stx/libview2/EventListener.st,v 1.2 1995-05-19 16:40:24 claus Exp $
 "
 !
 
 documentation
 "
-    abstract class for event listeners
+    abstract class for event listeners. See example use in ActiveHelp.
 "
 !
 
 copyright
 "
  COPYRIGHT (c) 1995 by Claus Gittinger
-              All Rights Reserved
+	      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
@@ -119,4 +119,3 @@
 
     WindowSensor eventListener:nil 
 ! !
-
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Icon.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,126 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+	      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.
+"
+
+'From Smalltalk/X, Version:2.10.5 on 14-apr-1995 at 11:13:06 am'!
+
+Object subclass:#Icon
+	 instanceVariableNames:'image mask'
+	 classVariableNames:'KnownIcons'
+	 poolDictionaries:''
+	 category:'Graphics-Support'
+!
+
+!Icon class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libview2/Icon.st,v 1.1 1995-05-19 16:40:37 claus Exp $
+"
+!
+
+documentation
+"
+    Compatibility mimicri for Icon.
+    Implements the #constantNamed: message which is used by some PD
+    classes and returns corresponding ST/X icons.
+    If you like the original icons, install the xbm files in the bitmap
+    directory under a name foo.xbm, where foo corresponds to the icons
+    name symbol (i.e. for Icon constantNamed:#foo, a 'foo.xbm' file is required).
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+	      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.
+"
+! !
+
+!Icon class methodsFor:'initialization'!
+
+replacementNames
+    "return a constant name to ST/X name translation."
+
+    ^ #( 
+	#(file             FBrowser)
+	#(debugger         Debugger)
+	#(systembrowser    SBrowser)
+	#(classbrowser     SBrowser)
+	#(categoryBrowser  SBrowser)
+	#(hierarchyBrowser SBrowser)
+	#(methodBrowser    SBrowser)
+	#(launcher         SmalltalkX)
+	#(workspace        SmalltalkX)
+	#(transcript       SmalltalkX)
+	#(inspector        Inspector)
+	#(default          SmalltalkX)
+       )
+!
+
+replacementNameFor:aName
+    "return a replacement ST/X name for an ST80 icon name."
+
+    self replacementNames do:[:aPair |
+	(aPair at:1) == aName ifTrue:[^ aPair at:2].
+    ].
+    ^ nil
+!
+
+initialize
+    KnownIcons := IdentityDictionary new
+
+    "
+     Icon initialize
+    "
+! !
+
+!Icon class methodsFor:'instance creation'!
+
+constantNamed:aName put:anIcon
+    KnownIcons at:aName put:icon
+!
+
+constantNamed:aName
+    |icon nm|
+
+    icon := KnownIcons at:aName ifAbsent:[].
+    icon isNil ifTrue:[
+	nm := self replacementNameFor:aName.
+	nm notNil ifTrue:[
+	    icon := Image fromFile:('bitmaps/' , nm , '.xbm').
+	].
+	icon isNil ifTrue:[
+	    icon := Image fromFile:('bitmaps/' , name , '.xbm').
+	    icon isNil ifTrue:[
+		('ICON: no icon named ' , aName) errorPrintNL.
+		^ nil
+	    ].
+	].
+	KnownIcons at:aName put:icon.
+    ].
+    ^ icon
+
+    "
+     Icon constantNamed:#file     
+     Icon constantNamed:#debugger     
+     Icon constantNamed:#systembrowser     
+    "
+! !
+
+Icon initialize!
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Layout.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,28 @@
+Object subclass:#Layout
+	 instanceVariableNames:''
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Graphics-Support-ST80 compatibility'
+!
+
+!Layout class methodsFor:'instance creation'!
+
+new
+    ^ self basicNew initialize
+! !
+
+!Layout methodsFor:'queries'!
+
+rectangleRelativeTo:superRectangle preferred:prefRect
+    ^ self subclassResponsibility
+!
+
+isLayout
+    ^ true
+! !
+
+!Layout methodsFor:'initialization'!
+
+initialize
+    ^ self subclassResponsibility
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/LayoutFrame.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,126 @@
+'From Smalltalk/X, Version:2.10.5 on 15-apr-1995 at 12:14:46 pm'!
+
+LayoutOrigin subclass:#LayoutFrame
+	 instanceVariableNames:'rightFraction bottomFraction
+		rightOffset bottomOffset'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Graphics-Support-ST80 compatibility'
+!
+
+!LayoutFrame methodsFor:'accessing'!
+
+rightFraction:something
+    "set rightFraction"
+
+    rightFraction := something.
+!
+
+rightFraction
+    "return rightFraction"
+
+    ^ rightFraction
+!
+
+rightOffset:something
+    "set rightOffset"
+
+    rightOffset := something.
+!
+
+rightOffset
+    "return rightOffset"
+
+    ^ rightOffset
+!
+
+rightFraction:something offset:o
+    "set rightFraction and offset"
+
+    rightFraction := something.
+    rightOffset := o
+!
+
+bottomFraction:something
+    "set bottomFraction"
+
+    bottomFraction := something.
+!
+
+bottomFraction
+    "return bottomFraction"
+
+    ^ bottomFraction
+!
+
+bottomOffset:something
+    "set bottomOffset"
+
+    bottomOffset := something.
+!
+
+bottomOffset
+    "return bottomOffset"
+
+    ^ bottomOffset
+!
+
+bottomFraction:something offset:o
+    "set bottomFraction and offset"
+
+    bottomFraction := something.
+    bottomOffset := o
+! !
+
+
+!LayoutFrame methodsFor:'queries'!
+
+rectangleRelativeTo:superRectangle preferred:prefRect
+    |x1 y1 x2 y2|
+
+    leftOffset isNil ifTrue:[
+	x1 := 0
+    ] ifFalse:[
+	x1 := leftOffset
+    ].
+    topOffset isNil ifTrue:[
+	y1 := 0
+    ] ifFalse:[
+	y1 := topOffset
+    ].
+    rightOffset isNil ifTrue:[
+	x2 := 0
+    ] ifFalse:[
+	x2 := rightOffset
+    ].
+    bottomOffset isNil ifTrue:[
+	y2 := 0
+    ] ifFalse:[
+	y2 := bottomOffset
+    ].
+    leftFraction notNil ifTrue:[
+	x1 := x1 + (prefRect width * leftFraction)
+    ].
+    topFraction notNil ifTrue:[
+	y1 := y1 + (prefRect height * topFraction)
+    ].
+    rightFraction notNil ifTrue:[
+	x2 := x2 + (prefRect width * rightFraction)
+    ].
+    bottomFraction notNil ifTrue:[
+	y2 := y2 + (prefRect height * bottomFraction)
+    ].
+    ^ Rectangle origin:x1@y1 corner:x2@y2 
+!
+
+corner
+    ^ rightFraction asFloat @ bottomFraction asFloat
+! !
+
+!LayoutFrame methodsFor:'initialization'!
+
+initialize
+    leftOffset := rightOffset := bottomOffset := topOffset := 0.
+    leftFraction := topFraction := 0.
+    bottomFraction := rightFraction := 1.
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/LayoutFrm.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,126 @@
+'From Smalltalk/X, Version:2.10.5 on 15-apr-1995 at 12:14:46 pm'!
+
+LayoutOrigin subclass:#LayoutFrame
+	 instanceVariableNames:'rightFraction bottomFraction
+		rightOffset bottomOffset'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Graphics-Support-ST80 compatibility'
+!
+
+!LayoutFrame methodsFor:'accessing'!
+
+rightFraction:something
+    "set rightFraction"
+
+    rightFraction := something.
+!
+
+rightFraction
+    "return rightFraction"
+
+    ^ rightFraction
+!
+
+rightOffset:something
+    "set rightOffset"
+
+    rightOffset := something.
+!
+
+rightOffset
+    "return rightOffset"
+
+    ^ rightOffset
+!
+
+rightFraction:something offset:o
+    "set rightFraction and offset"
+
+    rightFraction := something.
+    rightOffset := o
+!
+
+bottomFraction:something
+    "set bottomFraction"
+
+    bottomFraction := something.
+!
+
+bottomFraction
+    "return bottomFraction"
+
+    ^ bottomFraction
+!
+
+bottomOffset:something
+    "set bottomOffset"
+
+    bottomOffset := something.
+!
+
+bottomOffset
+    "return bottomOffset"
+
+    ^ bottomOffset
+!
+
+bottomFraction:something offset:o
+    "set bottomFraction and offset"
+
+    bottomFraction := something.
+    bottomOffset := o
+! !
+
+
+!LayoutFrame methodsFor:'queries'!
+
+rectangleRelativeTo:superRectangle preferred:prefRect
+    |x1 y1 x2 y2|
+
+    leftOffset isNil ifTrue:[
+	x1 := 0
+    ] ifFalse:[
+	x1 := leftOffset
+    ].
+    topOffset isNil ifTrue:[
+	y1 := 0
+    ] ifFalse:[
+	y1 := topOffset
+    ].
+    rightOffset isNil ifTrue:[
+	x2 := 0
+    ] ifFalse:[
+	x2 := rightOffset
+    ].
+    bottomOffset isNil ifTrue:[
+	y2 := 0
+    ] ifFalse:[
+	y2 := bottomOffset
+    ].
+    leftFraction notNil ifTrue:[
+	x1 := x1 + (prefRect width * leftFraction)
+    ].
+    topFraction notNil ifTrue:[
+	y1 := y1 + (prefRect height * topFraction)
+    ].
+    rightFraction notNil ifTrue:[
+	x2 := x2 + (prefRect width * rightFraction)
+    ].
+    bottomFraction notNil ifTrue:[
+	y2 := y2 + (prefRect height * bottomFraction)
+    ].
+    ^ Rectangle origin:x1@y1 corner:x2@y2 
+!
+
+corner
+    ^ rightFraction asFloat @ bottomFraction asFloat
+! !
+
+!LayoutFrame methodsFor:'initialization'!
+
+initialize
+    leftOffset := rightOffset := bottomOffset := topOffset := 0.
+    leftFraction := topFraction := 0.
+    bottomFraction := rightFraction := 1.
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/LayoutOrg.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,139 @@
+'From Smalltalk/X, Version:2.10.5 on 15-apr-1995 at 12:14:46 pm'!
+
+Layout subclass:#LayoutOrigin
+	 instanceVariableNames:'leftFraction topFraction leftOffset
+		topOffset'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Graphics-Support-ST80 compatibility'
+!
+
+!LayoutOrigin class methodsFor:'instance creation'!
+
+fractionalFromPoint:aPoint
+    ^ self new leftFraction:aPointx topFraction:aPoint y
+!
+
+offsetFromPoint:aPoint
+    ^ self new leftOffset:aPointx topOffset:aPoint y
+!
+
+fromPoint:aPoint
+    "return a new LayoutOrigin from  aPoint.
+     If the coordinates are between 0 and 1, take
+     them as fractional parts (relative to superview).
+     Otherwise, treat them as absolute offsets."
+
+    |x y layout|
+
+    x := aPoint x.
+    y := aPoint y.
+    layout := self new.
+    ((x between:0 and:1)
+    and:[y between:0 and:1]) ifTrue:[
+	layout leftFraction:x topFraction:y
+    ] ifFalse:[
+	layout leftOffset:x topOffset:y
+    ].
+    ^ layout
+! !
+
+!LayoutOrigin methodsFor:'accessing'!
+
+leftFraction:something
+    "set leftFraction"
+
+    leftFraction := something.
+!
+
+leftFraction
+    "return leftFraction"
+
+    ^ leftFraction
+!
+
+leftOffset:something
+    "set leftOffset"
+
+    leftOffset := something.
+!
+
+leftOffset
+    "return leftOffset"
+
+    ^ leftOffset
+!
+
+leftFraction:something offset:o
+    "set leftFraction and offset"
+
+    leftFraction := something.
+    leftOffset := o
+!
+
+topFraction:something
+    "set topFraction"
+
+    topFraction := something.
+!
+
+topFraction
+    "return topFraction"
+
+    ^ topFraction
+!
+
+topOffset:something
+    "set topOffset"
+
+    topOffset := something.
+!
+
+topOffset
+    "return topOffset"
+
+    ^ topOffset
+!
+
+topFraction:something offset:o
+    "set topFraction and offset"
+
+    topFraction := something.
+    topOffset := o
+! !
+
+
+!LayoutOrigin methodsFor:'queries'!
+
+rectangleRelativeTo:superRectangle preferred:prefRect
+    |x y|
+
+    leftOffset isNil ifTrue:[
+	x := 0
+    ] ifFalse:[
+	x := leftOffset
+    ].
+    topOffset isNil ifTrue:[
+	y := 0
+    ] ifFalse:[
+	y := topOffset
+    ].
+    leftFraction notNil ifTrue:[
+	x := x + (prefRect width * leftFraction)
+    ].
+    topFraction notNil ifTrue:[
+	y := y + (prefRect height * topFraction)
+    ].
+    ^ Rectangle origin:x@y extent:prefRect extent
+!
+
+origin
+    ^ leftFraction asFloat @ topFraction asFloat
+! !
+
+!LayoutOrigin methodsFor:'initialization'!
+
+initialize
+    leftOffset := topOffset := 0.
+    leftFraction := topFraction := 0.
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/LayoutOrigin.st	Fri May 19 18:40:45 1995 +0200
@@ -0,0 +1,139 @@
+'From Smalltalk/X, Version:2.10.5 on 15-apr-1995 at 12:14:46 pm'!
+
+Layout subclass:#LayoutOrigin
+	 instanceVariableNames:'leftFraction topFraction leftOffset
+		topOffset'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Graphics-Support-ST80 compatibility'
+!
+
+!LayoutOrigin class methodsFor:'instance creation'!
+
+fractionalFromPoint:aPoint
+    ^ self new leftFraction:aPointx topFraction:aPoint y
+!
+
+offsetFromPoint:aPoint
+    ^ self new leftOffset:aPointx topOffset:aPoint y
+!
+
+fromPoint:aPoint
+    "return a new LayoutOrigin from  aPoint.
+     If the coordinates are between 0 and 1, take
+     them as fractional parts (relative to superview).
+     Otherwise, treat them as absolute offsets."
+
+    |x y layout|
+
+    x := aPoint x.
+    y := aPoint y.
+    layout := self new.
+    ((x between:0 and:1)
+    and:[y between:0 and:1]) ifTrue:[
+	layout leftFraction:x topFraction:y
+    ] ifFalse:[
+	layout leftOffset:x topOffset:y
+    ].
+    ^ layout
+! !
+
+!LayoutOrigin methodsFor:'accessing'!
+
+leftFraction:something
+    "set leftFraction"
+
+    leftFraction := something.
+!
+
+leftFraction
+    "return leftFraction"
+
+    ^ leftFraction
+!
+
+leftOffset:something
+    "set leftOffset"
+
+    leftOffset := something.
+!
+
+leftOffset
+    "return leftOffset"
+
+    ^ leftOffset
+!
+
+leftFraction:something offset:o
+    "set leftFraction and offset"
+
+    leftFraction := something.
+    leftOffset := o
+!
+
+topFraction:something
+    "set topFraction"
+
+    topFraction := something.
+!
+
+topFraction
+    "return topFraction"
+
+    ^ topFraction
+!
+
+topOffset:something
+    "set topOffset"
+
+    topOffset := something.
+!
+
+topOffset
+    "return topOffset"
+
+    ^ topOffset
+!
+
+topFraction:something offset:o
+    "set topFraction and offset"
+
+    topFraction := something.
+    topOffset := o
+! !
+
+
+!LayoutOrigin methodsFor:'queries'!
+
+rectangleRelativeTo:superRectangle preferred:prefRect
+    |x y|
+
+    leftOffset isNil ifTrue:[
+	x := 0
+    ] ifFalse:[
+	x := leftOffset
+    ].
+    topOffset isNil ifTrue:[
+	y := 0
+    ] ifFalse:[
+	y := topOffset
+    ].
+    leftFraction notNil ifTrue:[
+	x := x + (prefRect width * leftFraction)
+    ].
+    topFraction notNil ifTrue:[
+	y := y + (prefRect height * topFraction)
+    ].
+    ^ Rectangle origin:x@y extent:prefRect extent
+!
+
+origin
+    ^ leftFraction asFloat @ topFraction asFloat
+! !
+
+!LayoutOrigin methodsFor:'initialization'!
+
+initialize
+    leftOffset := topOffset := 0.
+    leftFraction := topFraction := 0.
+! !