"
 COPYRIGHT (c) 1996 by eXept Software AG
	      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.
"
"{ Package: 'stx:libwidg2' }"

DialogBox subclass:#LicenceBox
	instanceVariableNames:'accepted destroySemaphore fileName textView'
	classVariableNames:'LicenceRejectSignal'
	poolDictionaries:''
	category:'Views-DialogBoxes'
!

!LicenceBox class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1996 by eXept Software AG
	      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.
"
!

documentation
"
    LicenceBox shows a licence text when opened, an returns true,
    if the licence has been accepted, false otherwise.

    [author:]
	Stefan Vogel

    [start with:]
	LicenceBox open

    [see also:]
	AboutBox
"
!

examples
"
						[exBegin]
    LicenceRejectSignal handle:[:ex|
	Transcript showCR:'Licence rejected'.
    ] do:[
	LicenceBox open.
	Transcript showCR:'Licence accepted'.
    ]
						[exEnd]
"
! !

!LicenceBox class methodsFor:'initialization'!

initialize
    LicenceRejectSignal isNil ifTrue:[
	LicenceRejectSignal := ErrorSignal newSignalMayProceed:true.
	LicenceRejectSignal nameClass:self message:#licenceRejectSignal.
	LicenceRejectSignal notifierString:'licence rejected by user'.
    ].

    "
     self initialize
    "
! !

!LicenceBox class methodsFor:'instance creation'!

open
    "open myself modal and return true if accepted, false otherwise"

    ^ super open accepted.

    "
     LicenceBox open
    "

    "Modified: 9.9.1996 / 17:52:48 / stefan"
!

openOnFile:aFileName
    "like open, but show the HTML-text found in aFileName.
     Can be used for end-user applications which want to display
     there own licence text."

    |box f fn text dir|

    box := self new.

    (f := aFileName asFilename) exists ifTrue:[
	text := f contents.
	dir := f directoryName.
    ] ifFalse:[
	fn := Smalltalk getSystemFileName:aFileName.
	fn notNil ifTrue:[
	    f := fn asFilename.
	    text := f contents.
	    dir := f directoryName.
	]
    ].
    text notNil ifTrue:[
	box licenceText:text.
	box topDirectory:dir.
    ].
    box open

    "
     LicenceBox openOnFile:'doc/online/english/TOP.html'

     (LicenceBox licenceRejectSignal catch:[
	LicenceBox openOnFile:'doc/online/english/TOP.html'
     ]) ifTrue:[
	self information:'rejected'
      ]
    "
! !

!LicenceBox class methodsFor:'Signal constants'!

licenceRejectSignal
    "licence has been rejected by user"

    ^ LicenceRejectSignal

! !

!LicenceBox methodsFor:'accessing'!

accepted
    "return accepted"

    ^ accepted

    "Created: 6.9.1996 / 13:24:44 / stefan"
!

accepted:something
    "set accepted"

    accepted := something.

    "Created: 6.9.1996 / 13:24:44 / stefan"
!

licenceText:someHTMLText
    "set the text which is shown in the box"

    textView setText:someHTMLText.
!

topDirectory:aDirectoryName
    "set the topDirectory, which is required for hyperlinks
     to work (in the html text)"

    textView setTopDirectoryName:aDirectoryName.
! !

!LicenceBox methodsFor:'destroying'!

terminate
    "this is the close from a windowmanager
     (only if UseTransientViews == true).
     Redefined, since ModalBox keeps the View alive (only hidden)"

    self destroy.

    "Created: 9.9.1996 / 15:15:31 / stefan"
! !

!LicenceBox methodsFor:'initialization'!

initialize
    |nLines displayHeight|

    super initialize.

    displayHeight := self graphicsDevice usableHeight.
    nLines := displayHeight // 25.

"/    (displayHeight < 800) ifTrue:[
"/        (displayHeight < 500) ifTrue:[
"/            nLines := 20
"/        ] ifFalse:[
"/            nLines := 30
"/        ]
"/    ] ifFalse:[
"/        nLines := 40
"/    ].

    accepted := false.

    (self addTextLabel:(resources string:'Please read the licence terms:')) adjust:#left.
    textView := self addTextBoxOn:nil
                        class:HTMLDocumentView
                        withNumberOfLines:nLines
                        hScrollable:true
                        vScrollable:true.

    self width:(textView preferredExtentForLines:nLines cols:70) x.
    textView setText:(self licenceText).
    textView setTopDirectoryName:(self topDirectory).
    self addAbortButtonLabelled:(resources string:'Reject licence terms').
    self addOkButtonLabelled:(resources string:'Accept licence terms').
    self abortAction:[self destroy. accepted := false. LicenceRejectSignal raise].
    self okAction:[self destroy. accepted := true].
    self stickAtBottomWithVariableHeight:textView.
    self label:'ST/X Licence Dialog'.

    "Modified: 9.9.1996 / 17:52:13 / stefan"
!

mapped
    super mapped.

    self graphicsDevice isWindowsPlatform ifTrue:[
        "/ kludge
        [
            Delay waitForSeconds:0.5.
            self raise.
            self activate.
            self setForegroundWindow.
            self activate.
        ] fork.
    ].

    "
     self open
    "
! !

!LicenceBox methodsFor:'private'!

licenceFile
    "get filename of licence file"

    |relName|

    fileName isNil ifTrue:[
	fileName := relName := resources at:'LICENCEFILE' default:nil.
	fileName isNil ifTrue:[
	    Smalltalk releaseIdentification = 'ST/X_free_demo_vsn' ifTrue:[
		relName := 'doc/online/english/LICENCE_DEMO_STX.html'.
	    ] ifFalse:[
		relName := 'doc/online/english/LICENCE_STX.html'.
	    ].
	    fileName := relName.
	].

	fileName asFilename exists ifFalse:[
	    fileName := Smalltalk getSystemFileName:relName.
	    fileName isNil ifTrue:[
		fileName := Smalltalk getSystemFileName:('../' , relName).
		fileName isNil ifTrue:[
		    fileName := Smalltalk getSystemFileName:('../../' , relName).
		    fileName isNil ifTrue:[
			fileName := Smalltalk getSystemFileName:'doc/online/german/LICENCE_STX.html'.
			fileName isNil ifTrue:[
			    fileName := '../../doc/online/german/LICENCE_STX.html'.
			]
		    ]
		].
	    ].
	].
	fileName asFilename exists ifFalse:[
	    fileName := nil
	].
    ].
    ^ fileName

    "
     LicenceBox new licenceFile
    "

    "Modified: / 23.4.1998 / 11:40:25 / cg"
!

licenceText
    "get licence text"

    |file|

    file := self licenceFile.
    file isNil ifTrue:[
	^ 'oops - you are not supposed to remove the LICENSE file !!

- or the documentation files have not been installed correctly;
- or your systemPath settings are not correct.'
    ].
    ^ file asFilename contents.

    "
     LicenceBox new licenceText
    "

!

topDirectory
    "get name of top directory"

    |file|

    file := self licenceFile.
    file isNil ifTrue:[
	^ ''
    ].
    ^ file asFilename directoryName.

    "
     LicenceBox new topDirectory
    "

! !

!LicenceBox methodsFor:'queries'!

windowStyle
    ^ #normal.
    ^ #dialog.
    ^ super windowStyle.

    "
     self new windowStyle
    "
! !

!LicenceBox class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/LicenceBox.st,v 1.30 2014-09-25 19:43:38 stefan Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libwidg2/LicenceBox.st,v 1.30 2014-09-25 19:43:38 stefan Exp $'
! !


LicenceBox initialize!