9
10
package require Tk
11
12
+######################################################################
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
+
23
+proc is_Windows {} {
24
+ if {$::tcl_platform(platform) eq {windows}} {
25
+ return 1
26
+ }
27
+ return 0
28
+}
29
+
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
+
43
+######################################################################
44
+##
45
+## PATH lookup
46
+
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]} {
60
+ set gitguidir [file dirname [info script]]
61
+ regsub -all ";" $gitguidir "\\;" gitguidir
62
+ set env(PATH) "$gitguidir;$env(PATH)"
63
+ set _search_path [split $env(PATH) {;}]
64
+ # Skip empty `PATH` elements
65
+ set _search_path [lsearch -all -inline -not -exact \
66
+ $_search_path ""]
67
+ set _search_exe .exe
68
+ } else {
69
+ set _search_path [split $env(PATH) :]
70
+ set _search_exe {}
71
+ }
72
+ }
73
+
74
+ if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
75
+ set suffix {}
76
+ } else {
77
+ set suffix $_search_exe
78
+ }
79
+
80
+ foreach p $_search_path {
81
+ set p [file join $p $what$suffix]
82
+ if {[file exists $p]} {
83
+ return [file normalize $p]
84
+ }
85
+ }
86
+ return {}
87
+}
88
+
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"
97
+ }
98
+ lset command_line $i $fullpath
99
+ }
100
+
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
106
+ }
107
+ }
108
+ }
109
+ return $command_line
110
+}
111
+
112
+# Override `exec` to avoid unsafe PATH lookup
113
+
114
+rename exec real_exec
115
+
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
126
+ }
127
+ }
128
+ set args [sanitize_command_line $args $i]
129
+ uplevel 1 real_exec $args
130
+}
131
+
132
+# Override `open` to avoid unsafe PATH lookup
133
+
134
+rename open real_open
135
+
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]"
141
+ }
142
+ uplevel 1 real_open $args
143
+}
144
+
145
+# End of safe PATH lookup stuff
146
+
147
proc hasworktree {} {
148
return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
149
[exec git rev-parse --is-inside-git-dir] == "false"}]