system_path(): simplify using strip_path_suffix(), and add suffix "git"
[git/platforms.git] / git-gui / lib / index.tcl
blobd33896a0ce26dd34c8024e21c71123e62832b8c0
1 # git-gui index (add/remove) support
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 proc _delete_indexlock {} {
5 if {[catch {file delete -- [gitdir index.lock]} err]} {
6 error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"]
10 proc _close_updateindex {fd after} {
11 fconfigure $fd -blocking 1
12 if {[catch {close $fd} err]} {
13 set w .indexfried
14 toplevel $w
15 wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
16 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
17 pack [label $w.msg \
18 -justify left \
19 -anchor w \
20 -text [strcat \
21 [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."] \
22 "\n\n$err"] \
23 ] -anchor w
25 frame $w.buttons
26 button $w.buttons.continue \
27 -text [mc "Continue"] \
28 -command [list destroy $w]
29 pack $w.buttons.continue -side right -padx 5
30 button $w.buttons.unlock \
31 -text [mc "Unlock Index"] \
32 -command "destroy $w; _delete_indexlock"
33 pack $w.buttons.unlock -side right
34 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
36 wm protocol $w WM_DELETE_WINDOW update
37 bind $w.buttons.continue <Visibility> "
38 grab $w
39 focus $w.buttons.continue
41 tkwait window $w
43 $::main_status stop
44 unlock_index
45 rescan $after 0
46 return
49 $::main_status stop
50 unlock_index
51 uplevel #0 $after
54 proc update_indexinfo {msg pathList after} {
55 global update_index_cp
57 if {![lock_index update]} return
59 set update_index_cp 0
60 set pathList [lsort $pathList]
61 set totalCnt [llength $pathList]
62 set batch [expr {int($totalCnt * .01) + 1}]
63 if {$batch > 25} {set batch 25}
65 $::main_status start $msg [mc "files"]
66 set fd [git_write update-index -z --index-info]
67 fconfigure $fd \
68 -blocking 0 \
69 -buffering full \
70 -buffersize 512 \
71 -encoding binary \
72 -translation binary
73 fileevent $fd writable [list \
74 write_update_indexinfo \
75 $fd \
76 $pathList \
77 $totalCnt \
78 $batch \
79 $after \
83 proc write_update_indexinfo {fd pathList totalCnt batch after} {
84 global update_index_cp
85 global file_states current_diff_path
87 if {$update_index_cp >= $totalCnt} {
88 _close_updateindex $fd $after
89 return
92 for {set i $batch} \
93 {$update_index_cp < $totalCnt && $i > 0} \
94 {incr i -1} {
95 set path [lindex $pathList $update_index_cp]
96 incr update_index_cp
98 set s $file_states($path)
99 switch -glob -- [lindex $s 0] {
100 A? {set new _O}
101 M? {set new _M}
102 T_ {set new _T}
103 D_ {set new _D}
104 D? {set new _?}
105 ?? {continue}
107 set info [lindex $s 2]
108 if {$info eq {}} continue
110 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
111 display_file $path $new
114 $::main_status update $update_index_cp $totalCnt
117 proc update_index {msg pathList after} {
118 global update_index_cp
120 if {![lock_index update]} return
122 set update_index_cp 0
123 set pathList [lsort $pathList]
124 set totalCnt [llength $pathList]
125 set batch [expr {int($totalCnt * .01) + 1}]
126 if {$batch > 25} {set batch 25}
128 $::main_status start $msg [mc "files"]
129 set fd [git_write update-index --add --remove -z --stdin]
130 fconfigure $fd \
131 -blocking 0 \
132 -buffering full \
133 -buffersize 512 \
134 -encoding binary \
135 -translation binary
136 fileevent $fd writable [list \
137 write_update_index \
138 $fd \
139 $pathList \
140 $totalCnt \
141 $batch \
142 $after \
146 proc write_update_index {fd pathList totalCnt batch after} {
147 global update_index_cp
148 global file_states current_diff_path
150 if {$update_index_cp >= $totalCnt} {
151 _close_updateindex $fd $after
152 return
155 for {set i $batch} \
156 {$update_index_cp < $totalCnt && $i > 0} \
157 {incr i -1} {
158 set path [lindex $pathList $update_index_cp]
159 incr update_index_cp
161 switch -glob -- [lindex $file_states($path) 0] {
162 AD {set new __}
163 ?D {set new D_}
164 _O -
165 AM {set new A_}
166 _T {set new T_}
167 _U -
168 U? {
169 if {[file exists $path]} {
170 set new M_
171 } else {
172 set new D_
175 ?M {set new M_}
176 ?? {continue}
178 puts -nonewline $fd "[encoding convertto $path]\0"
179 display_file $path $new
182 $::main_status update $update_index_cp $totalCnt
185 proc checkout_index {msg pathList after} {
186 global update_index_cp
188 if {![lock_index update]} return
190 set update_index_cp 0
191 set pathList [lsort $pathList]
192 set totalCnt [llength $pathList]
193 set batch [expr {int($totalCnt * .01) + 1}]
194 if {$batch > 25} {set batch 25}
196 $::main_status start $msg [mc "files"]
197 set fd [git_write checkout-index \
198 --index \
199 --quiet \
200 --force \
201 -z \
202 --stdin \
204 fconfigure $fd \
205 -blocking 0 \
206 -buffering full \
207 -buffersize 512 \
208 -encoding binary \
209 -translation binary
210 fileevent $fd writable [list \
211 write_checkout_index \
212 $fd \
213 $pathList \
214 $totalCnt \
215 $batch \
216 $after \
220 proc write_checkout_index {fd pathList totalCnt batch after} {
221 global update_index_cp
222 global file_states current_diff_path
224 if {$update_index_cp >= $totalCnt} {
225 _close_updateindex $fd $after
226 return
229 for {set i $batch} \
230 {$update_index_cp < $totalCnt && $i > 0} \
231 {incr i -1} {
232 set path [lindex $pathList $update_index_cp]
233 incr update_index_cp
234 switch -glob -- [lindex $file_states($path) 0] {
235 U? {continue}
236 ?M -
237 ?T -
238 ?D {
239 puts -nonewline $fd "[encoding convertto $path]\0"
240 display_file $path ?_
245 $::main_status update $update_index_cp $totalCnt
248 proc unstage_helper {txt paths} {
249 global file_states current_diff_path
251 if {![lock_index begin-update]} return
253 set pathList [list]
254 set after {}
255 foreach path $paths {
256 switch -glob -- [lindex $file_states($path) 0] {
257 A? -
258 M? -
259 T_ -
260 D? {
261 lappend pathList $path
262 if {$path eq $current_diff_path} {
263 set after {reshow_diff;}
268 if {$pathList eq {}} {
269 unlock_index
270 } else {
271 update_indexinfo \
272 $txt \
273 $pathList \
274 [concat $after [list ui_ready]]
278 proc do_unstage_selection {} {
279 global current_diff_path selected_paths
281 if {[array size selected_paths] > 0} {
282 unstage_helper \
283 {Unstaging selected files from commit} \
284 [array names selected_paths]
285 } elseif {$current_diff_path ne {}} {
286 unstage_helper \
287 [mc "Unstaging %s from commit" [short_path $current_diff_path]] \
288 [list $current_diff_path]
292 proc add_helper {txt paths} {
293 global file_states current_diff_path
295 if {![lock_index begin-update]} return
297 set pathList [list]
298 set after {}
299 foreach path $paths {
300 switch -glob -- [lindex $file_states($path) 0] {
301 _U -
302 U? {
303 if {$path eq $current_diff_path} {
304 unlock_index
305 merge_stage_workdir $path
306 return
309 _O -
310 ?M -
311 ?D -
312 ?T {
313 lappend pathList $path
314 if {$path eq $current_diff_path} {
315 set after {reshow_diff;}
320 if {$pathList eq {}} {
321 unlock_index
322 } else {
323 update_index \
324 $txt \
325 $pathList \
326 [concat $after {ui_status [mc "Ready to commit."]}]
330 proc do_add_selection {} {
331 global current_diff_path selected_paths
333 if {[array size selected_paths] > 0} {
334 add_helper \
335 {Adding selected files} \
336 [array names selected_paths]
337 } elseif {$current_diff_path ne {}} {
338 add_helper \
339 [mc "Adding %s" [short_path $current_diff_path]] \
340 [list $current_diff_path]
344 proc do_add_all {} {
345 global file_states
347 set paths [list]
348 foreach path [array names file_states] {
349 switch -glob -- [lindex $file_states($path) 0] {
350 U? {continue}
351 ?M -
352 ?T -
353 ?D {lappend paths $path}
356 add_helper {Adding all changed files} $paths
359 proc revert_helper {txt paths} {
360 global file_states current_diff_path
362 if {![lock_index begin-update]} return
364 set pathList [list]
365 set after {}
366 foreach path $paths {
367 switch -glob -- [lindex $file_states($path) 0] {
368 U? {continue}
369 ?M -
370 ?T -
371 ?D {
372 lappend pathList $path
373 if {$path eq $current_diff_path} {
374 set after {reshow_diff;}
381 # Split question between singular and plural cases, because
382 # such distinction is needed in some languages. Previously, the
383 # code used "Revert changes in" for both, but that can't work
384 # in languages where 'in' must be combined with word from
385 # rest of string (in diffrent way for both cases of course).
387 # FIXME: Unfortunately, even that isn't enough in some languages
388 # as they have quite complex plural-form rules. Unfortunately,
389 # msgcat doesn't seem to support that kind of string translation.
391 set n [llength $pathList]
392 if {$n == 0} {
393 unlock_index
394 return
395 } elseif {$n == 1} {
396 set query [mc "Revert changes in file %s?" [short_path [lindex $pathList]]]
397 } else {
398 set query [mc "Revert changes in these %i files?" $n]
401 set reply [tk_dialog \
402 .confirm_revert \
403 "[appname] ([reponame])" \
404 "$query
406 [mc "Any unstaged changes will be permanently lost by the revert."]" \
407 question \
409 [mc "Do Nothing"] \
410 [mc "Revert Changes"] \
412 if {$reply == 1} {
413 checkout_index \
414 $txt \
415 $pathList \
416 [concat $after [list ui_ready]]
417 } else {
418 unlock_index
422 proc do_revert_selection {} {
423 global current_diff_path selected_paths
425 if {[array size selected_paths] > 0} {
426 revert_helper \
427 [mc "Reverting selected files"] \
428 [array names selected_paths]
429 } elseif {$current_diff_path ne {}} {
430 revert_helper \
431 [mc "Reverting %s" [short_path $current_diff_path]] \
432 [list $current_diff_path]
436 proc do_select_commit_type {} {
437 global commit_type selected_commit_type
439 if {$selected_commit_type eq {new}
440 && [string match amend* $commit_type]} {
441 create_new_commit
442 } elseif {$selected_commit_type eq {amend}
443 && ![string match amend* $commit_type]} {
444 load_last_commit
446 # The amend request was rejected...
448 if {![string match amend* $commit_type]} {
449 set selected_commit_type new