DropObject.st
author Claus Gittinger <cg@exept.de>
Mon, 03 Mar 1997 22:28:21 +0100
changeset 479 8058c8296148
parent 403 cdcee4daddef
child 546 a71c15f2330c
permissions -rw-r--r--
checkin from browser

Object subclass:#DropObject
	instanceVariableNames:'theObject'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Support'
!

DropObject class instanceVariableNames:'DisplayObject'

"
 The following class instance variables are inherited by this class:

	Object - 
"
!

DropObject subclass:#File
	instanceVariableNames:'info isHtmlFile isImageFile isPrintable'
	classVariableNames:''
	poolDictionaries:''
	privateIn:DropObject
!

DropObject subclass:#Color
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DropObject
!

DropObject subclass:#Image
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DropObject
!

DropObject subclass:#Text
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DropObject
!


!DropObject class methodsFor:'instance creation'!

new:someThing
    "create an instance dependant on something
    "
    |cls|

               someThing isColor             ifTrue:[cls := Color
    ] ifFalse:[someThing isImageOrForm       ifTrue:[cls := Image
    ] ifFalse:[(someThing isKindOf:Filename) ifTrue:[cls := File
    ] ifFalse:[cls isString                  ifTrue:[cls := Text
    ] ifFalse:[
        cls := DropObject
    ]]]].
        
  ^ cls new theObject:someThing
!

newColor:aColor
    ^ Color new theObject:aColor
!

newFile:aFilename
    ^ File new theObject:aFilename
!

newImage:anImageOrForm
    ^ Image new theObject:anImageOrForm
!

newText:aTextOrString
    ^ Text new theObject:aTextOrString
! !

!DropObject class methodsFor:'defaults'!

displayObject

    DisplayObject notNil ifTrue:[
        ^ DisplayObject
    ].
    DisplayObject := Smalltalk::Image fromFile:(self displayObjectName).
    ^ DisplayObject
!

displayObjectName
    ^ 'bitmaps/xpmBitmaps/plain_pixmaps/balloon3.xpm'

! !

!DropObject methodsFor:'accessing'!

theObject
    "return the value of the instance variable 'theObject' (automatically generated)"

    ^ theObject!

theObject:something
    "set the value of the instance variable 'theObject' (automatically generated)"

    theObject := something.! !

!DropObject methodsFor:'queries'!

displayObject
    "return my graphical representation - here a default is returned"
    ^ self class displayObject
! !

!DropObject methodsFor:'testing'!

isColorObject
    ^ false
!

isFileObject
    ^ false
!

isImageObject
    ^ false
!

isTextObject
    ^ false
! !

!DropObject::File class methodsFor:'defaults'!

displayObjectName
    ^ 'bitmaps/xpmBitmaps/plain_pixmaps/xfm_file.xpm'


! !

!DropObject::File methodsFor:'accessing'!

theObject:aPathname
    |path|

    path := OperatingSystem pathNameOf:(aPathname asString).
    info := OperatingSystem infoOf:path.

    super theObject:(path asFilename)
! !

!DropObject::File methodsFor:'queries'!

exists
    "returns true if file exists
    "
    ^ info notNil
!

isDirectory
    "checks whether file is a directory
    "
    ^ (info notNil and:[info type == #directory])
!

isHtmlFile
    "checks whether file is a html file
    "
    |suffixes pathName|

    isHtmlFile isNil ifTrue:[
        (info isNil or:[self isDirectory]) ifTrue:[
            isHtmlFile := false
        ] ifFalse:[
            pathName   := theObject asString.
            suffixes   := #( '.html' '.htm' '.HTML' '.HTM' ).
            isHtmlFile := (suffixes findFirst:[:el|pathName endsWith:el]) ~~ 0
        ]
    ].
    ^ isHtmlFile
!

isImageFile
    "returns true if file is assigned to an image
    "
    |suffixes pathName|

    isImageFile isNil ifTrue:[
        (info isNil or:[self isDirectory]) ifTrue:[
            isImageFile := false
        ] ifFalse:[
            pathName    := theObject asString.
            suffixes    := #( '.xpm' '.xbm' '.tiff' '.gif' '.bmp' '.ico' '.icon' ).
            isImageFile := (suffixes findFirst:[:el|pathName endsWith:el]) ~~ 0
        ]
    ].
    ^ isImageFile

!

isPrintable
    "returns false if file contains non printable characters
    "
    |stream buff size|

    isPrintable isNil ifTrue:[
        isPrintable := false.

        (info isNil or:[self isDirectory]) ifFalse:[
            stream := FileStream readonlyFileNamed:(theObject pathName).

            stream isNil ifFalse:[
                buff := String new:300.
                size := stream nextBytes:300 into:buff.
                stream close.
            ].
            1 to:size do:[:i|
                (buff at:i) isPrintable ifFalse:[
                    ^ isPrintable
                ]
            ].
            isPrintable := true
        ]
    ].
    ^ isPrintable
! !

!DropObject::File methodsFor:'testing'!

isFileObject
    ^ true
! !

!DropObject::Color class methodsFor:'defaults'!

displayObjectName
    ^ 'bitmaps/xpmBitmaps/plain_pixmaps/paint2.xpm'





! !

!DropObject::Color methodsFor:'testing'!

isColorObject
    ^ true
! !

!DropObject::Image class methodsFor:'defaults'!

displayObjectName
    ^ 'bitmaps/xpmBitmaps/plain_pixmaps/hobbes.xpm'


! !

!DropObject::Image methodsFor:'testing'!

isImageObject
    ^ true


! !

!DropObject::Text class methodsFor:'defaults'!

displayObjectName
    ^ 'bitmaps/xpmBitmaps/plain_pixmaps/xfm_text.xpm'



! !

!DropObject::Text methodsFor:'testing'!

isTextObject
    ^ true


! !

!DropObject class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/DropObject.st,v 1.3 1997-02-03 09:12:22 ca Exp $'
! !