]> git.zerfleddert.de Git - micropolis/blob - src/tclx/tclsrc/install.tcl
automatically detect byteorder of X server
[micropolis] / 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
Impressum, Datenschutz