git.zerfleddert.de Git - micropolis/blob - src/tclx/tclsrc/install.tcl

   1 #
   2 # installTcl.tcl --
   3 #
   4 # Tcl program to install Tcl onto the system.
   5 #
   6 #------------------------------------------------------------------------------
   7 # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   8 #
   9 # Permission to use, copy, modify, and distribute this software and its
  10 # documentation for any purpose and without fee is hereby granted, provided
  11 # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12 # Mark Diekhans make no representations about the suitability of this
  13 # software for any purpose.  It is provided "as is" without express or
  14 # implied warranty.
  15 #------------------------------------------------------------------------------
  16 # $Id: installTcl.tcl,v 2.0 1992/10/16 04:52:08 markd Rel $
  17 #------------------------------------------------------------------------------
  18 #
  19 # It is run in the following manner:
  20 #
  21 #     tcl installTcl.tcl
  22 #
  23 # This script reads the Extended Tcl Makefile confiugation file (Config.mk)
  24 # and converts the Makefile macros in Tcl variables that control the
  25 # installation.  The following variables are currently used:
  26 #
  27 #   TCL_UCB_DIR             TCL_DEFAULT             TCL_OWNER
  28 #   TCL_GROUP               TCL_BINDIR              TCL_LIBDIR
  29 #   TCL_INCLUDEDIR          TCL_TCLDIR              TCL_MAN_INSTALL
  30 #   TCL_MAN_BASEDIR         TCL_MAN_CMD_SECTION     TCL_MAN_FUNC_SECTION
  31 #   TK_MAN_CMD_SECTION      TK_MAN_FUNC_SECTION     TCL_MAN_STYLE*
  32 #   TCL_MAN_INDEX*          TCL_TK_SHELL*
  33 #
  34 # (ones marked with * are optional)
  35 #
  36 # Notes:
  37 #   o Must be run in the Extended Tcl top level directory.
  38 #   o The routine InstallManPages has code to determine if a manual page
  39 #     belongs to a command or function.  For Tcl the commands are assumed
  40 #     to be in "Tcl.man",  for TclX functions are in TclX.man.  All others
  41 #     are assumed to be functions.  For Tk, all manuals starting with Tk_
  42 #     are assumed to be functions, all others are assumed to be commands.
  43 #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  44
  45 #------------------------------------------------------------------------------
  46 # ParseConfigFile --
  47 #
  48 #  Parse a configure file in the current directory and convert all make
  49 #  macros to global Tcl variables.
  50
  51 proc ParseConfigFile {configFile} {
  52    set cfgFH [open $configFile]
  53
  54    while {[gets $cfgFH line] >= 0} {
  55       if {[string match {[A-Za-z]*} $line]} {
  56           set idx [string first "=" $line]
  57           if {$idx < 0} {
  58               error "no `=' in: $line"}
  59           set name  [string trim [csubstr $line 0 $idx]]
  60           set value [string trim [crange  $line [expr $idx+1] end]]
  61           global $name
  62           set $name $value
  63       }
  64    }
  65    close $cfgFH
  66
  67 }
  68
  69 #------------------------------------------------------------------------------
  70 # GiveAwayFile --
  71 #   Give away a file to the Tcl owner and group and set its permissions.
  72 #
  73 # Globals:
  74 #    TCL_OWNER - Owner name for Tcl files.
  75 #    TCL_GROUP - Group nmae for Tcl file.
  76 #------------------------------------------------------------------------------
  77
  78 proc GiveAwayFile {file} {
  79     global TCL_OWNER TCL_GROUP
  80
  81     if {[file isdirectory $file]} {
  82         chmod a+rx,go-w $file
  83     } else {
  84         chmod a+r,go-w $file
  85     }
  86     chown [list $TCL_OWNER $TCL_GROUP] $file
  87
  88 } ;# GiveAwayFile
  89
  90 #------------------------------------------------------------------------------
  91 # MakePath --
  92 #
  93 # Make sure all directories in a directory path exists, if not, create them.
  94 #------------------------------------------------------------------------------
  95 proc MakePath {pathlist} {
  96     foreach path $pathlist {
  97         set exploded_path [split $path /]
  98         set thisdir {}
  99         foreach element $exploded_path {
 100             append thisdir $element
 101             if {![file isdirectory $thisdir]} {
 102                 mkdir $thisdir
 103                 GiveAwayFile $thisdir
 104             }
 105             append thisdir /
 106         }
 107     }
 108 }
 109
 110 #------------------------------------------------------------------------------
 111 # CopyFile --
 112 #
 113 # Copy the specified file and change the ownership.  If target is a directory,
 114 # then the file is copied to it, otherwise target is a new file name.
 115 #------------------------------------------------------------------------------
 116
 117 proc CopyFile {sourceFile target} {
 118
 119     if {[file isdirectory $target]} {
 120         set targetFile "$target/[file tail $sourceFile]"
 121     } else {
 122         set targetFile $target
 123     }
 124
 125     unlink -nocomplain $targetFile
 126     set sourceFH [open $sourceFile r]
 127     set targetFH [open $targetFile w]
 128     copyfile $sourceFH $targetFH
 129     close $sourceFH
 130     close $targetFH
 131     GiveAwayFile $targetFile
 132
 133 } ;# CopyFile
 134
 135 #------------------------------------------------------------------------------
 136 # CopyManPage --
 137 #
 138 # Copy the specified manual page and change the ownership.  The manual page
 139 # is edited to remove change bars (.VS and .VE macros). If target is a
 140 # directory, then the file is copied to it, otherwise target is a new file
 141 # name.
 142 #------------------------------------------------------------------------------
 143
 144 proc CopyManPage {sourceFile target} {
 145
 146     if {[file isdirectory $target]} {
 147         set targetFile "$target/[file tail $sourceFile]"
 148     } else {
 149         set targetFile $target
 150     }
 151
 152     unlink -nocomplain $targetFile
 153     set sourceFH [open $sourceFile r]
 154     set targetFH [open $targetFile w]
 155     while {[gets $sourceFH line] >= 0} {
 156         if [string match {.V[SE]*} $line] continue
 157         puts $targetFH $line
 158     }
 159     close $sourceFH
 160     close $targetFH
 161     GiveAwayFile $targetFile
 162
 163 } ;# CopyManPage
 164
 165 #------------------------------------------------------------------------------
 166 # CopySubDir --
 167 #
 168 # Recursively copy part of a directory tree, changing ownership and
 169 # permissions.  This is a utility routine that actually does the copying.
 170 #------------------------------------------------------------------------------
 171
 172 proc CopySubDir {sourceDir destDir} {
 173     foreach sourceFile [glob -nocomplain $sourceDir/*] {
 174
 175         if [file isdirectory $sourceFile] {
 176             set destFile $destDir/[file tail $sourceFile]
 177             if {![file exists $destFile]} {
 178                 mkdir $destFile}
 179             GiveAwayFile $destFile
 180             CopySubDir $sourceFile $destFile
 181         } else {
 182             CopyFile $sourceFile $destDir
 183         }
 184     }
 185 } ;# CopySubDir
 186
 187 #------------------------------------------------------------------------------
 188 # CopyDir --
 189 #
 190 # Recurisvely copy a directory tree.
 191 #------------------------------------------------------------------------------
 192
 193 proc CopyDir {sourceDir destDir} {
 194
 195     set cwd [pwd]
 196     if ![file exists $sourceDir] {
 197         error "\"$sourceDir\" does not exist"
 198     }
 199     if ![file isdirectory $sourceDir] {
 200         error "\"$sourceDir\" isn't a directory"
 201     }
 202     if {![file exists $destDir]} {
 203         mkdir $destDir
 204         GiveAwayFile $destDir
 205     }
 206     if ![file isdirectory $destDir] {
 207         error "\"$destDir\" isn't a directory"
 208     }
 209     cd $sourceDir
 210     set status [catch {CopySubDir . $destDir} msg]
 211     cd $cwd
 212     if {$status != 0} {
 213         global errorInfo errorCode
 214         error $msg $errorInfo $errorCode
 215     }
 216 }
 217
 218 #------------------------------------------------------------------------------
 219 # GenDefaultFile --
 220 #
 221 # Generate the tcl defaults file.
 222 #------------------------------------------------------------------------------
 223
 224 proc GenDefaultFile {defaultFileBase sourceDir} {
 225
 226     set defaultFile "$defaultFileBase[infox version]"
 227
 228     if ![file writable [file dirname $defaultFile]] {
 229         puts stderr "Can't create $defaultFile -- directory is not writable"
 230         puts stderr "Please reinstall with correct permissions or rebuild"
 231         puts stderr "Tcl to select a default file where the directory path"
 232         puts stderr "you specify is writable by you."
 233         puts stderr ""
 234         exit 1
 235     }
 236
 237     set fp [open $defaultFile w]
 238
 239     puts $fp "# Extended Tcl [infox version] default file"
 240     puts $fp ""
 241     puts $fp "set TCLINIT $sourceDir/TclInit.tcl"
 242     puts $fp ""
 243     puts $fp "set TCLPATH $sourceDir"
 244
 245     close $fp
 246     GiveAwayFile $defaultFile
 247
 248 } ;# GenDefaultFile
 249
 250 #------------------------------------------------------------------------------
 251 # GetManNames --
 252 #
 253 #   Search a manual page (nroff source) for the name line.  Parse the name
 254 # line into all of the functions or commands that it references.  This isn't
 255 # comprehensive, but it works for all of the Tcl, TclX and Tk man pages.
 256 #
 257 # Parameters:
 258 #   o manFile (I) - The path to the  manual page file.
 259 # Returns:
 260 #   A list contain the functions or commands or {} if the name line can't be
 261 # found or parsed.
 262 #------------------------------------------------------------------------------
 263
 264 proc GetManNames {manFile} {
 265
 266    set manFH [open $manFile]
 267
 268    #
 269    # Search for name line.  Once found, grab the next line that is not a
 270    # nroff macro.  If we end up with a blank line, we didn't find it.
 271    #
 272    while {[gets $manFH line] >= 0} {
 273        if [regexp {^.SH NAME.*$} $line] {
 274            break
 275        }
 276    }
 277    while {[gets $manFH line] >= 0} {
 278        if {![string match ".*" $line]} break
 279    }
 280    close $manFH
 281
 282    set line [string trim $line]
 283    if {$line == ""} return
 284
 285    #
 286    # Lets try and parse the name list out of the line
 287    #
 288    if {![regexp {^(.*)(\\-)} $line {} namePart]} {
 289        if {![regexp {^(.*)(-)} $line {} namePart]} return
 290    }
 291
 292    #
 293    # This magic converts the name line into a list
 294    #
 295
 296    if {[catch {join [split $namePart ,] " "} namePart] != 0} return
 297
 298    return $namePart
 299
 300 }
 301
 302 #------------------------------------------------------------------------------
 303 # SetUpManIndex --
 304 #   Setup generation of manual page index for short manual pages, if required.
 305 # Globals:
 306 #   o TCL_MAN_INDEX - Boolean indicating if a manual page is to be created.
 307 #     If it does not exists, false is assumed.
 308 #   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
 309 #     directories live.
 310 # Returns:
 311 #   The manual index file handle, or {} if the manual index is not to be
 312 #  generated.
 313 #------------------------------------------------------------------------------
 314
 315 proc SetUpManIndex {} {
 316     global TCL_MAN_BASEDIR TCL_MAN_INDEX
 317
 318     if {!([info exists TCL_MAN_INDEX] && [set TCL_MAN_INDEX])} {
 319         return {}
 320     }
 321     set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
 322     return [open $tclIndexFile w]
 323 }
 324
 325 #------------------------------------------------------------------------------
 326 # FinishUpManIndex --
 327 #   Finish generation of manual page index for short manual pages, if required.
 328 # Parameters:
 329 #   o indexFileHdl - The file handle returned by SetUpManIndex, maybe {}.
 330 # Globals:
 331 #   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
 332 #     directories live.
 333 #------------------------------------------------------------------------------
 334
 335 proc FinishUpManIndex {indexFileHdl} {
 336     global TCL_MAN_BASEDIR TCL_MAN_INDEX_MERGE
 337
 338     if [lempty $indexFileHdl] return
 339
 340     set tclIndexFile $TCL_MAN_BASEDIR/index.TCL
 341     close $indexFileHdl
 342     GiveAwayFile $tclIndexFile
 343
 344 }
 345
 346 #------------------------------------------------------------------------------
 347 # InstallShortMan --
 348 #   Install a manual page on a system that does not have long file names,
 349 #   optionally adding an entry to the man index.
 350 #
 351 # Parameters:
 352 #   o sourceFile - Manual page source file path.
 353 #   o section - Section to install the manual page in.
 354 #   o indexFileHdl - File handle of the current index file being created, or
 355 #     empty if no index is to be created.
 356 # Globals:
 357 #   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
 358 #     directories live.
 359 #   o TCL_MAN_SEPARATOR - The name separator between the directory and the
 360 #     section.
 361 #------------------------------------------------------------------------------
 362
 363 proc InstallShortMan {sourceFile section indexFileHdl} {
 364     global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR
 365
 366     set manNames [GetManNames $sourceFile]
 367     if [lempty $manNames] {
 368         set baseName [file tail [file root $sourceFile]]
 369         puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
 370         puts stderr "         Manual page only available as: $baseName"
 371     }
 372
 373     set manFileBase [file tail [file root $sourceFile]]
 374     set manFileName "$manFileBase.$section"
 375
 376     set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
 377     set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"
 378
 379     CopyManPage $sourceFile "$destManDir/$manFileName"
 380     unlink -nocomplain  "$destCatDir/$manFileName"
 381
 382     if {![lempty $indexFileHdl]} {
 383         foreach name $manNames {
 384             puts $indexFileHdl "$name\t$manFileBase\t$section"
 385         }
 386     }
 387 }
 388
 389 #------------------------------------------------------------------------------
 390 # InstallLongMan --
 391 #   Install a manual page on a system that does have long file names.
 392 #
 393 # Parameters:
 394 #   o sourceFile - Manual page source file path.
 395 #   o section - Section to install the manual page in.
 396 # Globals:
 397 #   o TCL_MAN_BASEDIR - Base manual directory where all of the man.* and cat.*
 398 #     directories live.
 399 #   o TCL_MAN_SEPARATOR - The name separator between the directory and the
 400 #     section.
 401 #------------------------------------------------------------------------------
 402
 403 proc InstallLongMan {sourceFile section} {
 404     global TCL_MAN_BASEDIR TCL_MAN_SEPARATOR
 405
 406     set manNames [GetManNames $sourceFile]
 407     if [lempty $manNames] {
 408         set baseName [file tail [file root $sourceFile]]
 409         puts stderr "Warning: can't parse NAME line for man page: $sourceFile."
 410         puts stderr "         Manual page only available as: $baseName"
 411         set manNames $baseName
 412     }
 413
 414     set destManDir "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$section"
 415     set destCatDir "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$section"
 416
 417     # Copy file to the first name in the list.
 418
 419     set firstFile [lvarpop manNames]
 420     set firstFilePath "$destManDir/$firstFile.$section"
 421
 422     CopyManPage $sourceFile $firstFilePath
 423     unlink -nocomplain   "$destCatDir/$firstFile.$section"
 424
 425     # Link it to the rest of the names in the list.
 426
 427     foreach manEntry $manNames {
 428         set destFilePath "$destManDir/$manEntry.$section"
 429         unlink -nocomplain  $destFilePath
 430         if {[catch {
 431                 link $firstFilePath $destFilePath
 432             } msg] != 0} {
 433             puts stderr "error from: link $firstFilePath $destFilePath"
 434             puts stderr "    $msg"
 435         }
 436         unlink -nocomplain "$destCatDir/$manEntry.$section"
 437     }
 438
 439 }
 440
 441 #------------------------------------------------------------------------------
 442 # InstallManPage --
 443 #   Install a manual page on a system.
 444 #
 445 # Parameters:
 446 #   o sourceFile - Manual page source file path.
 447 #   o section - Section to install the manual page in.
 448 #   o indexFileHdl - File handle of the current index file being created, or
 449 #     empty if no index is to be created.
 450 # Globals
 451 #   o TCL_MAN_STYLE - SHORT if short manual page names are being used,
 452 #     LONG if long manual pages are being used.
 453 #------------------------------------------------------------------------------
 454
 455 proc InstallManPage {sourceFile section indexFileHdl} {
 456     global TCL_MAN_STYLE
 457
 458     if {"$TCL_MAN_STYLE" == "SHORT"} {
 459         InstallShortMan $sourceFile $section $indexFileHdl
 460     } else {
 461         InstallLongMan $sourceFile $section
 462     }
 463 }
 464
 465 #------------------------------------------------------------------------------
 466 # InstallManPages --
 467 #   Install the manual pages.
 468 #------------------------------------------------------------------------------
 469
 470 proc InstallManPages {} {
 471     global TCL_UCB_DIR          TCL_TK_SHELL         TCL_TK_DIR
 472     global TCL_MAN_BASEDIR      TCL_MAN_SEPARATOR    TCL_MAN_STYLE
 473     global TCL_MAN_CMD_SECTION  TCL_MAN_FUNC_SECTION
 474     global TK_MAN_CMD_SECTION   TK_MAN_FUNC_SECTION
 475
 476     if {![info exists TCL_MAN_STYLE]} {
 477         set TCL_MAN_STYLE LONG
 478     }
 479     set TCL_MAN_STYLE [string toupper $TCL_MAN_STYLE]
 480     case $TCL_MAN_STYLE in {
 481         {SHORT} {}
 482         {LONG}  {}
 483         default {error "invalid value for TCL_MAN_STYLE: `$TCL_MAN_STYLE'"}
 484     }
 485
 486     MakePath $TCL_MAN_BASEDIR
 487     MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
 488     MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_CMD_SECTION"
 489     MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"
 490     MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TCL_MAN_FUNC_SECTION"
 491
 492     set indexFileHdl [SetUpManIndex]
 493
 494     # Install all of the actual files.
 495
 496     echo "    Installing Tcl [info tclversion] man files"
 497     foreach fileName [glob $TCL_UCB_DIR/doc/*.man] {
 498         if {[file root $fileName] == "Tcl.man"} {
 499             set section $TCL_MAN_CMD_SECTION
 500         } else {
 501             set section $TCL_MAN_FUNC_SECTION
 502         }
 503         InstallManPage $fileName $section $indexFileHdl
 504     }
 505
 506     echo "    Installing Extended Tcl [infox version] man files"
 507
 508     foreach fileName [glob man/*.man] {
 509         if {[file root $fileName] == "TclX.man"} {
 510             set section $TCL_MAN_CMD_SECTION
 511         } else {
 512             set section $TCL_MAN_FUNC_SECTION
 513         }
 514         InstallManPage $fileName $section $indexFileHdl
 515     }
 516
 517     if {![info exists TCL_TK_SHELL]} {
 518         FinishUpManIndex $indexFileHdl
 519         return
 520     }
 521
 522     MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
 523     MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_CMD_SECTION"
 524     MakePath "$TCL_MAN_BASEDIR/man$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"
 525     MakePath "$TCL_MAN_BASEDIR/cat$TCL_MAN_SEPARATOR$TK_MAN_FUNC_SECTION"
 526
 527     echo "    Installing Tk man files"
 528
 529     foreach fileName [glob $TCL_TK_DIR/doc/*.man] {
 530         if {![string match "Tk_*" [file root $fileName]]} {
 531             set section $TK_MAN_CMD_SECTION
 532         } else {
 533             set section $TK_MAN_FUNC_SECTION
 534         }
 535         InstallManPage $fileName $section $indexFileHdl
 536     }
 537
 538     FinishUpManIndex $indexFileHdl
 539
 540 } ;# InstallLongManPages
 541
 542 #------------------------------------------------------------------------------
 543 # Main program code.
 544 #------------------------------------------------------------------------------
 545
 546 echo ""
 547 echo ">>> Installing Extended Tcl [infox version] <<<"
 548
 549 set argc [llength $argv]
 550 if {$argc != 0} {
 551     puts stderr "usage: tcl installTcl.tcl"
 552     exit 1
 553 }
 554
 555 #
 556 # Bring in all of the macros defined bu the configuration file.
 557 #
 558 ParseConfigFile Config.mk
 559 ParseConfigFile config/$TCL_CONFIG_FILE
 560
 561 #
 562 # Make sure all directories exists that we will be installing in.
 563 #
 564
 565 MakePath [list $TCL_TCLDIR [file dirname $TCL_DEFAULT] $TCL_BINDIR]
 566 MakePath [list $TCL_LIBDIR $TCL_INCLUDEDIR $TCL_TCLDIR]
 567
 568 echo "    Creating default file: $TCL_DEFAULT[infox version]"
 569 GenDefaultFile $TCL_DEFAULT $TCL_TCLDIR
 570
 571 echo "    Installing `tcl' program in: $TCL_BINDIR"
 572 CopyFile tcl $TCL_BINDIR
 573 chmod +rx $TCL_BINDIR/tcl
 574
 575 echo "    Installing `libtcl.a' library in: $TCL_LIBDIR"
 576 CopyFile libtcl.a $TCL_LIBDIR
 577
 578 echo "    Installing Tcl .h files in: $TCL_INCLUDEDIR"
 579 CopyFile $TCL_UCB_DIR/tcl.h $TCL_INCLUDEDIR
 580 CopyFile $TCL_UCB_DIR/tclHash.h $TCL_INCLUDEDIR
 581 CopyFile src/tclExtend.h $TCL_INCLUDEDIR
 582 CopyFile src/tcl++.h $TCL_INCLUDEDIR
 583
 584 echo "    Installing Tcl run-time files in: $TCL_TCLDIR"
 585 foreach srcFile [glob tcllib/*] {
 586     if {![file isdirectory $srcFile]} {
 587         CopyFile $srcFile $TCL_TCLDIR
 588     }
 589 }
 590
 591 echo "    Installing Tcl help files in: $TCL_TCLDIR/help"
 592 if [file exists $TCL_TCLDIR/help] {
 593      echo "       Purging old help tree"
 594      exec rm -rf $TCL_TCLDIR/help
 595 }
 596 CopyDir tcllib/help          $TCL_TCLDIR/help
 597
 598 if [info exists TCL_TK_SHELL] {
 599     echo "    Installing `wish' program in: $TCL_BINDIR"
 600     CopyFile wish $TCL_BINDIR
 601     chmod +rx $TCL_BINDIR/wish
 602
 603     echo "    Installing `libtk.a' library in: $TCL_LIBDIR"
 604     CopyFile libtk.a $TCL_LIBDIR
 605
 606     echo "    Installing `tk.h' in: $TCL_INCLUDEDIR"
 607     CopyFile $TCL_TK_DIR/tk.h $TCL_INCLUDEDIR
 608 }
 609
 610 foreach file [glob $TCL_TCLDIR/*.tlib] {
 611     buildpackageindex $file
 612 }
 613
 614 if {$TCL_MAN_INSTALL} {
 615     InstallManPages
 616 }
 617
 618 echo "     *** TCL IS NOW INSTALLED ***"
 619