freshlybakedca.ke
Git fork
1# git-gui index (add/remove) support
2# Copyright (C) 2006, 2007 Shawn Pearce
3
4proc _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
10proc close_and_unlock_index {fd after} {
11 if {![catch {_close_updateindex $fd} err]} {
12 unlock_index
13 uplevel #0 $after
14 } else {
15 rescan_on_error $err $after
16 }
17}
18
19proc _close_updateindex {fd} {
20 fconfigure $fd -blocking 1
21 close $fd
22}
23
24proc rescan_on_error {err {after {}}} {
25 set w .indexfried
26 Dialog $w
27 wm withdraw $w
28 wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
29 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
30 set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."]
31 text $w.msg -yscrollcommand [list $w.vs set] \
32 -width [string length $s] -relief flat \
33 -borderwidth 0 -highlightthickness 0 \
34 -background [get_bg_color $w]
35 $w.msg tag configure bold -font font_uibold -justify center
36 ttk::scrollbar $w.vs -command [list $w.msg yview]
37 $w.msg insert end $s bold \n\n$err {}
38 $w.msg configure -state disabled
39
40 ttk::button $w.continue \
41 -text [mc "Continue"] \
42 -command [list destroy $w]
43 ttk::button $w.unlock \
44 -text [mc "Unlock Index"] \
45 -command "destroy $w; _delete_indexlock"
46 grid $w.msg - $w.vs -sticky news
47 grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2
48 grid columnconfigure $w 0 -weight 1
49 grid rowconfigure $w 0 -weight 1
50
51 wm protocol $w WM_DELETE_WINDOW update
52 bind $w.continue <Visibility> "
53 grab $w
54 focus %W
55 "
56 wm deiconify $w
57 tkwait window $w
58
59 $::main_status stop_all
60 unlock_index
61 rescan [concat $after {ui_ready;}] 0
62}
63
64proc update_indexinfo {msg path_list after} {
65 global update_index_cp
66
67 if {![lock_index update]} return
68
69 set update_index_cp 0
70 set path_list [lsort $path_list]
71 set total_cnt [llength $path_list]
72 set batch [expr {int($total_cnt * .01) + 1}]
73 if {$batch > 25} {set batch 25}
74
75 set status_bar_operation [$::main_status start $msg [mc "files"]]
76 set fd [git_write [list update-index -z --index-info]]
77 fconfigure $fd \
78 -blocking 0 \
79 -buffering full \
80 -buffersize 512 \
81 -translation binary
82 fileevent $fd writable [list \
83 write_update_indexinfo \
84 $fd \
85 $path_list \
86 $total_cnt \
87 $batch \
88 $status_bar_operation \
89 $after \
90 ]
91}
92
93proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \
94 after} {
95 global update_index_cp
96 global file_states current_diff_path
97
98 if {$update_index_cp >= $total_cnt} {
99 $status_bar_operation stop
100 close_and_unlock_index $fd $after
101 return
102 }
103
104 for {set i $batch} \
105 {$update_index_cp < $total_cnt && $i > 0} \
106 {incr i -1} {
107 set path [lindex $path_list $update_index_cp]
108 incr update_index_cp
109
110 set s $file_states($path)
111 switch -glob -- [lindex $s 0] {
112 A? {set new _O}
113 MT -
114 TM -
115 T_ {set new _T}
116 M? {set new _M}
117 TD -
118 D_ {set new _D}
119 D? {set new _?}
120 ?? {continue}
121 }
122 set info [lindex $s 2]
123 if {$info eq {}} continue
124
125 puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0"
126 display_file $path $new
127 }
128
129 $status_bar_operation update $update_index_cp $total_cnt
130}
131
132proc update_index {msg path_list after} {
133 global update_index_cp
134
135 if {![lock_index update]} return
136
137 set update_index_cp 0
138 set path_list [lsort $path_list]
139 set total_cnt [llength $path_list]
140 set batch [expr {int($total_cnt * .01) + 1}]
141 if {$batch > 25} {set batch 25}
142
143 set status_bar_operation [$::main_status start $msg [mc "files"]]
144 set fd [git_write [list update-index --add --remove -z --stdin]]
145 fconfigure $fd \
146 -blocking 0 \
147 -buffering full \
148 -buffersize 512 \
149 -translation binary
150 fileevent $fd writable [list \
151 write_update_index \
152 $fd \
153 $path_list \
154 $total_cnt \
155 $batch \
156 $status_bar_operation \
157 $after \
158 ]
159}
160
161proc write_update_index {fd path_list total_cnt batch status_bar_operation \
162 after} {
163 global update_index_cp
164 global file_states current_diff_path
165
166 if {$update_index_cp >= $total_cnt} {
167 $status_bar_operation stop
168 close_and_unlock_index $fd $after
169 return
170 }
171
172 for {set i $batch} \
173 {$update_index_cp < $total_cnt && $i > 0} \
174 {incr i -1} {
175 set path [lindex $path_list $update_index_cp]
176 incr update_index_cp
177
178 switch -glob -- [lindex $file_states($path) 0] {
179 AD {set new __}
180 ?D {set new D_}
181 _O -
182 AT -
183 AM {set new A_}
184 TM -
185 MT -
186 _T {set new T_}
187 _U -
188 U? {
189 if {[file exists $path]} {
190 set new M_
191 } else {
192 set new D_
193 }
194 }
195 ?M {set new M_}
196 ?? {continue}
197 }
198 puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
199 display_file $path $new
200 }
201
202 $status_bar_operation update $update_index_cp $total_cnt
203}
204
205proc checkout_index {msg path_list after capture_error} {
206 global update_index_cp
207
208 if {![lock_index update]} return
209
210 set update_index_cp 0
211 set path_list [lsort $path_list]
212 set total_cnt [llength $path_list]
213 set batch [expr {int($total_cnt * .01) + 1}]
214 if {$batch > 25} {set batch 25}
215
216 set status_bar_operation [$::main_status start $msg [mc "files"]]
217 set fd [git_write [list checkout-index \
218 --index \
219 --quiet \
220 --force \
221 -z \
222 --stdin \
223 ]]
224 fconfigure $fd \
225 -blocking 0 \
226 -buffering full \
227 -buffersize 512 \
228 -translation binary
229 fileevent $fd writable [list \
230 write_checkout_index \
231 $fd \
232 $path_list \
233 $total_cnt \
234 $batch \
235 $status_bar_operation \
236 $after \
237 $capture_error \
238 ]
239}
240
241proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \
242 after capture_error} {
243 global update_index_cp
244 global file_states current_diff_path
245
246 if {$update_index_cp >= $total_cnt} {
247 $status_bar_operation stop
248
249 # We do not unlock the index directly here because this
250 # operation expects to potentially run in parallel with file
251 # deletions scheduled by revert_helper. We're done with the
252 # update index, so we close it, but actually unlocking the index
253 # and dealing with potential errors is deferred to the chord
254 # body that runs when all async operations are completed.
255 #
256 # (See after_chord in revert_helper.)
257
258 if {[catch {_close_updateindex $fd} err]} {
259 uplevel #0 $capture_error [list $err]
260 }
261
262 uplevel #0 $after
263
264 return
265 }
266
267 for {set i $batch} \
268 {$update_index_cp < $total_cnt && $i > 0} \
269 {incr i -1} {
270 set path [lindex $path_list $update_index_cp]
271 incr update_index_cp
272 switch -glob -- [lindex $file_states($path) 0] {
273 U? {continue}
274 ?M -
275 ?T -
276 ?D {
277 puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
278 display_file $path ?_
279 }
280 }
281 }
282
283 $status_bar_operation update $update_index_cp $total_cnt
284}
285
286proc unstage_helper {txt paths} {
287 global file_states current_diff_path
288
289 if {![lock_index begin-update]} return
290
291 set path_list [list]
292 set after {}
293 foreach path $paths {
294 switch -glob -- [lindex $file_states($path) 0] {
295 A? -
296 M? -
297 T? -
298 D? {
299 lappend path_list $path
300 if {$path eq $current_diff_path} {
301 set after {reshow_diff;}
302 }
303 }
304 }
305 }
306 if {$path_list eq {}} {
307 unlock_index
308 } else {
309 update_indexinfo \
310 $txt \
311 $path_list \
312 [concat $after {ui_ready;}]
313 }
314}
315
316proc do_unstage_selection {} {
317 global current_diff_path selected_paths
318
319 if {[array size selected_paths] > 0} {
320 unstage_helper \
321 [mc "Unstaging selected files from commit"] \
322 [array names selected_paths]
323 } elseif {$current_diff_path ne {}} {
324 unstage_helper \
325 [mc "Unstaging %s from commit" [short_path $current_diff_path]] \
326 [list $current_diff_path]
327 }
328}
329
330proc add_helper {txt paths} {
331 global file_states current_diff_path
332
333 if {![lock_index begin-update]} return
334
335 set path_list [list]
336 set after {}
337 foreach path $paths {
338 switch -glob -- [lindex $file_states($path) 0] {
339 _U -
340 U? {
341 if {$path eq $current_diff_path} {
342 unlock_index
343 merge_stage_workdir $path
344 return
345 }
346 }
347 _O -
348 ?M -
349 ?D -
350 ?T {
351 lappend path_list $path
352 if {$path eq $current_diff_path} {
353 set after {reshow_diff;}
354 }
355 }
356 }
357 }
358 if {$path_list eq {}} {
359 unlock_index
360 } else {
361 update_index \
362 $txt \
363 $path_list \
364 [concat $after {ui_status [mc "Ready to commit."];}]
365 }
366}
367
368proc do_add_selection {} {
369 global current_diff_path selected_paths
370
371 if {[array size selected_paths] > 0} {
372 add_helper \
373 [mc "Adding selected files"] \
374 [array names selected_paths]
375 } elseif {$current_diff_path ne {}} {
376 add_helper \
377 [mc "Adding %s" [short_path $current_diff_path]] \
378 [list $current_diff_path]
379 }
380}
381
382proc do_add_all {} {
383 global file_states
384
385 set paths [list]
386 set untracked_paths [list]
387 foreach path [array names file_states] {
388 switch -glob -- [lindex $file_states($path) 0] {
389 U? {continue}
390 ?M -
391 ?T -
392 ?D {lappend paths $path}
393 ?O {lappend untracked_paths $path}
394 }
395 }
396 if {[llength $untracked_paths]} {
397 set reply 0
398 switch -- [get_config gui.stageuntracked] {
399 no {
400 set reply 0
401 }
402 yes {
403 set reply 1
404 }
405 ask -
406 default {
407 set reply [ask_popup [mc "Stage %d untracked files?" \
408 [llength $untracked_paths]]]
409 }
410 }
411 if {$reply} {
412 set paths [concat $paths $untracked_paths]
413 }
414 }
415 add_helper [mc "Adding all changed files"] $paths
416}
417
418# Copied from TclLib package "lambda".
419proc lambda {arguments body args} {
420 return [list ::apply [list $arguments $body] {*}$args]
421}
422
423proc revert_helper {txt paths} {
424 global file_states current_diff_path
425
426 if {![lock_index begin-update]} return
427
428 # Workaround for Tcl < 9.0: chord namespaces are not obeyed and
429 # operated in the global namespace. This clears an error that could
430 # have been left over from a previous operation.
431 set ::err {}
432
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.
439 set after_chord [SimpleChord::new {
440 if {[info exists err] && [string trim $err] ne ""} {
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
464 set path_list [list]
465 set untracked_list [list]
466
467 foreach path $paths {
468 switch -glob -- [lindex $file_states($path) 0] {
469 U? {continue}
470 ?O {
471 lappend untracked_list $path
472 }
473 ?M -
474 ?T -
475 ?D {
476 lappend path_list $path
477 if {$path eq $current_diff_path} {
478 $after_chord eval { set should_reshow_diff 1 }
479 }
480 }
481 }
482 }
483
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 }
511
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} {
525 set note [$after_chord add_note]
526 checkout_index \
527 $txt \
528 $path_list \
529 [list $note activate] \
530 $capture_error
531 }
532 }
533
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 }
555
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
571 set note [$after_chord add_note]
572 delete_files $untracked_list [list $note activate]
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.
579 $after_common_note activate
580}
581
582# Delete all of the specified files, performing deletion in batches to allow the
583# UI to remain responsive and updated.
584proc 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.
607proc 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 \
651 $path_list \
652 $path_index \
653 $deletion_errors \
654 $batch_size \
655 $status_bar_operation \
656 $after
657 ]]
658 } else {
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
691proc 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.
700proc 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.
709proc 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]
720 }
721}
722
723proc do_revert_selection {} {
724 global current_diff_path selected_paths
725
726 if {[array size selected_paths] > 0} {
727 revert_helper \
728 [mc "Reverting selected files"] \
729 [array names selected_paths]
730 } elseif {$current_diff_path ne {}} {
731 revert_helper \
732 [mc "Reverting %s" [short_path $current_diff_path]] \
733 [list $current_diff_path]
734 }
735}
736
737proc do_select_commit_type {} {
738 global commit_type commit_type_is_amend
739
740 if {$commit_type_is_amend == 0
741 && [string match amend* $commit_type]} {
742 create_new_commit
743 } elseif {$commit_type_is_amend == 1
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]} {
750 set commit_type_is_amend 0
751 }
752 }
753}