![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to install.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc|
Return to install.tcl CVS log | Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc |
1.1 root 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.