]>
Commit | Line | Data |
---|---|---|
f522c9b5 SP |
1 | # git-gui index (add/remove) support |
2 | # Copyright (C) 2006, 2007 Shawn Pearce | |
3 | ||
d4e890e5 SP |
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"] | |
7 | } | |
8 | } | |
9 | ||
fa38ab68 JG |
10 | proc close_and_unlock_index {fd after} { |
11 | if {![catch {_close_updateindex $fd} err]} { | |
d4e890e5 | 12 | unlock_index |
fa38ab68 JG |
13 | uplevel #0 $after |
14 | } else { | |
15 | rescan_on_error $err $after | |
d4e890e5 | 16 | } |
fa38ab68 JG |
17 | } |
18 | ||
19 | proc _close_updateindex {fd} { | |
20 | fconfigure $fd -blocking 1 | |
21 | close $fd | |
22 | } | |
23 | ||
24 | proc rescan_on_error {err {after {}}} { | |
25 | global use_ttk NS | |
26 | ||
27 | set w .indexfried | |
28 | Dialog $w | |
29 | wm withdraw $w | |
30 | wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]] | |
31 | wm geometry $w "+[winfo rootx .]+[winfo rooty .]" | |
32 | set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."] | |
33 | text $w.msg -yscrollcommand [list $w.vs set] \ | |
34 | -width [string length $s] -relief flat \ | |
35 | -borderwidth 0 -highlightthickness 0 \ | |
36 | -background [get_bg_color $w] | |
37 | $w.msg tag configure bold -font font_uibold -justify center | |
38 | ${NS}::scrollbar $w.vs -command [list $w.msg yview] | |
39 | $w.msg insert end $s bold \n\n$err {} | |
40 | $w.msg configure -state disabled | |
41 | ||
42 | ${NS}::button $w.continue \ | |
43 | -text [mc "Continue"] \ | |
44 | -command [list destroy $w] | |
45 | ${NS}::button $w.unlock \ | |
46 | -text [mc "Unlock Index"] \ | |
47 | -command "destroy $w; _delete_indexlock" | |
48 | grid $w.msg - $w.vs -sticky news | |
49 | grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2 | |
50 | grid columnconfigure $w 0 -weight 1 | |
51 | grid rowconfigure $w 0 -weight 1 | |
52 | ||
53 | wm protocol $w WM_DELETE_WINDOW update | |
54 | bind $w.continue <Visibility> " | |
55 | grab $w | |
56 | focus %W | |
57 | " | |
58 | wm deiconify $w | |
59 | tkwait window $w | |
d4e890e5 | 60 | |
d9c6469f | 61 | $::main_status stop_all |
d4e890e5 | 62 | unlock_index |
19195fbd | 63 | rescan [concat $after {ui_ready;}] 0 |
d4e890e5 SP |
64 | } |
65 | ||
29a93660 | 66 | proc update_indexinfo {msg path_list after} { |
699d5601 | 67 | global update_index_cp |
f522c9b5 SP |
68 | |
69 | if {![lock_index update]} return | |
70 | ||
71 | set update_index_cp 0 | |
29a93660 JG |
72 | set path_list [lsort $path_list] |
73 | set total_cnt [llength $path_list] | |
74 | set batch [expr {int($total_cnt * .01) + 1}] | |
f522c9b5 SP |
75 | if {$batch > 25} {set batch 25} |
76 | ||
d9c6469f | 77 | set status_bar_operation [$::main_status start $msg [mc "files"]] |
0b812616 | 78 | set fd [git_write update-index -z --index-info] |
f522c9b5 SP |
79 | fconfigure $fd \ |
80 | -blocking 0 \ | |
81 | -buffering full \ | |
82 | -buffersize 512 \ | |
83 | -encoding binary \ | |
84 | -translation binary | |
85 | fileevent $fd writable [list \ | |
86 | write_update_indexinfo \ | |
87 | $fd \ | |
29a93660 JG |
88 | $path_list \ |
89 | $total_cnt \ | |
f522c9b5 | 90 | $batch \ |
d9c6469f | 91 | $status_bar_operation \ |
f522c9b5 SP |
92 | $after \ |
93 | ] | |
94 | } | |
95 | ||
d9c6469f JG |
96 | proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \ |
97 | after} { | |
699d5601 | 98 | global update_index_cp |
f522c9b5 SP |
99 | global file_states current_diff_path |
100 | ||
29a93660 | 101 | if {$update_index_cp >= $total_cnt} { |
d9c6469f | 102 | $status_bar_operation stop |
fa38ab68 | 103 | close_and_unlock_index $fd $after |
f522c9b5 SP |
104 | return |
105 | } | |
106 | ||
107 | for {set i $batch} \ | |
29a93660 | 108 | {$update_index_cp < $total_cnt && $i > 0} \ |
f522c9b5 | 109 | {incr i -1} { |
29a93660 | 110 | set path [lindex $path_list $update_index_cp] |
f522c9b5 SP |
111 | incr update_index_cp |
112 | ||
113 | set s $file_states($path) | |
114 | switch -glob -- [lindex $s 0] { | |
115 | A? {set new _O} | |
7587f4d3 BW |
116 | MT - |
117 | TM - | |
e681cb7d | 118 | T_ {set new _T} |
7587f4d3 BW |
119 | M? {set new _M} |
120 | TD - | |
f522c9b5 SP |
121 | D_ {set new _D} |
122 | D? {set new _?} | |
123 | ?? {continue} | |
124 | } | |
125 | set info [lindex $s 2] | |
126 | if {$info eq {}} continue | |
127 | ||
e2039e94 | 128 | puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0" |
f522c9b5 SP |
129 | display_file $path $new |
130 | } | |
131 | ||
d9c6469f | 132 | $status_bar_operation update $update_index_cp $total_cnt |
f522c9b5 SP |
133 | } |
134 | ||
29a93660 | 135 | proc update_index {msg path_list after} { |
699d5601 | 136 | global update_index_cp |
f522c9b5 SP |
137 | |
138 | if {![lock_index update]} return | |
139 | ||
140 | set update_index_cp 0 | |
29a93660 JG |
141 | set path_list [lsort $path_list] |
142 | set total_cnt [llength $path_list] | |
143 | set batch [expr {int($total_cnt * .01) + 1}] | |
f522c9b5 SP |
144 | if {$batch > 25} {set batch 25} |
145 | ||
d9c6469f | 146 | set status_bar_operation [$::main_status start $msg [mc "files"]] |
0b812616 | 147 | set fd [git_write update-index --add --remove -z --stdin] |
f522c9b5 SP |
148 | fconfigure $fd \ |
149 | -blocking 0 \ | |
150 | -buffering full \ | |
151 | -buffersize 512 \ | |
152 | -encoding binary \ | |
153 | -translation binary | |
154 | fileevent $fd writable [list \ | |
155 | write_update_index \ | |
156 | $fd \ | |
29a93660 JG |
157 | $path_list \ |
158 | $total_cnt \ | |
f522c9b5 | 159 | $batch \ |
d9c6469f | 160 | $status_bar_operation \ |
f522c9b5 SP |
161 | $after \ |
162 | ] | |
163 | } | |
164 | ||
d9c6469f JG |
165 | proc write_update_index {fd path_list total_cnt batch status_bar_operation \ |
166 | after} { | |
699d5601 | 167 | global update_index_cp |
f522c9b5 SP |
168 | global file_states current_diff_path |
169 | ||
29a93660 | 170 | if {$update_index_cp >= $total_cnt} { |
d9c6469f | 171 | $status_bar_operation stop |
fa38ab68 | 172 | close_and_unlock_index $fd $after |
f522c9b5 SP |
173 | return |
174 | } | |
175 | ||
176 | for {set i $batch} \ | |
29a93660 | 177 | {$update_index_cp < $total_cnt && $i > 0} \ |
f522c9b5 | 178 | {incr i -1} { |
29a93660 | 179 | set path [lindex $path_list $update_index_cp] |
f522c9b5 SP |
180 | incr update_index_cp |
181 | ||
182 | switch -glob -- [lindex $file_states($path) 0] { | |
183 | AD {set new __} | |
184 | ?D {set new D_} | |
185 | _O - | |
7587f4d3 | 186 | AT - |
f522c9b5 | 187 | AM {set new A_} |
7587f4d3 BW |
188 | TM - |
189 | MT - | |
e681cb7d | 190 | _T {set new T_} |
ff515d81 | 191 | _U - |
f522c9b5 SP |
192 | U? { |
193 | if {[file exists $path]} { | |
194 | set new M_ | |
195 | } else { | |
196 | set new D_ | |
197 | } | |
198 | } | |
199 | ?M {set new M_} | |
200 | ?? {continue} | |
201 | } | |
e2039e94 | 202 | puts -nonewline $fd "[encoding convertto utf-8 $path]\0" |
f522c9b5 SP |
203 | display_file $path $new |
204 | } | |
205 | ||
d9c6469f | 206 | $status_bar_operation update $update_index_cp $total_cnt |
f522c9b5 SP |
207 | } |
208 | ||
fa38ab68 | 209 | proc checkout_index {msg path_list after capture_error} { |
699d5601 | 210 | global update_index_cp |
f522c9b5 SP |
211 | |
212 | if {![lock_index update]} return | |
213 | ||
214 | set update_index_cp 0 | |
29a93660 JG |
215 | set path_list [lsort $path_list] |
216 | set total_cnt [llength $path_list] | |
217 | set batch [expr {int($total_cnt * .01) + 1}] | |
f522c9b5 SP |
218 | if {$batch > 25} {set batch 25} |
219 | ||
d9c6469f | 220 | set status_bar_operation [$::main_status start $msg [mc "files"]] |
0b812616 SP |
221 | set fd [git_write checkout-index \ |
222 | --index \ | |
223 | --quiet \ | |
224 | --force \ | |
225 | -z \ | |
226 | --stdin \ | |
227 | ] | |
f522c9b5 SP |
228 | fconfigure $fd \ |
229 | -blocking 0 \ | |
230 | -buffering full \ | |
231 | -buffersize 512 \ | |
232 | -encoding binary \ | |
233 | -translation binary | |
234 | fileevent $fd writable [list \ | |
235 | write_checkout_index \ | |
236 | $fd \ | |
29a93660 JG |
237 | $path_list \ |
238 | $total_cnt \ | |
f522c9b5 | 239 | $batch \ |
d9c6469f | 240 | $status_bar_operation \ |
f522c9b5 | 241 | $after \ |
fa38ab68 | 242 | $capture_error \ |
f522c9b5 SP |
243 | ] |
244 | } | |
245 | ||
d9c6469f | 246 | proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \ |
fa38ab68 | 247 | after capture_error} { |
699d5601 | 248 | global update_index_cp |
f522c9b5 SP |
249 | global file_states current_diff_path |
250 | ||
29a93660 | 251 | if {$update_index_cp >= $total_cnt} { |
d9c6469f | 252 | $status_bar_operation stop |
fa38ab68 JG |
253 | |
254 | # We do not unlock the index directly here because this | |
255 | # operation expects to potentially run in parallel with file | |
256 | # deletions scheduled by revert_helper. We're done with the | |
257 | # update index, so we close it, but actually unlocking the index | |
258 | # and dealing with potential errors is deferred to the chord | |
259 | # body that runs when all async operations are completed. | |
260 | # | |
261 | # (See after_chord in revert_helper.) | |
262 | ||
263 | if {[catch {_close_updateindex $fd} err]} { | |
264 | uplevel #0 $capture_error [list $err] | |
265 | } | |
266 | ||
267 | uplevel #0 $after | |
268 | ||
f522c9b5 SP |
269 | return |
270 | } | |
271 | ||
272 | for {set i $batch} \ | |
29a93660 | 273 | {$update_index_cp < $total_cnt && $i > 0} \ |
f522c9b5 | 274 | {incr i -1} { |
29a93660 | 275 | set path [lindex $path_list $update_index_cp] |
f522c9b5 SP |
276 | incr update_index_cp |
277 | switch -glob -- [lindex $file_states($path) 0] { | |
278 | U? {continue} | |
279 | ?M - | |
e681cb7d | 280 | ?T - |
f522c9b5 | 281 | ?D { |
e2039e94 | 282 | puts -nonewline $fd "[encoding convertto utf-8 $path]\0" |
f522c9b5 SP |
283 | display_file $path ?_ |
284 | } | |
285 | } | |
286 | } | |
287 | ||
d9c6469f | 288 | $status_bar_operation update $update_index_cp $total_cnt |
f522c9b5 SP |
289 | } |
290 | ||
291 | proc unstage_helper {txt paths} { | |
292 | global file_states current_diff_path | |
293 | ||
294 | if {![lock_index begin-update]} return | |
295 | ||
29a93660 | 296 | set path_list [list] |
f522c9b5 SP |
297 | set after {} |
298 | foreach path $paths { | |
299 | switch -glob -- [lindex $file_states($path) 0] { | |
300 | A? - | |
301 | M? - | |
7587f4d3 | 302 | T? - |
f522c9b5 | 303 | D? { |
29a93660 | 304 | lappend path_list $path |
f522c9b5 SP |
305 | if {$path eq $current_diff_path} { |
306 | set after {reshow_diff;} | |
307 | } | |
308 | } | |
309 | } | |
310 | } | |
29a93660 | 311 | if {$path_list eq {}} { |
f522c9b5 SP |
312 | unlock_index |
313 | } else { | |
314 | update_indexinfo \ | |
315 | $txt \ | |
29a93660 | 316 | $path_list \ |
19195fbd | 317 | [concat $after {ui_ready;}] |
f522c9b5 SP |
318 | } |
319 | } | |
320 | ||
321 | proc do_unstage_selection {} { | |
322 | global current_diff_path selected_paths | |
323 | ||
324 | if {[array size selected_paths] > 0} { | |
325 | unstage_helper \ | |
124356b6 | 326 | [mc "Unstaging selected files from commit"] \ |
f522c9b5 SP |
327 | [array names selected_paths] |
328 | } elseif {$current_diff_path ne {}} { | |
329 | unstage_helper \ | |
c8c4854b | 330 | [mc "Unstaging %s from commit" [short_path $current_diff_path]] \ |
f522c9b5 SP |
331 | [list $current_diff_path] |
332 | } | |
333 | } | |
334 | ||
335 | proc add_helper {txt paths} { | |
336 | global file_states current_diff_path | |
337 | ||
338 | if {![lock_index begin-update]} return | |
339 | ||
29a93660 | 340 | set path_list [list] |
f522c9b5 SP |
341 | set after {} |
342 | foreach path $paths { | |
343 | switch -glob -- [lindex $file_states($path) 0] { | |
0aea2842 AG |
344 | _U - |
345 | U? { | |
346 | if {$path eq $current_diff_path} { | |
347 | unlock_index | |
348 | merge_stage_workdir $path | |
349 | return | |
350 | } | |
351 | } | |
f522c9b5 SP |
352 | _O - |
353 | ?M - | |
354 | ?D - | |
0aea2842 | 355 | ?T { |
29a93660 | 356 | lappend path_list $path |
f522c9b5 SP |
357 | if {$path eq $current_diff_path} { |
358 | set after {reshow_diff;} | |
359 | } | |
360 | } | |
361 | } | |
362 | } | |
29a93660 | 363 | if {$path_list eq {}} { |
f522c9b5 SP |
364 | unlock_index |
365 | } else { | |
366 | update_index \ | |
367 | $txt \ | |
29a93660 | 368 | $path_list \ |
19195fbd | 369 | [concat $after {ui_status [mc "Ready to commit."];}] |
f522c9b5 SP |
370 | } |
371 | } | |
372 | ||
373 | proc do_add_selection {} { | |
374 | global current_diff_path selected_paths | |
375 | ||
376 | if {[array size selected_paths] > 0} { | |
377 | add_helper \ | |
124356b6 | 378 | [mc "Adding selected files"] \ |
f522c9b5 SP |
379 | [array names selected_paths] |
380 | } elseif {$current_diff_path ne {}} { | |
381 | add_helper \ | |
c8c4854b | 382 | [mc "Adding %s" [short_path $current_diff_path]] \ |
f522c9b5 SP |
383 | [list $current_diff_path] |
384 | } | |
385 | } | |
386 | ||
387 | proc do_add_all {} { | |
388 | global file_states | |
389 | ||
390 | set paths [list] | |
526aa2b2 | 391 | set untracked_paths [list] |
f522c9b5 SP |
392 | foreach path [array names file_states] { |
393 | switch -glob -- [lindex $file_states($path) 0] { | |
394 | U? {continue} | |
395 | ?M - | |
e681cb7d | 396 | ?T - |
f522c9b5 | 397 | ?D {lappend paths $path} |
526aa2b2 | 398 | ?O {lappend untracked_paths $path} |
856c2d75 HV |
399 | } |
400 | } | |
526aa2b2 | 401 | if {[llength $untracked_paths]} { |
bb196e26 BW |
402 | set reply 0 |
403 | switch -- [get_config gui.stageuntracked] { | |
404 | no { | |
405 | set reply 0 | |
406 | } | |
407 | yes { | |
408 | set reply 1 | |
409 | } | |
410 | ask - | |
411 | default { | |
99665fc5 PT |
412 | set reply [ask_popup [mc "Stage %d untracked files?" \ |
413 | [llength $untracked_paths]]] | |
bb196e26 BW |
414 | } |
415 | } | |
856c2d75 | 416 | if {$reply} { |
526aa2b2 | 417 | set paths [concat $paths $untracked_paths] |
f522c9b5 SP |
418 | } |
419 | } | |
124356b6 | 420 | add_helper [mc "Adding all changed files"] $paths |
f522c9b5 SP |
421 | } |
422 | ||
fa38ab68 JG |
423 | # Copied from TclLib package "lambda". |
424 | proc lambda {arguments body args} { | |
425 | return [list ::apply [list $arguments $body] {*}$args] | |
426 | } | |
427 | ||
f522c9b5 SP |
428 | proc revert_helper {txt paths} { |
429 | global file_states current_diff_path | |
430 | ||
431 | if {![lock_index begin-update]} return | |
432 | ||
fa38ab68 JG |
433 | # Common "after" functionality that waits until multiple asynchronous |
434 | # operations are complete (by waiting for them to activate their notes | |
435 | # on the chord). | |
436 | # | |
437 | # The asynchronous operations are each indicated below by a comment | |
438 | # before the code block that starts the async operation. | |
8a8efbe4 | 439 | set after_chord [SimpleChord::new { |
fa38ab68 JG |
440 | if {[string trim $err] != ""} { |
441 | rescan_on_error $err | |
442 | } else { | |
443 | unlock_index | |
444 | if {$should_reshow_diff} { reshow_diff } | |
445 | ui_ready | |
446 | } | |
447 | }] | |
448 | ||
449 | $after_chord eval { set should_reshow_diff 0 } | |
450 | ||
451 | # This function captures an error for processing when after_chord is | |
452 | # completed. (The chord is curried into the lambda function.) | |
453 | set capture_error [lambda \ | |
454 | {chord error} \ | |
455 | { $chord eval [list set err $error] } \ | |
456 | $after_chord] | |
457 | ||
458 | # We don't know how many notes we're going to create (it's dynamic based | |
459 | # on conditional paths below), so create a common note that will delay | |
460 | # the chord's completion until we activate it, and then activate it | |
461 | # after all the other notes have been created. | |
462 | set after_common_note [$after_chord add_note] | |
463 | ||
29a93660 | 464 | set path_list [list] |
fa38ab68 JG |
465 | set untracked_list [list] |
466 | ||
f522c9b5 SP |
467 | foreach path $paths { |
468 | switch -glob -- [lindex $file_states($path) 0] { | |
469 | U? {continue} | |
fa38ab68 JG |
470 | ?O { |
471 | lappend untracked_list $path | |
472 | } | |
f522c9b5 | 473 | ?M - |
e681cb7d | 474 | ?T - |
f522c9b5 | 475 | ?D { |
29a93660 | 476 | lappend path_list $path |
f522c9b5 | 477 | if {$path eq $current_diff_path} { |
fa38ab68 | 478 | $after_chord eval { set should_reshow_diff 1 } |
f522c9b5 SP |
479 | } |
480 | } | |
481 | } | |
482 | } | |
483 | ||
fa38ab68 JG |
484 | set path_cnt [llength $path_list] |
485 | set untracked_cnt [llength $untracked_list] | |
486 | ||
487 | # Asynchronous operation: revert changes by checking them out afresh | |
488 | # from the index. | |
489 | if {$path_cnt > 0} { | |
490 | # Split question between singular and plural cases, because | |
491 | # such distinction is needed in some languages. Previously, the | |
492 | # code used "Revert changes in" for both, but that can't work | |
493 | # in languages where 'in' must be combined with word from | |
494 | # rest of string (in different way for both cases of course). | |
495 | # | |
496 | # FIXME: Unfortunately, even that isn't enough in some languages | |
497 | # as they have quite complex plural-form rules. Unfortunately, | |
498 | # msgcat doesn't seem to support that kind of string | |
499 | # translation. | |
500 | # | |
501 | if {$path_cnt == 1} { | |
502 | set query [mc \ | |
503 | "Revert changes in file %s?" \ | |
504 | [short_path [lindex $path_list]] \ | |
505 | ] | |
506 | } else { | |
507 | set query [mc \ | |
508 | "Revert changes in these %i files?" \ | |
509 | $path_cnt] | |
510 | } | |
1ac17950 | 511 | |
fa38ab68 JG |
512 | set reply [tk_dialog \ |
513 | .confirm_revert \ | |
514 | "[appname] ([reponame])" \ | |
515 | "$query | |
516 | ||
517 | [mc "Any unstaged changes will be permanently lost by the revert."]" \ | |
518 | question \ | |
519 | 1 \ | |
520 | [mc "Do Nothing"] \ | |
521 | [mc "Revert Changes"] \ | |
522 | ] | |
523 | ||
524 | if {$reply == 1} { | |
8a8efbe4 | 525 | set note [$after_chord add_note] |
fa38ab68 JG |
526 | checkout_index \ |
527 | $txt \ | |
528 | $path_list \ | |
8a8efbe4 | 529 | [list $note activate] \ |
fa38ab68 JG |
530 | $capture_error |
531 | } | |
f522c9b5 SP |
532 | } |
533 | ||
fa38ab68 JG |
534 | # Asynchronous operation: Deletion of untracked files. |
535 | if {$untracked_cnt > 0} { | |
536 | # Split question between singular and plural cases, because | |
537 | # such distinction is needed in some languages. | |
538 | # | |
539 | # FIXME: Unfortunately, even that isn't enough in some languages | |
540 | # as they have quite complex plural-form rules. Unfortunately, | |
541 | # msgcat doesn't seem to support that kind of string | |
542 | # translation. | |
543 | # | |
544 | if {$untracked_cnt == 1} { | |
545 | set query [mc \ | |
546 | "Delete untracked file %s?" \ | |
547 | [short_path [lindex $untracked_list]] \ | |
548 | ] | |
549 | } else { | |
550 | set query [mc \ | |
551 | "Delete these %i untracked files?" \ | |
552 | $untracked_cnt \ | |
553 | ] | |
554 | } | |
d4544601 | 555 | |
fa38ab68 JG |
556 | set reply [tk_dialog \ |
557 | .confirm_revert \ | |
558 | "[appname] ([reponame])" \ | |
559 | "$query | |
560 | ||
561 | [mc "Files will be permanently deleted."]" \ | |
562 | question \ | |
563 | 1 \ | |
564 | [mc "Do Nothing"] \ | |
565 | [mc "Delete Files"] \ | |
566 | ] | |
567 | ||
568 | if {$reply == 1} { | |
569 | $after_chord eval { set should_reshow_diff 1 } | |
570 | ||
8a8efbe4 PY |
571 | set note [$after_chord add_note] |
572 | delete_files $untracked_list [list $note activate] | |
fa38ab68 JG |
573 | } |
574 | } | |
575 | ||
576 | # Activate the common note. If no other notes were created, this | |
577 | # completes the chord. If other notes were created, then this common | |
578 | # note prevents a race condition where the chord might complete early. | |
8a8efbe4 | 579 | $after_common_note activate |
fa38ab68 JG |
580 | } |
581 | ||
582 | # Delete all of the specified files, performing deletion in batches to allow the | |
583 | # UI to remain responsive and updated. | |
584 | proc delete_files {path_list after} { | |
585 | # Enable progress bar status updates | |
586 | set status_bar_operation [$::main_status \ | |
587 | start \ | |
588 | [mc "Deleting"] \ | |
589 | [mc "files"]] | |
590 | ||
591 | set path_index 0 | |
592 | set deletion_errors [list] | |
593 | set batch_size 50 | |
594 | ||
595 | delete_helper \ | |
596 | $path_list \ | |
597 | $path_index \ | |
598 | $deletion_errors \ | |
599 | $batch_size \ | |
600 | $status_bar_operation \ | |
601 | $after | |
602 | } | |
603 | ||
604 | # Helper function to delete a list of files in batches. Each call deletes one | |
605 | # batch of files, and then schedules a call for the next batch after any UI | |
606 | # messages have been processed. | |
607 | proc delete_helper {path_list path_index deletion_errors batch_size \ | |
608 | status_bar_operation after} { | |
609 | global file_states | |
610 | ||
611 | set path_cnt [llength $path_list] | |
612 | ||
613 | set batch_remaining $batch_size | |
614 | ||
615 | while {$batch_remaining > 0} { | |
616 | if {$path_index >= $path_cnt} { break } | |
617 | ||
618 | set path [lindex $path_list $path_index] | |
619 | ||
620 | set deletion_failed [catch {file delete -- $path} deletion_error] | |
621 | ||
622 | if {$deletion_failed} { | |
623 | lappend deletion_errors [list "$deletion_error"] | |
624 | } else { | |
625 | remove_empty_directories [file dirname $path] | |
626 | ||
627 | # Don't assume the deletion worked. Remove the file from | |
628 | # the UI, but only if it no longer exists. | |
629 | if {![path_exists $path]} { | |
630 | unset file_states($path) | |
631 | display_file $path __ | |
632 | } | |
633 | } | |
634 | ||
635 | incr path_index 1 | |
636 | incr batch_remaining -1 | |
637 | } | |
638 | ||
639 | # Update the progress bar to indicate that this batch has been | |
640 | # completed. The update will be visible when this procedure returns | |
641 | # and allows the UI thread to process messages. | |
642 | $status_bar_operation update $path_index $path_cnt | |
643 | ||
644 | if {$path_index < $path_cnt} { | |
645 | # The Tcler's Wiki lists this as the best practice for keeping | |
646 | # a UI active and processing messages during a long-running | |
647 | # operation. | |
648 | ||
649 | after idle [list after 0 [list \ | |
650 | delete_helper \ | |
29a93660 | 651 | $path_list \ |
fa38ab68 JG |
652 | $path_index \ |
653 | $deletion_errors \ | |
654 | $batch_size \ | |
655 | $status_bar_operation \ | |
656 | $after | |
657 | ]] | |
f522c9b5 | 658 | } else { |
fa38ab68 JG |
659 | # Finish the status bar operation. |
660 | $status_bar_operation stop | |
661 | ||
662 | # Report error, if any, based on how many deletions failed. | |
663 | set deletion_error_cnt [llength $deletion_errors] | |
664 | ||
665 | if {($deletion_error_cnt > 0) | |
666 | && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} { | |
667 | set error_text [mc "Encountered errors deleting files:\n"] | |
668 | ||
669 | foreach deletion_error $deletion_errors { | |
670 | append error_text "* [lindex $deletion_error 0]\n" | |
671 | } | |
672 | ||
673 | error_popup $error_text | |
674 | } elseif {$deletion_error_cnt == $path_cnt} { | |
675 | error_popup [mc \ | |
676 | "None of the %d selected files could be deleted." \ | |
677 | $path_cnt \ | |
678 | ] | |
679 | } elseif {$deletion_error_cnt > 1} { | |
680 | error_popup [mc \ | |
681 | "%d of the %d selected files could not be deleted." \ | |
682 | $deletion_error_cnt \ | |
683 | $path_cnt \ | |
684 | ] | |
685 | } | |
686 | ||
687 | uplevel #0 $after | |
688 | } | |
689 | } | |
690 | ||
691 | proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; } | |
692 | ||
693 | # This function is from the TCL documentation: | |
694 | # | |
695 | # https://wiki.tcl-lang.org/page/file+exists | |
696 | # | |
697 | # [file exists] returns false if the path does exist but is a symlink to a path | |
698 | # that doesn't exist. This proc returns true if the path exists, regardless of | |
699 | # whether it is a symlink and whether it is broken. | |
700 | proc path_exists {name} { | |
701 | expr {![catch {file lstat $name finfo}]} | |
702 | } | |
703 | ||
704 | # Remove as many empty directories as we can starting at the specified path, | |
705 | # walking up the directory tree. If we encounter a directory that is not | |
706 | # empty, or if a directory deletion fails, then we stop the operation and | |
707 | # return to the caller. Even if this procedure fails to delete any | |
708 | # directories at all, it does not report failure. | |
709 | proc remove_empty_directories {directory_path} { | |
710 | set parent_path [file dirname $directory_path] | |
711 | ||
712 | while {$parent_path != $directory_path} { | |
713 | set contents [glob -nocomplain -dir $directory_path *] | |
714 | ||
715 | if {[llength $contents] > 0} { break } | |
716 | if {[catch {file delete -- $directory_path}]} { break } | |
717 | ||
718 | set directory_path $parent_path | |
719 | set parent_path [file dirname $directory_path] | |
f522c9b5 SP |
720 | } |
721 | } | |
722 | ||
723 | proc do_revert_selection {} { | |
724 | global current_diff_path selected_paths | |
725 | ||
726 | if {[array size selected_paths] > 0} { | |
727 | revert_helper \ | |
700e5603 | 728 | [mc "Reverting selected files"] \ |
f522c9b5 SP |
729 | [array names selected_paths] |
730 | } elseif {$current_diff_path ne {}} { | |
731 | revert_helper \ | |
700e5603 | 732 | [mc "Reverting %s" [short_path $current_diff_path]] \ |
f522c9b5 SP |
733 | [list $current_diff_path] |
734 | } | |
735 | } | |
736 | ||
737 | proc do_select_commit_type {} { | |
ba41b5b3 | 738 | global commit_type commit_type_is_amend |
f522c9b5 | 739 | |
ba41b5b3 | 740 | if {$commit_type_is_amend == 0 |
f522c9b5 SP |
741 | && [string match amend* $commit_type]} { |
742 | create_new_commit | |
ba41b5b3 | 743 | } elseif {$commit_type_is_amend == 1 |
f522c9b5 SP |
744 | && ![string match amend* $commit_type]} { |
745 | load_last_commit | |
746 | ||
747 | # The amend request was rejected... | |
748 | # | |
749 | if {![string match amend* $commit_type]} { | |
ba41b5b3 | 750 | set commit_type_is_amend 0 |
f522c9b5 SP |
751 | } |
752 | } | |
753 | } |