1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#!/bin/sh
# The next line is a TK comment, but a shell command \
exec wish "$0" "$@" & exit 0
# resolve_link --
#
# Procedure to resolve the final directory from a single link
# or set of links to a file or directory.
#
# Args
#
# p_link - Starting link or directory. Directories do
# not get resolved.
#
# Returns
#
# Final destination directory that a link points to. If a
# directory is passed to the procedure, then the directory
# name is returned since there is nothing to resolve.
proc resolve_link { p_link } {
switch [file type $p_link] {
link {
set p_link [file join [file dirname $p_link] \
[file readlink $p_link]]
resolve_link $p_link
}
file {
return [file dirname $p_link]
}
directory {
return $p_link
}
}
}
# Define the application's global option database.
option clear
option add *borderWidth 1
option add *selectBackground #d9d9d9
option add *selectForeground #000000
option add *activeBackground #d9d9d9
option add *activeForeground #000000
option add *Entry.background #ffffff
option add *Entry.foreground #000000
option add *TabnotebookFrame.borderWidth 2
option add *TabnotebookFrame.relief groove
option add *Menu.borderWidth 1
option add *Menu.activeBorderWidth 1
option add *Menu.tearOff 0
option add *Menu.activeBackground #ececec
option add *Menubutton.activeBackground #d9d9d9
option add *Scrollbar.activeBackground #ececec
# Define some odds and ends that will be used by the application
# that will change as time goes on.
set tkWorld(version) "1.4.0"
set tkWorld(copyright) "Copyright (C) 1996-2000 Wesley H. Bailey"
set tkWorld(email) "tkworld@tkworld.org"
set tkWorld(www) "http:://www.tkworld.org"
set tkWorld(ostype) [string tolower $tcl_platform(platform)]
# Define the home directory for tkWorld. Make sure to follow links
# since a user might put the source code in /usr/local/src/tkWorld
# and have a link in /usr/local/bin.
cd [set tkWorld(home) [resolve_link [info script]]]
# Setup the tkWorld script directory structure based on the home
# directory.
set tkWorld(lib_dir) [file join $tkWorld(home) lib]
set tkWorld(tcl_dir) [file join $tkWorld(lib_dir) tcl]
set tkWorld(image_dir) [file join $tkWorld(lib_dir) images]
set tkWorld(registry_dir) [file join $tkWorld(lib_dir) registry]
set tkWorld(help_dir) [file join $tkWorld(lib_dir) help]
# Check for the appropriate Tcl/Tk version.
if {$tcl_version < 8.0} {
puts stderr "Error: Tcl/Tk Version Conflict: $tcl_version\nYou\
need Tcl/Tk version 8.0 or higher in order to run tkWorld\
version $tkWorld(version).\nDownload the latest version of\
Tcl/Tk from www.scriptics.com"
exit
}
# Define the tkWorld user information.
if [info exists env(USER)] {
set tkWorld(user) $env(USER)
} elseif [info exists env(USERNAME)] {
set tkWorld(user) $env(USERNAME)
} elseif [info exists env(LOGNAME)] {
set tkWorld(user) $env(LOGNAME)
} else {
set tkWorld(user) unknown
}
# Setup tkWorld to display start/finish header labels.
set tkWorld(start_finish_display) 1
# Define the users default shell to the Bourne Shell to execute
# the commands from.
set tkWorld(working_shell) "sh"
# Define the working directory for the scripts to be executed from.
set tkWorld(user_home) $env(HOME)
set tkWorld(working_dir) $env(HOME)
# Source all of the library scripts.
foreach f [glob -nocomplain [file join $tkWorld(tcl_dir) *.tcl]] {
source $f
}
# Source all of the scripts in the registry.
foreach f [glob -nocomplain [file join $tkWorld(registry_dir) *.tcl]] {
source $f
}
# Define the directory for executing the shell scripts.
if {[file writable /tmp]} {
set tkWorld(script_dir) /tmp
} elseif {[file writable [file join / usr tmp]]} {
set tkWorld(script_dir) [file join / usr tmp]
} elseif {[file writable $tkWorld(home)]} {
set tkWorld(script_dir) $tkWorld(home)
} else {
stderr::log 0003 "You do not have write permission to the\
$tkWorld(home) directory. Please restart tkWorld in a\
directory that you have write permissions in"
}
# Startup the application
switch [lindex $argv 0] {
debug {
gui::create
}
develop {
# Place holder for future work.
}
default {
placard::create
}
}
|
