git

1
# git-gui index (add/remove) support
2
# Copyright (C) 2006, 2007 Shawn Pearce
3

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

10
proc 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

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
60

61
	$::main_status stop_all
62
	unlock_index
63
	rescan [concat $after {ui_ready;}] 0
64
}
65

66
proc update_indexinfo {msg path_list after} {
67
	global update_index_cp
68

69
	if {![lock_index update]} return
70

71
	set update_index_cp 0
72
	set path_list [lsort $path_list]
73
	set total_cnt [llength $path_list]
74
	set batch [expr {int($total_cnt * .01) + 1}]
75
	if {$batch > 25} {set batch 25}
76

77
	set status_bar_operation [$::main_status start $msg [mc "files"]]
78
	set fd [git_write update-index -z --index-info]
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 \
88
		$path_list \
89
		$total_cnt \
90
		$batch \
91
		$status_bar_operation \
92
		$after \
93
		]
94
}
95

96
proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \
97
	after} {
98
	global update_index_cp
99
	global file_states current_diff_path
100

101
	if {$update_index_cp >= $total_cnt} {
102
		$status_bar_operation stop
103
		close_and_unlock_index $fd $after
104
		return
105
	}
106

107
	for {set i $batch} \
108
		{$update_index_cp < $total_cnt && $i > 0} \
109
		{incr i -1} {
110
		set path [lindex $path_list $update_index_cp]
111
		incr update_index_cp
112

113
		set s $file_states($path)
114
		switch -glob -- [lindex $s 0] {
115
		A? {set new _O}
116
		MT -
117
		TM -
118
		T_ {set new _T}
119
		M? {set new _M}
120
		TD -
121
		D_ {set new _D}
122
		D? {set new _?}
123
		?? {continue}
124
		}
125
		set info [lindex $s 2]
126
		if {$info eq {}} continue
127

128
		puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0"
129
		display_file $path $new
130
	}
131

132
	$status_bar_operation update $update_index_cp $total_cnt
133
}
134

135
proc update_index {msg path_list after} {
136
	global update_index_cp
137

138
	if {![lock_index update]} return
139

140
	set update_index_cp 0
141
	set path_list [lsort $path_list]
142
	set total_cnt [llength $path_list]
143
	set batch [expr {int($total_cnt * .01) + 1}]
144
	if {$batch > 25} {set batch 25}
145

146
	set status_bar_operation [$::main_status start $msg [mc "files"]]
147
	set fd [git_write update-index --add --remove -z --stdin]
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 \
157
		$path_list \
158
		$total_cnt \
159
		$batch \
160
		$status_bar_operation \
161
		$after \
162
		]
163
}
164

165
proc write_update_index {fd path_list total_cnt batch status_bar_operation \
166
	after} {
167
	global update_index_cp
168
	global file_states current_diff_path
169

170
	if {$update_index_cp >= $total_cnt} {
171
		$status_bar_operation stop
172
		close_and_unlock_index $fd $after
173
		return
174
	}
175

176
	for {set i $batch} \
177
		{$update_index_cp < $total_cnt && $i > 0} \
178
		{incr i -1} {
179
		set path [lindex $path_list $update_index_cp]
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 -
186
		AT -
187
		AM {set new A_}
188
		TM -
189
		MT -
190
		_T {set new T_}
191
		_U -
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
		}
202
		puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
203
		display_file $path $new
204
	}
205

206
	$status_bar_operation update $update_index_cp $total_cnt
207
}
208

209
proc checkout_index {msg path_list after capture_error} {
210
	global update_index_cp
211

212
	if {![lock_index update]} return
213

214
	set update_index_cp 0
215
	set path_list [lsort $path_list]
216
	set total_cnt [llength $path_list]
217
	set batch [expr {int($total_cnt * .01) + 1}]
218
	if {$batch > 25} {set batch 25}
219

220
	set status_bar_operation [$::main_status start $msg [mc "files"]]
221
	set fd [git_write checkout-index \
222
		--index \
223
		--quiet \
224
		--force \
225
		-z \
226
		--stdin \
227
		]
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 \
237
		$path_list \
238
		$total_cnt \
239
		$batch \
240
		$status_bar_operation \
241
		$after \
242
		$capture_error \
243
		]
244
}
245

246
proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \
247
	after capture_error} {
248
	global update_index_cp
249
	global file_states current_diff_path
250

251
	if {$update_index_cp >= $total_cnt} {
252
		$status_bar_operation stop
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

269
		return
270
	}
271

272
	for {set i $batch} \
273
		{$update_index_cp < $total_cnt && $i > 0} \
274
		{incr i -1} {
275
		set path [lindex $path_list $update_index_cp]
276
		incr update_index_cp
277
		switch -glob -- [lindex $file_states($path) 0] {
278
		U? {continue}
279
		?M -
280
		?T -
281
		?D {
282
			puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
283
			display_file $path ?_
284
		}
285
		}
286
	}
287

288
	$status_bar_operation update $update_index_cp $total_cnt
289
}
290

291
proc unstage_helper {txt paths} {
292
	global file_states current_diff_path
293

294
	if {![lock_index begin-update]} return
295

296
	set path_list [list]
297
	set after {}
298
	foreach path $paths {
299
		switch -glob -- [lindex $file_states($path) 0] {
300
		A? -
301
		M? -
302
		T? -
303
		D? {
304
			lappend path_list $path
305
			if {$path eq $current_diff_path} {
306
				set after {reshow_diff;}
307
			}
308
		}
309
		}
310
	}
311
	if {$path_list eq {}} {
312
		unlock_index
313
	} else {
314
		update_indexinfo \
315
			$txt \
316
			$path_list \
317
			[concat $after {ui_ready;}]
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 \
326
			[mc "Unstaging selected files from commit"] \
327
			[array names selected_paths]
328
	} elseif {$current_diff_path ne {}} {
329
		unstage_helper \
330
			[mc "Unstaging %s from commit" [short_path $current_diff_path]] \
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

340
	set path_list [list]
341
	set after {}
342
	foreach path $paths {
343
		switch -glob -- [lindex $file_states($path) 0] {
344
		_U -
345
		U? {
346
			if {$path eq $current_diff_path} {
347
				unlock_index
348
				merge_stage_workdir $path
349
				return
350
			}
351
		}
352
		_O -
353
		?M -
354
		?D -
355
		?T {
356
			lappend path_list $path
357
			if {$path eq $current_diff_path} {
358
				set after {reshow_diff;}
359
			}
360
		}
361
		}
362
	}
363
	if {$path_list eq {}} {
364
		unlock_index
365
	} else {
366
		update_index \
367
			$txt \
368
			$path_list \
369
			[concat $after {ui_status [mc "Ready to commit."];}]
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 \
378
			[mc "Adding selected files"] \
379
			[array names selected_paths]
380
	} elseif {$current_diff_path ne {}} {
381
		add_helper \
382
			[mc "Adding %s" [short_path $current_diff_path]] \
383
			[list $current_diff_path]
384
	}
385
}
386

387
proc do_add_all {} {
388
	global file_states
389

390
	set paths [list]
391
	set untracked_paths [list]
392
	foreach path [array names file_states] {
393
		switch -glob -- [lindex $file_states($path) 0] {
394
		U? {continue}
395
		?M -
396
		?T -
397
		?D {lappend paths $path}
398
		?O {lappend untracked_paths $path}
399
		}
400
	}
401
	if {[llength $untracked_paths]} {
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 {
412
			set reply [ask_popup [mc "Stage %d untracked files?" \
413
									  [llength $untracked_paths]]]
414
		}
415
		}
416
		if {$reply} {
417
			set paths [concat $paths $untracked_paths]
418
		}
419
	}
420
	add_helper [mc "Adding all changed files"] $paths
421
}
422

423
# Copied from TclLib package "lambda".
424
proc lambda {arguments body args} {
425
	return [list ::apply [list $arguments $body] {*}$args]
426
}
427

428
proc revert_helper {txt paths} {
429
	global file_states current_diff_path
430

431
	if {![lock_index begin-update]} return
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 {[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

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.
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 \
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

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]
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 \
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

737
proc 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
}
754