STXInstaller.st
author Claus Gittinger <cg@exept.de>
Mon, 22 Jul 1996 11:47:54 +0200
changeset 2 936a4407697b
parent 1 7ebb34d8f3df
child 3 7b048cdcc856
permissions -rw-r--r--
checkin from browser

Object subclass:#STXInstaller
	instanceVariableNames:'stxLibDir stxBinDir actionPercentageHolder actionTextHolder'
	classVariableNames:'LastBinDir LastLibDir'
	poolDictionaries:''
	category:'eXept-tools'
!


!STXInstaller  class methodsFor:'startup'!

open
    ^ self new open

    "Created: 17.7.1996 / 14:36:22 / cg"
    "Modified: 18.7.1996 / 21:20:22 / cg"
! !

!STXInstaller methodsFor:'defaults'!

defaultBinDirs
    |dirs|

    dirs := OrderedCollection new.
    dirs add:'/usr/local/bin'.
    dirs add:'/usr/bin'.
    dirs add:(Filename homeDirectory constructString:'bin').
    dirs add:'/tmp/stxbin'.
    dirs add:'/home/stx/bin'.
    dirs add:'/home2/stx/bin'.
    ^ dirs

    "Created: 18.7.1996 / 19:43:00 / cg"
    "Modified: 18.7.1996 / 19:45:08 / cg"
!

defaultLibDirs
    |dirs|

    dirs := OrderedCollection new.
    dirs add:'/usr/local/lib/smalltalk'.
    dirs add:'/usr/lib/smalltalk'.
    dirs add:((Filename homeDirectory 
                            construct:'lib')
                            constructString:'smalltalk').
    dirs add:'/tmp/stxlib'.
    dirs add:'/home/stx/lib'.
    dirs add:'/home2/stx/lib'.
    ^ dirs

    "Created: 18.7.1996 / 19:43:21 / cg"
    "Modified: 18.7.1996 / 19:46:04 / cg"
! !

!STXInstaller methodsFor:'installing'!

copyFiles
    |msg fileSpec filesToCopy numFiles nDone|

    msg := #('ST/X Installation' '' 'copying:' '' 'to:' '') asStringCollection.

    fileSpec := #(
                "/ name            destination   subDir        required

                ( 'stc/stc'                         #bin     nil  false '755' )
                ( 'rules/stmkmp'                    #bin     nil  false '755' )
                ( 'rules/stmkmf'                    #bin     nil  false '755' )
                ( 'projects/smalltalk/smalltalk'    #bin     nil  true  '755' )

                ( 'librun/librun.a'                 #lib     'lib'    false '644' )
                ( 'libbasic/libbasic.o'             #lib     'lib'    false '644' )
                ( 'libbasic2/libbasic2.o'           #lib     'lib'    false '644' )
                ( 'libbasic3/libbasic3.o'           #lib     'lib'    false '644' )
                ( 'libcomp/libcomp.o'               #lib     'lib'    false '644' )
                ( 'libview/libview.o'               #lib     'lib'    false '644' )
                ( 'libview2/libview2.o'             #lib     'lib'    false '644' )
                ( 'libwidg/libwidg.o'               #lib     'lib'    false '644' )
                ( 'libwidg2/libwidg2.o'             #lib     'lib'    false '644' )
                ( 'libwidg3/libwidg3.o'             #lib     'lib'    false '644' )
                ( 'libsnmp/libsnmp.o'               #lib     'lib'    false '644' )
                ( 'libtable/libtable.o'             #lib     'lib'    false '644' )
                ( 'libtool/libtool.o'               #lib     'lib'    false '644' )
                ( 'libxt/libxt.o'                   #lib     'lib'    false '644' )
                ( 'librt/librt.o'                   #lib     'lib'    false '644' )
                ( 'support/VGL/vogl/src/libvogl.a'  #lib     'lib'        false '644' )
                ( 'support/VGL/vogl/src/*.h'        #lib     'include'    false '644' )
                ( 'support/DLD/dld-3.2.5/libdld.a'  #lib     'lib'        false '644' )

                ( 'projects/smalltalk/*.rc'         #lib   nil    false '644' )
                ( 'projects/smalltalk/patches'      #lib   nil    true  '644' )

                ( 'projects/smalltalk/bitmaps'      #lib nil    true  '644' )
                ( 'doc'                             #lib nil    false '644' )
                ( 'projects/smalltalk/include'      #lib nil    true  '644' )
                ( 'projects/smalltalk/resources'    #lib nil    true  '644' )
                ( 'projects/smalltalk/source'       #lib nil    true  '644' )
                ( 'configurations'                  #lib nil    false '644' )
                ( 'rules'                           #lib nil    false '644' )

                ( 'goodies/*.st'                    #lib 'goodies'    false '644' )
                ( 'goodies/*.chg'                   #lib 'goodies'    false '644' )
                ( 'goodies/rdoit/rdoit'             #bin nil          false '755' )
              ).

    filesToCopy := OrderedCollection new.

    fileSpec do:[:entry |
        |fileName dest subDir required destDir|

        fileName := entry at:1.
        dest := entry at:2.
        subDir := entry at:3.
        required := entry at:4.

        dest == #bin ifTrue:[
            destDir := stxBinDir
        ] ifFalse:[
            destDir := stxLibDir
        ].
        
        destDir := destDir asFilename.
        subDir notNil ifTrue:[
            destDir := destDir construct:subDir
        ].

        filesToCopy add:(fileName -> destDir pathName)
    ].

    numFiles := filesToCopy size.
    nDone := 0.

    filesToCopy do:[:entry |
        |fileName destDir cmd p text|

        actionPercentageHolder value:(nDone / numFiles * 100) rounded.

        fileName := entry key.
        destDir := entry value.

        msg at:4 put:'    ' , (fileName asText allBold).
        msg at:6 put:'    ' , (destDir asText allBold).
        actionTextHolder value:nil.
        actionTextHolder value:msg.

        cmd := 'cp -r ../../' , fileName , ' ' , destDir.

        p := PipeStream readingFrom:cmd.
        p isNil ifTrue:[
            self warn:('command error. Could not execute:\\' , cmd) withCRs.
        ] ifFalse:[
            text := OrderedCollection new.
            [p atEnd] whileFalse:[
                text add:p nextLine
            ].
            p close.
        ].
"/        (OperatingSystem executeCommand:('cp -r ../../' , fileName , ' ' , destDir))
"/        ifFalse:[
"/            self warn:('error while copying ' , fileName , '\\Please check manually.') withCRs.
"/        ].        

        nDone := nDone + 1
    ].

    ^ true

    "Created: 17.7.1996 / 15:16:20 / cg"
    "Modified: 18.7.1996 / 22:20:24 / cg"
!

createDirectories
    |msg dirsToMake numDirs nDone|

    msg := #('ST/X Installation' '' 'creating directory:' '' '' '') asStringCollection.

    dirsToMake := OrderedCollection new.
    dirsToMake add:stxBinDir.
    dirsToMake add:stxLibDir.
    dirsToMake add:(stxLibDir asFilename constructString:'lib').
    dirsToMake add:(stxLibDir asFilename constructString:'doc').
    dirsToMake add:(stxLibDir asFilename constructString:'include').
    dirsToMake add:(stxLibDir asFilename constructString:'resources').
    dirsToMake add:(stxLibDir asFilename constructString:'binary').
    dirsToMake add:(stxLibDir asFilename constructString:'bitmaps').
    dirsToMake add:(stxLibDir asFilename constructString:'goodies').

    numDirs := dirsToMake size.
    nDone := 0.

    dirsToMake do:[:dirName |
        |d errMsg stop box|

        actionPercentageHolder value:(nDone / numDirs * 100) rounded.

        msg at:4 put:'    ' , dirName.
        actionTextHolder value:nil.
        actionTextHolder value:msg.

        d := dirName asFilename.

        d exists ifFalse:[
            OperatingSystem recursiveCreateDirectory:d pathName
        ].

        d exists ifFalse:[
            errMsg := 'failed to create directory: ' , dirName.
            stop := true
        ] ifTrue:[
            d isDirectory ifFalse:[
                errMsg := 'not a directory: ' , dirName.
                stop := true
            ] ifTrue:[
                (d isReadable
                and:[d isWritable]) ifFalse:[
                    errMsg := 'no R/W access to directory: ' , dirName.
                    stop := false
                ] ifTrue:[
                    errMsg := nil
                ]
            ]
        ].

        errMsg notNil ifTrue:[
            box := WarningBox new.
            box title:errMsg.
            box showAtPointerNotCovering:(WindowGroup activeGroup topViews first).
            stop ifTrue:[^ false].
        ].

        Delay waitForSeconds:0.25.
        nDone := nDone + 1.
    ].
    ^ true

    "Created: 17.7.1996 / 15:24:19 / cg"
    "Modified: 18.7.1996 / 22:18:38 / cg"
! !

!STXInstaller methodsFor:'startup'!

askAndInstall
    "/ check, if we are in the projects/smalltalk directory

    (Filename currentDirectory pathName endsWith:'projects/smalltalk') ifFalse:[
        self warn:'must be in the projects/smalltalk directory'.
        ^ self
    ].

    [self askForDestination] whileTrue:[
        self checkForExistingInstallationAndConfirm ifFalse:[
            ^ self
        ].
        self doInstall ifTrue:[
            self postInstall.
            ^ self
        ].
        (self confirm:'installation failed or aborted - retry ?')
        ifFalse:[
            ^ self
        ]
    ].

    "Modified: 18.7.1996 / 21:20:56 / cg"
!

askForDestination
    "open a dialog to enter destination directories"

    |d cm l green dark img
     stxLibDirHolder stxBinDirHolder
    |

    LastLibDir isNil ifTrue:[
        LastLibDir := '/usr/local/lib/smalltalk'
    ].
    LastBinDir isNil ifTrue:[
        LastBinDir := '/usr/local/bin'
    ].

    stxLibDirHolder := LastLibDir asValue.
    stxBinDirHolder := LastBinDir asValue.

    Screen current hasColors ifTrue:[
        green := (Color red:0 green:80 blue:20) "darkened".
        dark := Color grey:10.
    ] ifFalse:[
        green := Color white.
        dark := Color black.
    ].

    d := DialogBox new.

    d label:'ST/X CD Installation'.
    img := Image fromFile:'SmalltalkX.xbm'.

    l := d addTextLabel:img.
    l adjust:#left; foregroundColor:green backgroundColor:dark.

    l := d addTextLabel:'Smalltalk/X CD installation.'.
    l adjust:#left; backgroundColor:dark; foregroundColor:Color white.
    d addVerticalSpace.
    d addVerticalSpace.

    d addHorizontalLine.

    l := d addTextLabel:'Destination directories:'.
    l adjust:#left; backgroundColor:dark; foregroundColor:Color white.

    cm := ComboBoxView on:stxBinDirHolder.
    cm list:self defaultBinDirs.
    d 
        addLabelledField:cm 
        label:'binaries' 
        adjust:#left 
        tabable:true 
        from:0.0 to:1.0 separateAtX:0.25
        nameAs:'binaryBox'.

    (d componentAt:'binaryBox.label') backgroundColor:dark; foregroundColor:Color white.

    cm := ComboBoxView on:stxLibDirHolder.
    cm list:self defaultLibDirs.
    d 
        addLabelledField:cm 
        label:'libraries' 
        adjust:#left 
        tabable:true 
        from:0.0 to:1.0 separateAtX:0.25
        nameAs:'libraryBox'.

    (d componentAt:'libraryBox.label') backgroundColor:dark; foregroundColor:Color white.

    d addAbortButton; addOkButtonLabelled:'install'.
    d extent:400@300.

    d allViewBackground:dark.

    d openAtCenter.
    d accepted ifTrue:[
        stxLibDir := LastLibDir := stxLibDirHolder value.
        stxBinDir := LastBinDir := stxBinDirHolder value.
        d destroy.
        ^ true
    ].
    d destroy.
    ^ false

    "Modified: 18.7.1996 / 19:43:38 / cg"
!

checkForExistingInstallationAndConfirm
    "look if there is another installation and confirm
     reinstalling; return true if ok, false if not"

    |whatToDo|

    stxLibDir asFilename exists ifTrue:[
        whatToDo := Dialog 
                        choose:('detected existing installation in ' 
                                 , stxLibDir asText allBold)
                        label:'Attention'
                        labels:#('remove first' 'overwrite' 'cancel') 
                        values:#(remove over nil) 
                        default:nil.     
        whatToDo isNil ifTrue:[^false].
        whatToDo == #remove ifTrue:[
            (OperatingSystem recursiveRemoveDirectory:stxLibDir)
            ifFalse:[
                self warn:'mhmh - could not remove old installation.'
            ].
        ].
        ^ true
"/        ^ DialogBox
"/            confirm:('detected existing installation in ' 
"/                     , stxLibDir asText allBold
"/                     , '\\continue & overwrite ?') withCRs 
"/           yesLabel:'overwrite' noLabel:'cancel'
        
    ].
    ^ true

    "Modified: 18.7.1996 / 20:01:36 / cg"
!

doInstall
    "install ST/X; return true if ok, false if not"

    |progressView ok|

    progressView := ProgressIndicator
                        inBoxWithLabel:'ST/X Installation'
                        text:#('ST/X Installation' '' '' '' '' '' '' '') asStringCollection
                        abortable:true.
    progressView topView extent:400@300.

    ok := false.

    progressView showProgressOf:
            [:progressValue :currentAction |

              actionPercentageHolder := progressValue.
              actionTextHolder := currentAction.

              (self createDirectories) ifTrue:[
                  ok := self copyFiles
              ]
            ].

    ^ ok

    "Created: 17.7.1996 / 15:11:27 / cg"
    "Modified: 17.7.1996 / 15:24:27 / cg"
!

open
    self askAndInstall.

    "Created: 17.7.1996 / 14:37:14 / cg"
    "Modified: 18.7.1996 / 18:26:20 / cg"
!

postInstall
    "some messages at the end ..."

    |shInfo cshInfo msg stxBinDir stxLibDir havePath|

stxBinDir := '/home2/stx/bin'.
stxLibDir := '/home2/stx/lib'.

    msg := 'ST/X Installation complete.\\' withCRs.
    shInfo := ''.
    cshInfo := ''.

    havePath := true.
    (((OperatingSystem getEnvironment:'PATH')
        asCollectionOfSubstringsSeparatedBy:$:)
            includes:stxBinDir) ifFalse:[

        havePath := false.
        shInfo  := 'PATH=$PATH:' , stxBinDir , ' ; export PATH\'.
        cshInfo := 'set path=($path ' , stxBinDir , ')\'.
        msg := msg , stxBinDir asText allBold , ' is not in your PATH.
You should change your ".login" and/or ".profile" files to include it.

'
    ].

    (stxLibDir ~= '/usr/local/lib/smalltalk'
    and:[stxLibDir ~= '/usr/lib/smalltalk']) ifTrue:[
        msg := msg ,
'The library directory is not a standard ST/X library directory
("/usr/local/lib/smalltalk" or "/usr/lib/smalltalk"). 
You have to define the ' , 'STX_LIBDIR' asText allBold ,' environment variable 
as ' , stxLibDir asText allBold , ' before ST/X can be started.
'.

        havePath ifFalse:[
            msg := msg , 'The above mentioned files are also a good place to do this.
'.
        ] ifTrue:[
            msg := msg , 'The ".login" and/or ".profile" files are a good place to do this.
'.
        ].

        shInfo := shInfo , 'STX_LIBDIR=' , stxLibDir , ' ; export STX_LIBDIR\'.
        cshInfo := cshInfo , 'setenv STX_LIBDIR ' , stxLibDir , '\'.
    ].

    shInfo notEmpty ifTrue:[
        'Please add the following to your ".profile" file:' errorPrintCR.
        '' errorPrintCR.
        shInfo withCRs errorPrintCR.
        '' errorPrintCR.
        'or (if you use csh/tcsh), add to your ".login" file:' errorPrintCR.
        '' errorPrintCR.
        cshInfo withCRs errorPrintCR.
        '' errorPrintCR.
    ].
    self information:msg.

    "
     STXInstaller new postInstall
    "

    "Modified: 18.7.1996 / 22:10:42 / cg"
! !

!STXInstaller  class methodsFor:'documentation'!

version
    ^ '$Header$'
! !