13
##
14
## Enabling platform-specific code paths
15
16
-proc is_MacOSX {} {
17
- if {[tk windowingsystem] eq {aqua}} {
18
- return 1
19
- }
20
- return 0
21
-}
22
-
16
proc is_Windows {} {
17
if {$::tcl_platform(platform) eq {windows}} {
18
return 1
20
return 0
21
}
22
30
-set _iscygwin {}
31
-proc is_Cygwin {} {
32
- global _iscygwin
33
- if {$_iscygwin eq {}} {
34
- if {[string match "CYGWIN_*" $::tcl_platform(os)]} {
35
- set _iscygwin 1
36
- } else {
37
- set _iscygwin 0
38
- }
39
- }
40
- return $_iscygwin
41
-}
42
-
23
######################################################################
24
##
25
## PATH lookup
26
47
-set _search_path {}
48
-proc _which {what args} {
49
- global env _search_exe _search_path
50
-
51
- if {$_search_path eq {}} {
52
- if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
53
- set _search_path [split [exec cygpath \
54
- --windows \
55
- --path \
56
- --absolute \
57
- $env(PATH)] {;}]
58
- set _search_exe .exe
59
- } elseif {[is_Windows]} {
27
+if {[is_Windows]} {
28
+ set _search_path {}
29
+ proc _which {what args} {
30
+ global env _search_exe _search_path
31
+
32
+ if {$_search_path eq {}} {
33
set gitguidir [file dirname [info script]]
34
regsub -all ";" $gitguidir "\\;" gitguidir
35
set env(PATH) "$gitguidir;$env(PATH)"
36
set _search_path [split $env(PATH) {;}]
37
# Skip empty `PATH` elements
38
set _search_path [lsearch -all -inline -not -exact \
66
- $_search_path ""]
39
+ $_search_path ""]
40
set _search_exe .exe
68
- } else {
69
- set _search_path [split $env(PATH) :]
70
- set _search_exe {}
41
}
72
- }
42
74
- if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
75
- set suffix {}
76
- } else {
77
- set suffix $_search_exe
78
- }
43
+ if {[lsearch -exact $args -script] >= 0} {
44
+ set suffix {}
45
+ } else {
46
+ set suffix $_search_exe
47
+ }
48
80
- foreach p $_search_path {
81
- set p [file join $p $what$suffix]
82
- if {[file exists $p]} {
83
- return [file normalize $p]
49
+ foreach p $_search_path {
50
+ set p [file join $p $what$suffix]
51
+ if {[file exists $p]} {
52
+ return [file normalize $p]
53
+ }
54
}
55
+ return {}
56
}
86
- return {}
87
-}
57
89
-proc sanitize_command_line {command_line from_index} {
90
- set i $from_index
91
- while {$i < [llength $command_line]} {
92
- set cmd [lindex $command_line $i]
93
- if {[file pathtype $cmd] ne "absolute"} {
94
- set fullpath [_which $cmd]
95
- if {$fullpath eq ""} {
96
- throw {NOT-FOUND} "$cmd not found in PATH"
58
+ proc sanitize_command_line {command_line from_index} {
59
+ set i $from_index
60
+ while {$i < [llength $command_line]} {
61
+ set cmd [lindex $command_line $i]
62
+ if {[file pathtype $cmd] ne "absolute"} {
63
+ set fullpath [_which $cmd]
64
+ if {$fullpath eq ""} {
65
+ throw {NOT-FOUND} "$cmd not found in PATH"
66
+ }
67
+ lset command_line $i $fullpath
68
}
98
- lset command_line $i $fullpath
99
- }
69
101
- # handle piped commands, e.g. `exec A | B`
102
- for {incr i} {$i < [llength $command_line]} {incr i} {
103
- if {[lindex $command_line $i] eq "|"} {
104
- incr i
105
- break
70
+ # handle piped commands, e.g. `exec A | B`
71
+ for {incr i} {$i < [llength $command_line]} {incr i} {
72
+ if {[lindex $command_line $i] eq "|"} {
73
+ incr i
74
+ break
75
+ }
76
}
77
}
78
+ return $command_line
79
}
109
- return $command_line
110
-}
80
112
-# Override `exec` to avoid unsafe PATH lookup
81
+ # Override `exec` to avoid unsafe PATH lookup
82
114
-rename exec real_exec
83
+ rename exec real_exec
84
116
-proc exec {args} {
117
- # skip options
118
- for {set i 0} {$i < [llength $args]} {incr i} {
119
- set arg [lindex $args $i]
120
- if {$arg eq "--"} {
121
- incr i
122
- break
123
- }
124
- if {[string range $arg 0 0] ne "-"} {
125
- break
85
+ proc exec {args} {
86
+ # skip options
87
+ for {set i 0} {$i < [llength $args]} {incr i} {
88
+ set arg [lindex $args $i]
89
+ if {$arg eq "--"} {
90
+ incr i
91
+ break
92
+ }
93
+ if {[string range $arg 0 0] ne "-"} {
94
+ break
95
+ }
96
}
97
+ set args [sanitize_command_line $args $i]
98
+ uplevel 1 real_exec $args
99
}
128
- set args [sanitize_command_line $args $i]
129
- uplevel 1 real_exec $args
130
-}
100
132
-# Override `open` to avoid unsafe PATH lookup
101
+ # Override `open` to avoid unsafe PATH lookup
102
134
-rename open real_open
103
+ rename open real_open
104
136
-proc open {args} {
137
- set arg0 [lindex $args 0]
138
- if {[string range $arg0 0 0] eq "|"} {
139
- set command_line [string trim [string range $arg0 1 end]]
140
- lset args 0 "| [sanitize_command_line $command_line 0]"
105
+ proc open {args} {
106
+ set arg0 [lindex $args 0]
107
+ if {[string range $arg0 0 0] eq "|"} {
108
+ set command_line [string trim [string range $arg0 1 end]]
109
+ lset args 0 "| [sanitize_command_line $command_line 0]"
110
+ }
111
+ uplevel 1 real_open $args
112
}
142
- uplevel 1 real_open $args
113
}
114
115
# End of safe PATH lookup stuff