# HG changeset patch # User claus # Date 800901645 -7200 # Node ID e846c6f3ac50ee6e742b66ab34fcbd34095387b4 # Parent e4458543dda2efb2eb9e81a07a2cadda7589756d . diff -r e4458543dda2 -r e846c6f3ac50 EventListener.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 ! ! - diff -r e4458543dda2 -r e846c6f3ac50 Icon.st --- /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! diff -r e4458543dda2 -r e846c6f3ac50 Layout.st --- /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 +! ! diff -r e4458543dda2 -r e846c6f3ac50 LayoutFrame.st --- /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. +! ! diff -r e4458543dda2 -r e846c6f3ac50 LayoutFrm.st --- /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. +! ! diff -r e4458543dda2 -r e846c6f3ac50 LayoutOrg.st --- /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. +! ! diff -r e4458543dda2 -r e846c6f3ac50 LayoutOrigin.st --- /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. +! !