git-gui.sh 108.3 KB
Newer Older
1
#!/bin/sh
S
Shawn O. Pearce 已提交
2 3 4
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"

5
set appvers {@@GIT_VERSION@@}
6
set copyright {
7
Copyright  2006, 2007 Shawn Pearce, Paul Mackerras.
8

9 10 11 12 13 14 15 16 17 18 19 20 21
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
S
Shawn O. Pearce 已提交
22

23 24 25 26 27 28 29 30 31 32 33 34 35
######################################################################
##
## read only globals

set _appname [lindex [file split $argv0] end]
set _gitdir {}
set _reponame {}

proc appname {} {
	global _appname
	return $_appname
}

36
proc gitdir {args} {
37
	global _gitdir
38 39 40 41
	if {$args eq {}} {
		return $_gitdir
	}
	return [eval [concat [list file join $_gitdir] $args]]
42 43 44 45 46 47
}

proc reponame {} {
	global _reponame
	return $_reponame
}
48

49 50 51 52
######################################################################
##
## config

53 54 55 56 57 58 59 60 61
proc is_many_config {name} {
	switch -glob -- $name {
	remote.*.fetch -
	remote.*.push
		{return 1}
	*
		{return 0}
	}
}
62

63
proc load_config {include_global} {
64 65 66
	global repo_config global_config default_config

	array unset global_config
67 68 69 70 71 72 73 74 75 76
	if {$include_global} {
		catch {
			set fd_rc [open "| git repo-config --global --list" r]
			while {[gets $fd_rc line] >= 0} {
				if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
					if {[is_many_config $name]} {
						lappend global_config($name) $value
					} else {
						set global_config($name) $value
					}
77 78
				}
			}
79
			close $fd_rc
80 81
		}
	}
82 83

	array unset repo_config
84 85 86 87
	catch {
		set fd_rc [open "| git repo-config --list" r]
		while {[gets $fd_rc line] >= 0} {
			if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
88 89 90 91 92
				if {[is_many_config $name]} {
					lappend repo_config($name) $value
				} else {
					set repo_config($name) $value
				}
93 94 95 96 97
			}
		}
		close $fd_rc
	}

98 99 100 101 102 103 104
	foreach name [array names default_config] {
		if {[catch {set v $global_config($name)}]} {
			set global_config($name) $default_config($name)
		}
		if {[catch {set v $repo_config($name)}]} {
			set repo_config($name) $default_config($name)
		}
105 106 107
	}
}

108
proc save_config {} {
109 110
	global default_config font_descs
	global repo_config global_config
111
	global repo_config_new global_config_new
112

113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
	foreach option $font_descs {
		set name [lindex $option 0]
		set font [lindex $option 1]
		font configure $font \
			-family $global_config_new(gui.$font^^family) \
			-size $global_config_new(gui.$font^^size)
		font configure ${font}bold \
			-family $global_config_new(gui.$font^^family) \
			-size $global_config_new(gui.$font^^size)
		set global_config_new(gui.$name) [font configure $font]
		unset global_config_new(gui.$font^^family)
		unset global_config_new(gui.$font^^size)
	}

	foreach name [array names default_config] {
128
		set value $global_config_new($name)
129 130
		if {$value ne $global_config($name)} {
			if {$value eq $default_config($name)} {
131 132
				catch {exec git repo-config --global --unset $name}
			} else {
133 134
				regsub -all "\[{}\]" $value {"} value
				exec git repo-config --global $name $value
135 136
			}
			set global_config($name) $value
137
			if {$value eq $repo_config($name)} {
138 139 140 141
				catch {exec git repo-config --unset $name}
				set repo_config($name) $value
			}
		}
142 143
	}

144
	foreach name [array names default_config] {
145
		set value $repo_config_new($name)
146 147
		if {$value ne $repo_config($name)} {
			if {$value eq $global_config($name)} {
148 149
				catch {exec git repo-config --unset $name}
			} else {
150 151
				regsub -all "\[{}\]" $value {"} value
				exec git repo-config $name $value
152 153 154
			}
			set repo_config($name) $value
		}
155 156 157
	}
}

158
proc error_popup {msg} {
159 160 161
	set title [appname]
	if {[reponame] ne {}} {
		append title " ([reponame])"
162
	}
163
	set cmd [list tk_messageBox \
164 165 166
		-icon error \
		-type ok \
		-title "$title: error" \
167 168 169 170 171
		-message $msg]
	if {[winfo ismapped .]} {
		lappend cmd -parent .
	}
	eval $cmd
172 173
}

174
proc warn_popup {msg} {
175 176 177
	set title [appname]
	if {[reponame] ne {}} {
		append title " ([reponame])"
178 179 180 181 182 183 184 185 186 187 188 189
	}
	set cmd [list tk_messageBox \
		-icon warning \
		-type ok \
		-title "$title: warning" \
		-message $msg]
	if {[winfo ismapped .]} {
		lappend cmd -parent .
	}
	eval $cmd
}

190
proc info_popup {msg} {
191 192 193
	set title [appname]
	if {[reponame] ne {}} {
		append title " ([reponame])"
194 195 196
	}
	tk_messageBox \
		-parent . \
197
		-icon info \
198 199 200 201 202
		-type ok \
		-title $title \
		-message $msg
}

203
proc ask_popup {msg} {
204 205 206
	set title [appname]
	if {[reponame] ne {}} {
		append title " ([reponame])"
207 208 209 210 211 212 213 214 215
	}
	return [tk_messageBox \
		-parent . \
		-icon question \
		-type yesno \
		-title $title \
		-message $msg]
}

216 217 218 219
######################################################################
##
## repository setup

220 221
if {   [catch {set _gitdir $env(GIT_DIR)}]
	&& [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
222 223
	catch {wm withdraw .}
	error_popup "Cannot find the git directory:\n\n$err"
224 225
	exit 1
}
226
if {![file isdirectory $_gitdir]} {
227
	catch {wm withdraw .}
228
	error_popup "Git directory not found:\n\n$_gitdir"
229 230
	exit 1
}
231
if {[lindex [file split $_gitdir] end] ne {.git}} {
232 233 234 235
	catch {wm withdraw .}
	error_popup "Cannot use funny .git directory:\n\n$gitdir"
	exit 1
}
236
if {[catch {cd [file dirname $_gitdir]} err]} {
237
	catch {wm withdraw .}
238
	error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
239
	exit 1
240
}
241 242
set _reponame [lindex [file split \
	[file normalize [file dirname $_gitdir]]] \
243
	end]
244

245
set single_commit 0
246
if {[appname] eq {git-citool}} {
247 248 249
	set single_commit 1
}

S
Shawn O. Pearce 已提交
250 251
######################################################################
##
252
## task management
S
Shawn O. Pearce 已提交
253

254
set rescan_active 0
255
set diff_active 0
256
set last_clicked {}
257

258 259 260 261 262
set disable_on_lock [list]
set index_lock_type none

proc lock_index {type} {
	global index_lock_type disable_on_lock
263

264
	if {$index_lock_type eq {none}} {
265 266 267 268 269
		set index_lock_type $type
		foreach w $disable_on_lock {
			uplevel #0 $w disabled
		}
		return 1
270
	} elseif {$index_lock_type eq "begin-$type"} {
271
		set index_lock_type $type
272 273 274 275
		return 1
	}
	return 0
}
S
Shawn O. Pearce 已提交
276

277 278 279 280 281 282 283 284 285 286 287 288 289
proc unlock_index {} {
	global index_lock_type disable_on_lock

	set index_lock_type none
	foreach w $disable_on_lock {
		uplevel #0 $w normal
	}
}

######################################################################
##
## status

290
proc repository_state {ctvar hdvar mhvar} {
291
	global current_branch
292 293 294
	upvar $ctvar ct $hdvar hd $mhvar mh

	set mh [list]
295

296 297 298
	if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
		set current_branch {}
	} else {
299
		regsub ^refs/((heads|tags|remotes)/)? \
300 301 302 303 304
			$current_branch \
			{} \
			current_branch
	}

305
	if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
306
		set hd {}
307
		set ct initial
308 309 310
		return
	}

311
	set merge_head [gitdir MERGE_HEAD]
312
	if {[file exists $merge_head]} {
313
		set ct merge
314 315 316 317 318 319
		set fd_mh [open $merge_head r]
		while {[gets $fd_mh line] >= 0} {
			lappend mh $line
		}
		close $fd_mh
		return
320
	}
321 322

	set ct normal
323 324
}

325 326 327
proc PARENT {} {
	global PARENT empty_tree

328 329 330
	set p [lindex $PARENT 0]
	if {$p ne {}} {
		return $p
331 332 333 334 335 336 337
	}
	if {$empty_tree eq {}} {
		set empty_tree [exec git mktree << {}]
	}
	return $empty_tree
}

338
proc rescan {after {honor_trustmtime 1}} {
339
	global HEAD PARENT MERGE_HEAD commit_type
340
	global ui_index ui_workdir ui_status_value ui_comm
341
	global rescan_active file_states
342
	global repo_config
S
Shawn O. Pearce 已提交
343

344
	if {$rescan_active > 0 || ![lock_index read]} return
S
Shawn O. Pearce 已提交
345

346
	repository_state newType newHEAD newMERGE_HEAD
347
	if {[string match amend* $commit_type]
348 349
		&& $newType eq {normal}
		&& $newHEAD eq $HEAD} {
350
	} else {
351 352 353 354
		set HEAD $newHEAD
		set PARENT $newHEAD
		set MERGE_HEAD $newMERGE_HEAD
		set commit_type $newType
355 356
	}

S
Shawn O. Pearce 已提交
357 358
	array unset file_states

359
	if {![$ui_comm edit modified]
360
		|| [string trim [$ui_comm get 0.0 end]] eq {}} {
361 362 363 364
		if {[load_message GITGUI_MSG]} {
		} elseif {[load_message MERGE_MSG]} {
		} elseif {[load_message SQUASH_MSG]} {
		}
365
		$ui_comm edit reset
366
		$ui_comm edit modified false
367 368
	}

369
	if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
370
		rescan_stage2 {} $after
371
	} else {
372
		set rescan_active 1
373
		set ui_status_value {Refreshing file status...}
374 375 376 377 378 379
		set cmd [list git update-index]
		lappend cmd -q
		lappend cmd --unmerged
		lappend cmd --ignore-missing
		lappend cmd --refresh
		set fd_rf [open "| $cmd" r]
380
		fconfigure $fd_rf -blocking 0 -translation binary
381
		fileevent $fd_rf readable \
382
			[list rescan_stage2 $fd_rf $after]
383
	}
384 385
}

386
proc rescan_stage2 {fd after} {
387
	global ui_status_value
388
	global rescan_active buf_rdi buf_rdf buf_rlo
389

390
	if {$fd ne {}} {
391 392 393 394
		read $fd
		if {![eof $fd]} return
		close $fd
	}
395

S
Shawn O. Pearce 已提交
396 397
	set ls_others [list | git ls-files --others -z \
		--exclude-per-directory=.gitignore]
398
	set info_exclude [gitdir info exclude]
S
Shawn O. Pearce 已提交
399 400 401 402
	if {[file readable $info_exclude]} {
		lappend ls_others "--exclude-from=$info_exclude"
	}

403 404 405 406
	set buf_rdi {}
	set buf_rdf {}
	set buf_rlo {}

407
	set rescan_active 3
408
	set ui_status_value {Scanning for modified files ...}
409
	set fd_di [open "| git diff-index --cached -z [PARENT]" r]
S
Shawn O. Pearce 已提交
410 411 412
	set fd_df [open "| git diff-files -z" r]
	set fd_lo [open $ls_others r]

413 414 415
	fconfigure $fd_di -blocking 0 -translation binary -encoding binary
	fconfigure $fd_df -blocking 0 -translation binary -encoding binary
	fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
416 417 418
	fileevent $fd_di readable [list read_diff_index $fd_di $after]
	fileevent $fd_df readable [list read_diff_files $fd_df $after]
	fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
S
Shawn O. Pearce 已提交
419 420
}

421
proc load_message {file} {
422
	global ui_comm
423

424
	set f [gitdir $file]
425
	if {[file isfile $f]} {
426 427 428
		if {[catch {set fd [open $f r]}]} {
			return 0
		}
429
		set content [string trim [read $fd]]
430 431 432 433 434 435 436 437
		close $fd
		$ui_comm delete 0.0 end
		$ui_comm insert end $content
		return 1
	}
	return 0
}

438
proc read_diff_index {fd after} {
S
Shawn O. Pearce 已提交
439 440 441
	global buf_rdi

	append buf_rdi [read $fd]
442 443 444 445 446 447 448 449 450 451
	set c 0
	set n [string length $buf_rdi]
	while {$c < $n} {
		set z1 [string first "\0" $buf_rdi $c]
		if {$z1 == -1} break
		incr z1
		set z2 [string first "\0" $buf_rdi $z1]
		if {$z2 == -1} break

		incr c
452
		set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
453
		set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
454
		merge_state \
455
			[encoding convertfrom $p] \
456 457
			[lindex $i 4]? \
			[list [lindex $i 0] [lindex $i 2]] \
458 459
			[list]
		set c $z2
460
		incr c
S
Shawn O. Pearce 已提交
461
	}
462 463 464 465 466 467
	if {$c < $n} {
		set buf_rdi [string range $buf_rdi $c end]
	} else {
		set buf_rdi {}
	}

468
	rescan_done $fd buf_rdi $after
S
Shawn O. Pearce 已提交
469 470
}

471
proc read_diff_files {fd after} {
S
Shawn O. Pearce 已提交
472 473 474
	global buf_rdf

	append buf_rdf [read $fd]
475 476 477 478 479 480 481 482 483 484
	set c 0
	set n [string length $buf_rdf]
	while {$c < $n} {
		set z1 [string first "\0" $buf_rdf $c]
		if {$z1 == -1} break
		incr z1
		set z2 [string first "\0" $buf_rdf $z1]
		if {$z2 == -1} break

		incr c
485
		set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
486
		set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
487
		merge_state \
488
			[encoding convertfrom $p] \
489
			?[lindex $i 4] \
490
			[list] \
491
			[list [lindex $i 0] [lindex $i 2]]
492
		set c $z2
493
		incr c
494 495 496 497 498
	}
	if {$c < $n} {
		set buf_rdf [string range $buf_rdf $c end]
	} else {
		set buf_rdf {}
S
Shawn O. Pearce 已提交
499
	}
500

501
	rescan_done $fd buf_rdf $after
S
Shawn O. Pearce 已提交
502 503
}

504
proc read_ls_others {fd after} {
S
Shawn O. Pearce 已提交
505 506 507 508 509 510
	global buf_rlo

	append buf_rlo [read $fd]
	set pck [split $buf_rlo "\0"]
	set buf_rlo [lindex $pck end]
	foreach p [lrange $pck 0 end-1] {
511
		merge_state [encoding convertfrom $p] ?O
S
Shawn O. Pearce 已提交
512
	}
513
	rescan_done $fd buf_rlo $after
S
Shawn O. Pearce 已提交
514 515
}

516 517
proc rescan_done {fd buf after} {
	global rescan_active
518
	global file_states repo_config
519
	upvar $buf to_clear
S
Shawn O. Pearce 已提交
520

521 522 523
	if {![eof $fd]} return
	set to_clear {}
	close $fd
524
	if {[incr rescan_active -1] > 0} return
525

526
	prune_selection
527 528 529
	unlock_index
	display_all_files
	reshow_diff
530
	uplevel #0 $after
S
Shawn O. Pearce 已提交
531 532
}

533 534 535 536 537 538 539 540 541 542
proc prune_selection {} {
	global file_states selected_paths

	foreach path [array names selected_paths] {
		if {[catch {set still_here $file_states($path)}]} {
			unset selected_paths($path)
		}
	}
}

S
Shawn O. Pearce 已提交
543 544 545 546 547
######################################################################
##
## diff

proc clear_diff {} {
548
	global ui_diff current_diff_path ui_index ui_workdir
S
Shawn O. Pearce 已提交
549 550 551 552

	$ui_diff conf -state normal
	$ui_diff delete 0.0 end
	$ui_diff conf -state disabled
553

554
	set current_diff_path {}
555 556

	$ui_index tag remove in_diff 0.0 end
557
	$ui_workdir tag remove in_diff 0.0 end
S
Shawn O. Pearce 已提交
558 559
}

560
proc reshow_diff {} {
561
	global ui_status_value file_states file_lists
562
	global current_diff_path current_diff_side
563

564 565 566 567 568
	set p $current_diff_path
	if {$p eq {}
		|| $current_diff_side eq {}
		|| [catch {set s $file_states($p)}]
		|| [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
569
		clear_diff
570
	} else {
571
		show_diff $p $current_diff_side
572 573 574
	}
}

575
proc handle_empty_diff {} {
576
	global current_diff_path file_states file_lists
577

578
	set path $current_diff_path
579
	set s $file_states($path)
580
	if {[lindex $s 0] ne {_M}} return
581 582 583 584 585

	info_popup "No differences detected.

[short_path $path] has no changes.

586
The modification date of this file was updated
587 588 589 590 591
by another application, but the content within
the file was not changed.

A rescan will be automatically started to find
other files which may have the same state."
592 593

	clear_diff
594
	display_file $path __
595
	rescan {set ui_status_value {Ready.}} 0
596 597
}

598
proc show_diff {path w {lno {}}} {
599
	global file_states file_lists
600
	global is_3way_diff diff_active repo_config
601 602
	global ui_diff ui_status_value ui_index ui_workdir
	global current_diff_path current_diff_side
S
Shawn O. Pearce 已提交
603

604
	if {$diff_active || ![lock_index read]} return
S
Shawn O. Pearce 已提交
605 606

	clear_diff
607
	if {$w eq {} || $lno == {}} {
608 609 610 611 612 613 614 615
		foreach w [array names file_lists] {
			set lno [lsearch -sorted $file_lists($w) $path]
			if {$lno >= 0} {
				incr lno
				break
			}
		}
	}
616
	if {$w ne {} && $lno >= 1} {
617
		$w tag add in_diff $lno.0 [expr {$lno + 1}].0
618 619
	}

S
Shawn O. Pearce 已提交
620 621
	set s $file_states($path)
	set m [lindex $s 0]
622
	set is_3way_diff 0
S
Shawn O. Pearce 已提交
623
	set diff_active 1
624
	set current_diff_path $path
625
	set current_diff_side $w
626
	set ui_status_value "Loading diff of [escape_path $path]..."
S
Shawn O. Pearce 已提交
627

628 629 630
	# - Git won't give us the diff, there's nothing to compare to!
	#
	if {$m eq {_O}} {
631
		set max_sz [expr {128 * 1024}]
S
Shawn O. Pearce 已提交
632 633
		if {[catch {
				set fd [open $path r]
634
				set content [read $fd $max_sz]
S
Shawn O. Pearce 已提交
635
				close $fd
636
				set sz [file size $path]
S
Shawn O. Pearce 已提交
637
			} err ]} {
638
			set diff_active 0
639
			unlock_index
640
			set ui_status_value "Unable to display [escape_path $path]"
641
			error_popup "Error loading file:\n\n$err"
S
Shawn O. Pearce 已提交
642 643 644
			return
		}
		$ui_diff conf -state normal
645 646 647 648 649 650 651 652
		if {![catch {set type [exec file $path]}]} {
			set n [string length $path]
			if {[string equal -length $n $path $type]} {
				set type [string range $type $n end]
				regsub {^:?\s*} $type {} type
			}
			$ui_diff insert end "* $type\n" d_@
		}
653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671
		if {[string first "\0" $content] != -1} {
			$ui_diff insert end \
				"* Binary file (not showing content)." \
				d_@
		} else {
			if {$sz > $max_sz} {
				$ui_diff insert end \
"* Untracked file is $sz bytes.
* Showing only first $max_sz bytes.
" d_@
			}
			$ui_diff insert end $content
			if {$sz > $max_sz} {
				$ui_diff insert end "
* Untracked file clipped here by [appname].
* To see the entire file, use an external editor.
" d_@
			}
		}
S
Shawn O. Pearce 已提交
672
		$ui_diff conf -state disabled
673 674 675
		set diff_active 0
		unlock_index
		set ui_status_value {Ready.}
S
Shawn O. Pearce 已提交
676 677
		return
	}
678 679 680 681 682 683

	set cmd [list | git]
	if {$w eq $ui_index} {
		lappend cmd diff-index
		lappend cmd --cached
	} elseif {$w eq $ui_workdir} {
684 685 686 687 688
		if {[string index $m 0] eq {U}} {
			lappend cmd diff
		} else {
			lappend cmd diff-files
		}
S
Shawn O. Pearce 已提交
689 690
	}

691 692 693 694 695 696 697 698
	lappend cmd -p
	lappend cmd --no-color
	if {$repo_config(gui.diffcontext) > 0} {
		lappend cmd "-U$repo_config(gui.diffcontext)"
	}
	if {$w eq $ui_index} {
		lappend cmd [PARENT]
	}
699 700 701
	lappend cmd --
	lappend cmd $path

S
Shawn O. Pearce 已提交
702
	if {[catch {set fd [open $cmd r]} err]} {
703
		set diff_active 0
704
		unlock_index
705
		set ui_status_value "Unable to display [escape_path $path]"
706
		error_popup "Error loading diff:\n\n$err"
S
Shawn O. Pearce 已提交
707 708 709
		return
	}

710
	fconfigure $fd -blocking 0 -translation auto
S
Shawn O. Pearce 已提交
711 712 713 714
	fileevent $fd readable [list read_diff $fd]
}

proc read_diff {fd} {
715
	global ui_diff ui_status_value is_3way_diff diff_active
S
Shawn O. Pearce 已提交
716

717
	$ui_diff conf -state normal
S
Shawn O. Pearce 已提交
718
	while {[gets $fd line] >= 0} {
719 720 721
		# -- Cleanup uninteresting diff header lines.
		#
		if {[string match {diff --git *}      $line]} continue
722
		if {[string match {diff --cc *}       $line]} continue
723
		if {[string match {diff --combined *} $line]} continue
724 725
		if {[string match {--- *}             $line]} continue
		if {[string match {+++ *}             $line]} continue
726 727 728
		if {$line eq {deleted file mode 120000}} {
			set line "deleted symlink"
		}
S
Shawn O. Pearce 已提交
729

730 731 732 733
		# -- Automatically detect if this is a 3 way diff.
		#
		if {[string match {@@@ *} $line]} {set is_3way_diff 1}

734
		if {[string match {index *} $line]
735
			|| [string match {mode *} $line]
736 737
			|| [string match {new file *} $line]
			|| [string match {deleted file *} $line]
738
			|| [string match {Binary files * and * differ} $line]
739
			|| $line eq {\ No newline at end of file}
740
			|| [regexp {^\* Unmerged path } $line]} {
741 742
			set tags {}
		} elseif {$is_3way_diff} {
743 744
			set op [string range $line 0 1]
			switch -- $op {
745
			{  } {set tags {}}
746
			{@@} {set tags d_@}
747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763
			{ +} {set tags d_s+}
			{ -} {set tags d_s-}
			{+ } {set tags d_+s}
			{- } {set tags d_-s}
			{--} {set tags d_--}
			{++} {
				if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
					set line [string replace $line 0 1 {  }]
					set tags d$op
				} else {
					set tags d_++
				}
			}
			default {
				puts "error: Unhandled 3 way diff marker: {$op}"
				set tags {}
			}
S
Shawn O. Pearce 已提交
764 765
			}
		} else {
766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782
			set op [string index $line 0]
			switch -- $op {
			{ } {set tags {}}
			{@} {set tags d_@}
			{-} {set tags d_-}
			{+} {
				if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
					set line [string replace $line 0 0 { }]
					set tags d$op
				} else {
					set tags d_+
				}
			}
			default {
				puts "error: Unhandled 2 way diff marker: {$op}"
				set tags {}
			}
S
Shawn O. Pearce 已提交
783 784 785
			}
		}
		$ui_diff insert end $line $tags
786
		$ui_diff insert end "\n" $tags
S
Shawn O. Pearce 已提交
787
	}
788
	$ui_diff conf -state disabled
S
Shawn O. Pearce 已提交
789 790 791 792

	if {[eof $fd]} {
		close $fd
		set diff_active 0
793
		unlock_index
S
Shawn O. Pearce 已提交
794
		set ui_status_value {Ready.}
795

796
		if {[$ui_diff index end] eq {2.0}} {
797 798
			handle_empty_diff
		}
S
Shawn O. Pearce 已提交
799 800 801
	}
}

802 803 804 805
######################################################################
##
## commit

806
proc load_last_commit {} {
807
	global HEAD PARENT MERGE_HEAD commit_type ui_comm
808
	global repo_config
809

810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827
	if {[llength $PARENT] == 0} {
		error_popup {There is nothing to amend.

You are about to create the initial commit.
There is no commit before this to amend.
}
		return
	}

	repository_state curType curHEAD curMERGE_HEAD
	if {$curType eq {merge}} {
		error_popup {Cannot amend while merging.

You are currently in the middle of a merge that
has not been fully completed.  You cannot amend
the prior commit unless you first abort the
current merge activity.
}
828 829 830 831
		return
	}

	set msg {}
832
	set parents [list]
833
	if {[catch {
834
			set fd [open "| git cat-file commit $curHEAD" r]
835 836 837 838
			fconfigure $fd -encoding binary -translation lf
			if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
				set enc utf-8
			}
839 840
			while {[gets $fd line] > 0} {
				if {[string match {parent *} $line]} {
841
					lappend parents [string range $line 7 end]
842 843
				} elseif {[string match {encoding *} $line]} {
					set enc [string tolower [string range $line 9 end]]
844 845
				}
			}
846
			fconfigure $fd -encoding $enc
847 848 849
			set msg [string trim [read $fd]]
			close $fd
		} err]} {
850
		error_popup "Error loading commit data for amend:\n\n$err"
851 852 853
		return
	}

854 855 856 857 858 859 860
	set HEAD $curHEAD
	set PARENT $parents
	set MERGE_HEAD [list]
	switch -- [llength $parents] {
	0       {set commit_type amend-initial}
	1       {set commit_type amend}
	default {set commit_type amend-merge}
861
	}
862 863 864 865

	$ui_comm delete 0.0 end
	$ui_comm insert end $msg
	$ui_comm edit reset
866
	$ui_comm edit modified false
867
	rescan {set ui_status_value {Ready.}}
868 869
}

870 871 872 873 874 875
proc create_new_commit {} {
	global commit_type ui_comm

	set commit_type normal
	$ui_comm delete 0.0 end
	$ui_comm edit reset
876
	$ui_comm edit modified false
877 878 879
	rescan {set ui_status_value {Ready.}}
}

880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899
set GIT_COMMITTER_IDENT {}

proc committer_ident {} {
	global GIT_COMMITTER_IDENT

	if {$GIT_COMMITTER_IDENT eq {}} {
		if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
			error_popup "Unable to obtain your identity:\n\n$err"
			return {}
		}
		if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
			$me me GIT_COMMITTER_IDENT]} {
			error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
			return {}
		}
	}

	return $GIT_COMMITTER_IDENT
}

900
proc commit_tree {} {
901
	global HEAD commit_type file_states ui_comm repo_config
902
	global ui_status_value pch_error
903

904
	if {![lock_index update]} return
905
	if {[committer_ident] eq {}} return
906 907 908

	# -- Our in memory state should match the repository.
	#
909
	repository_state curType curHEAD curMERGE_HEAD
910
	if {[string match amend* $commit_type]
911
		&& $curType eq {normal}
912
		&& $curHEAD eq $HEAD} {
913
	} elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
914
		info_popup {Last scanned state does not match repository state.
915

916 917 918
Another Git program has modified this repository
since the last scan.  A rescan must be performed
before another commit can be created.
919

920
The rescan will be automatically started now.
921 922
}
		unlock_index
923
		rescan {set ui_status_value {Ready.}}
924 925 926 927 928 929 930
		return
	}

	# -- At least one file should differ in the index.
	#
	set files_ready 0
	foreach path [array names file_states] {
931
		switch -glob -- [lindex $file_states($path) 0] {
932 933 934
		_? {continue}
		A? -
		D? -
935
		M? {set files_ready 1}
936
		U? {
937 938
			error_popup "Unmerged files cannot be committed.

939
File [short_path $path] has merge conflicts.
940
You must resolve them and add the file before committing.
941 942 943 944 945 946 947
"
			unlock_index
			return
		}
		default {
			error_popup "Unknown file state [lindex $s 0] detected.

948
File [short_path $path] cannot be committed by this program.
949 950 951 952 953
"
		}
		}
	}
	if {!$files_ready} {
954
		info_popup {No changes to commit.
955

956
You must add at least 1 file before you can commit.
957 958 959 960 961 962 963 964
}
		unlock_index
		return
	}

	# -- A message is required.
	#
	set msg [string trim [$ui_comm get 1.0 end]]
965
	if {$msg eq {}} {
966 967 968 969 970 971 972 973 974 975 976 977
		error_popup {Please supply a commit message.

A good commit message has the following format:

- First line: Describe in one sentance what you did.
- Second line: Blank
- Remaining lines: Describe why this change is good.
}
		unlock_index
		return
	}

978 979
	# -- Run the pre-commit hook.
	#
980
	set pchook [gitdir hooks pre-commit]
981 982 983

	# On Cygwin [file executable] might lie so we need to ask
	# the shell if the hook is executable.  Yes that's annoying.
984 985
	#
	if {[is_Windows] && [file isfile $pchook]} {
986 987 988 989
		set pchook [list sh -c [concat \
			"if test -x \"$pchook\";" \
			"then exec \"$pchook\" 2>&1;" \
			"fi"]]
990
	} elseif {[file executable $pchook]} {
991
		set pchook [list $pchook |& cat]
992
	} else {
993 994
		commit_writetree $curHEAD $msg
		return
995
	}
996 997 998 999 1000 1001 1002

	set ui_status_value {Calling pre-commit hook...}
	set pch_error {}
	set fd_ph [open "| $pchook" r]
	fconfigure $fd_ph -blocking 0 -translation binary
	fileevent $fd_ph readable \
		[list commit_prehook_wait $fd_ph $curHEAD $msg]
1003 1004
}

1005
proc commit_prehook_wait {fd_ph curHEAD msg} {
1006
	global pch_error ui_status_value
1007 1008 1009 1010 1011 1012 1013 1014

	append pch_error [read $fd_ph]
	fconfigure $fd_ph -blocking 1
	if {[eof $fd_ph]} {
		if {[catch {close $fd_ph}]} {
			set ui_status_value {Commit declined by pre-commit hook.}
			hook_failed_popup pre-commit $pch_error
			unlock_index
1015
		} else {
1016
			commit_writetree $curHEAD $msg
1017
		}
1018
		set pch_error {}
1019
		return
1020
	}
1021
	fconfigure $fd_ph -blocking 0
1022 1023
}

1024
proc commit_writetree {curHEAD msg} {
1025
	global ui_status_value
1026 1027 1028

	set ui_status_value {Committing changes...}
	set fd_wt [open "| git write-tree" r]
1029 1030
	fileevent $fd_wt readable \
		[list commit_committree $fd_wt $curHEAD $msg]
1031 1032
}

1033
proc commit_committree {fd_wt curHEAD msg} {
1034
	global HEAD PARENT MERGE_HEAD commit_type
1035
	global single_commit all_heads current_branch
1036
	global ui_status_value ui_comm selected_commit_type
1037
	global file_states selected_paths rescan_active
1038
	global repo_config
1039 1040

	gets $fd_wt tree_id
1041
	if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1042
		error_popup "write-tree failed:\n\n$err"
1043 1044 1045 1046 1047
		set ui_status_value {Commit failed.}
		unlock_index
		return
	}

1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058
	# -- Build the message.
	#
	set msg_p [gitdir COMMIT_EDITMSG]
	set msg_wt [open $msg_p w]
	if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
		set enc utf-8
	}
	fconfigure $msg_wt -encoding $enc -translation binary
	puts -nonewline $msg_wt $msg
	close $msg_wt

1059 1060 1061
	# -- Create the commit.
	#
	set cmd [list git commit-tree $tree_id]
1062 1063 1064 1065
	set parents [concat $PARENT $MERGE_HEAD]
	if {[llength $parents] > 0} {
		foreach p $parents {
			lappend cmd -p $p
1066
		}
1067
	} else {
1068 1069 1070
		# git commit-tree writes to stderr during initial commit.
		lappend cmd 2>/dev/null
	}
1071
	lappend cmd <$msg_p
1072
	if {[catch {set cmt_id [eval exec $cmd]} err]} {
1073
		error_popup "commit-tree failed:\n\n$err"
1074 1075 1076 1077 1078 1079 1080 1081
		set ui_status_value {Commit failed.}
		unlock_index
		return
	}

	# -- Update the HEAD ref.
	#
	set reflogm commit
1082
	if {$commit_type ne {normal}} {
1083 1084 1085 1086
		append reflogm " ($commit_type)"
	}
	set i [string first "\n" $msg]
	if {$i >= 0} {
1087
		append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1088 1089 1090
	} else {
		append reflogm {: } $msg
	}
1091
	set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1092
	if {[catch {eval exec $cmd} err]} {
1093
		error_popup "update-ref failed:\n\n$err"
1094 1095 1096 1097 1098
		set ui_status_value {Commit failed.}
		unlock_index
		return
	}

1099 1100 1101 1102 1103 1104 1105 1106
	# -- Make sure our current branch exists.
	#
	if {$commit_type eq {initial}} {
		lappend all_heads $current_branch
		set all_heads [lsort -unique $all_heads]
		populate_branch_menu
	}

1107 1108
	# -- Cleanup after ourselves.
	#
1109
	catch {file delete $msg_p}
1110 1111 1112 1113
	catch {file delete [gitdir MERGE_HEAD]}
	catch {file delete [gitdir MERGE_MSG]}
	catch {file delete [gitdir SQUASH_MSG]}
	catch {file delete [gitdir GITGUI_MSG]}
1114 1115 1116

	# -- Let rerere do its thing.
	#
1117
	if {[file isdirectory [gitdir rr-cache]]} {
1118 1119 1120
		catch {exec git rerere}
	}

1121 1122
	# -- Run the post-commit hook.
	#
1123
	set pchook [gitdir hooks post-commit]
1124
	if {[is_Windows] && [file isfile $pchook]} {
1125 1126 1127 1128 1129 1130 1131
		set pchook [list sh -c [concat \
			"if test -x \"$pchook\";" \
			"then exec \"$pchook\";" \
			"fi"]]
	} elseif {![file executable $pchook]} {
		set pchook {}
	}
1132
	if {$pchook ne {}} {
1133 1134 1135
		catch {exec $pchook &}
	}

1136
	$ui_comm delete 0.0 end
1137
	$ui_comm edit reset
1138
	$ui_comm edit modified false
1139 1140 1141

	if {$single_commit} do_quit

1142
	# -- Update in memory status
1143
	#
1144
	set selected_commit_type new
1145
	set commit_type normal
1146 1147
	set HEAD $cmt_id
	set PARENT $cmt_id
1148
	set MERGE_HEAD [list]
1149 1150 1151 1152 1153

	foreach path [array names file_states] {
		set s $file_states($path)
		set m [lindex $s 0]
		switch -glob -- $m {
1154 1155 1156 1157 1158 1159
		_O -
		_M -
		_D {continue}
		__ -
		A_ -
		M_ -
1160
		D_ {
1161
			unset file_states($path)
1162
			catch {unset selected_paths($path)}
1163 1164 1165 1166 1167 1168 1169
		}
		DO {
			set file_states($path) [list _O [lindex $s 1] {} {}]
		}
		AM -
		AD -
		MM -
1170
		MD {
1171 1172 1173 1174 1175 1176
			set file_states($path) [list \
				_[string index $m 1] \
				[lindex $s 1] \
				[lindex $s 3] \
				{}]
		}
1177 1178 1179 1180
		}
	}

	display_all_files
1181
	unlock_index
1182 1183 1184
	reshow_diff
	set ui_status_value \
		"Changes committed as [string range $cmt_id 0 7]."
1185 1186
}

1187 1188 1189 1190 1191 1192 1193
######################################################################
##
## fetch pull push

proc fetch_from {remote} {
	set w [new_console "fetch $remote" \
		"Fetching new changes from $remote"]
1194
	set cmd [list git fetch]
1195
	lappend cmd $remote
1196
	console_exec $w $cmd
1197 1198
}

1199
proc pull_remote {remote branch} {
1200
	global HEAD commit_type file_states repo_config
1201

1202
	if {![lock_index update]} return
1203 1204 1205

	# -- Our in memory state should match the repository.
	#
1206 1207
	repository_state curType curHEAD curMERGE_HEAD
	if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1208
		info_popup {Last scanned state does not match repository state.
1209

1210 1211 1212 1213 1214
Another Git program has modified this repository
since the last scan.  A rescan must be performed
before a pull operation can be started.

The rescan will be automatically started now.
1215 1216
}
		unlock_index
1217
		rescan {set ui_status_value {Ready.}}
1218 1219 1220 1221 1222 1223 1224 1225
		return
	}

	# -- No differences should exist before a pull.
	#
	if {[array size file_states] != 0} {
		error_popup {Uncommitted but modified files are present.

1226 1227 1228
You should not perform a pull with unmodified
files in your working directory as Git will be
unable to recover from an incorrect merge.
1229

1230 1231
You should commit or revert all changes before
starting a pull operation.
1232 1233 1234 1235 1236
}
		unlock_index
		return
	}

1237 1238 1239
	set w [new_console "pull $remote $branch" \
		"Pulling new changes from branch $branch in $remote"]
	set cmd [list git pull]
1240
	if {$repo_config(gui.pullsummary) eq {false}} {
1241 1242
		lappend cmd --no-summary
	}
1243 1244 1245 1246 1247 1248
	lappend cmd $remote
	lappend cmd $branch
	console_exec $w $cmd [list post_pull_remote $remote $branch]
}

proc post_pull_remote {remote branch success} {
1249
	global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1250 1251
	global ui_status_value

1252
	unlock_index
1253
	if {$success} {
1254
		repository_state commit_type HEAD MERGE_HEAD
1255
		set PARENT $HEAD
1256
		set selected_commit_type new
1257
		set ui_status_value "Pulling $branch from $remote complete."
1258
	} else {
1259 1260
		rescan [list set ui_status_value \
			"Conflicts detected while pulling $branch from $remote."]
1261 1262 1263
	}
}

1264 1265 1266
proc push_to {remote} {
	set w [new_console "push $remote" \
		"Pushing changes to $remote"]
1267
	set cmd [list git push]
1268
	lappend cmd $remote
1269
	console_exec $w $cmd
1270 1271
}

S
Shawn O. Pearce 已提交
1272 1273 1274 1275
######################################################################
##
## ui helpers

1276
proc mapicon {w state path} {
S
Shawn O. Pearce 已提交
1277 1278
	global all_icons

1279 1280
	if {[catch {set r $all_icons($state$w)}]} {
		puts "error: no icon for $w state={$state} $path"
S
Shawn O. Pearce 已提交
1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295
		return file_plain
	}
	return $r
}

proc mapdesc {state path} {
	global all_descs

	if {[catch {set r $all_descs($state)}]} {
		puts "error: no desc for state={$state} $path"
		return $state
	}
	return $r
}

1296 1297 1298 1299 1300
proc escape_path {path} {
	regsub -all "\n" $path "\\n" path
	return $path
}

1301 1302 1303 1304
proc short_path {path} {
	return [escape_path [lindex [file split $path] end]]
}

1305
set next_icon_id 0
1306
set null_sha1 [string repeat 0 40]
1307

1308
proc merge_state {path new_state {head_info {}} {index_info {}}} {
1309
	global file_states next_icon_id null_sha1
S
Shawn O. Pearce 已提交
1310

1311 1312 1313 1314 1315 1316
	set s0 [string index $new_state 0]
	set s1 [string index $new_state 1]

	if {[catch {set info $file_states($path)}]} {
		set state __
		set icon n[incr next_icon_id]
S
Shawn O. Pearce 已提交
1317
	} else {
1318 1319
		set state [lindex $info 0]
		set icon [lindex $info 1]
1320 1321
		if {$head_info eq {}}  {set head_info  [lindex $info 2]}
		if {$index_info eq {}} {set index_info [lindex $info 3]}
S
Shawn O. Pearce 已提交
1322 1323
	}

1324 1325 1326 1327 1328
	if     {$s0 eq {?}} {set s0 [string index $state 0]} \
	elseif {$s0 eq {_}} {set s0 _}

	if     {$s1 eq {?}} {set s1 [string index $state 1]} \
	elseif {$s1 eq {_}} {set s1 _}
S
Shawn O. Pearce 已提交
1329

1330 1331 1332
	if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
		set head_info [list 0 $null_sha1]
	} elseif {$s0 ne {_} && [string index $state 0] eq {_}
1333 1334
		&& $head_info eq {}} {
		set head_info $index_info
S
Shawn O. Pearce 已提交
1335 1336
	}

1337 1338 1339
	set file_states($path) [list $s0$s1 $icon \
		$head_info $index_info \
		]
1340
	return $state
S
Shawn O. Pearce 已提交
1341 1342
}

1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373
proc display_file_helper {w path icon_name old_m new_m} {
	global file_lists

	if {$new_m eq {_}} {
		set lno [lsearch -sorted $file_lists($w) $path]
		if {$lno >= 0} {
			set file_lists($w) [lreplace $file_lists($w) $lno $lno]
			incr lno
			$w conf -state normal
			$w delete $lno.0 [expr {$lno + 1}].0
			$w conf -state disabled
		}
	} elseif {$old_m eq {_} && $new_m ne {_}} {
		lappend file_lists($w) $path
		set file_lists($w) [lsort -unique $file_lists($w)]
		set lno [lsearch -sorted $file_lists($w) $path]
		incr lno
		$w conf -state normal
		$w image create $lno.0 \
			-align center -padx 5 -pady 1 \
			-name $icon_name \
			-image [mapicon $w $new_m $path]
		$w insert $lno.1 "[escape_path $path]\n"
		$w conf -state disabled
	} elseif {$old_m ne $new_m} {
		$w conf -state normal
		$w image conf $icon_name -image [mapicon $w $new_m $path]
		$w conf -state disabled
	}
}

S
Shawn O. Pearce 已提交
1374
proc display_file {path state} {
1375 1376
	global file_states selected_paths
	global ui_index ui_workdir
S
Shawn O. Pearce 已提交
1377 1378 1379

	set old_m [merge_state $path $state]
	set s $file_states($path)
1380
	set new_m [lindex $s 0]
1381 1382
	set icon_name [lindex $s 1]

1383 1384 1385 1386
	set o [string index $old_m 0]
	set n [string index $new_m 0]
	if {$o eq {U}} {
		set o _
1387
	}
1388 1389 1390 1391
	if {$n eq {U}} {
		set n _
	}
	display_file_helper	$ui_index $path $icon_name $o $n
1392

1393 1394 1395
	if {[string index $old_m 0] eq {U}} {
		set o U
	} else {
1396
		set o [string index $old_m 1]
1397
	}
1398
	if {[string index $new_m 0] eq {U}} {
1399
		set n U
1400
	} else {
1401
		set n [string index $new_m 1]
1402
	}
1403
	display_file_helper	$ui_workdir $path $icon_name $o $n
S
Shawn O. Pearce 已提交
1404

1405 1406 1407 1408
	if {$new_m eq {__}} {
		unset file_states($path)
		catch {unset selected_paths($path)}
	}
1409
}
1410

1411 1412
proc display_all_files_helper {w path icon_name m} {
	global file_lists
1413

1414 1415 1416 1417 1418 1419 1420
	lappend file_lists($w) $path
	set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
	$w image create end \
		-align center -padx 5 -pady 1 \
		-name $icon_name \
		-image [mapicon $w $m $path]
	$w insert end "[escape_path $path]\n"
1421
}
S
Shawn O. Pearce 已提交
1422

1423
proc display_all_files {} {
1424
	global ui_index ui_workdir
1425
	global file_states file_lists
1426
	global last_clicked
1427 1428

	$ui_index conf -state normal
1429
	$ui_workdir conf -state normal
1430

1431
	$ui_index delete 0.0 end
1432
	$ui_workdir delete 0.0 end
1433
	set last_clicked {}
1434

1435
	set file_lists($ui_index) [list]
1436
	set file_lists($ui_workdir) [list]
1437

1438 1439 1440
	foreach path [lsort [array names file_states]] {
		set s $file_states($path)
		set m [lindex $s 0]
1441 1442
		set icon_name [lindex $s 1]

1443 1444
		set s [string index $m 0]
		if {$s ne {U} && $s ne {_}} {
1445
			display_all_files_helper $ui_index $path \
1446
				$icon_name $s
1447
		}
1448 1449 1450 1451 1452 1453 1454

		if {[string index $m 0] eq {U}} {
			set s U
		} else {
			set s [string index $m 1]
		}
		if {$s ne {_}} {
1455
			display_all_files_helper $ui_workdir $path \
1456
				$icon_name $s
1457
		}
S
Shawn O. Pearce 已提交
1458
	}
1459 1460

	$ui_index conf -state disabled
1461
	$ui_workdir conf -state disabled
S
Shawn O. Pearce 已提交
1462 1463
}

1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484
proc update_indexinfo {msg pathList after} {
	global update_index_cp ui_status_value

	if {![lock_index update]} return

	set update_index_cp 0
	set pathList [lsort $pathList]
	set totalCnt [llength $pathList]
	set batch [expr {int($totalCnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

	set ui_status_value [format \
		"$msg... %i/%i files (%.2f%%)" \
		$update_index_cp \
		$totalCnt \
		0.0]
	set fd [open "| git update-index -z --index-info" w]
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
1485
		-encoding binary \
1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499
		-translation binary
	fileevent $fd writable [list \
		write_update_indexinfo \
		$fd \
		$pathList \
		$totalCnt \
		$batch \
		$msg \
		$after \
		]
}

proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
	global update_index_cp ui_status_value
1500
	global file_states current_diff_path
1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518

	if {$update_index_cp >= $totalCnt} {
		close $fd
		unlock_index
		uplevel #0 $after
		return
	}

	for {set i $batch} \
		{$update_index_cp < $totalCnt && $i > 0} \
		{incr i -1} {
		set path [lindex $pathList $update_index_cp]
		incr update_index_cp

		set s $file_states($path)
		switch -glob -- [lindex $s 0] {
		A? {set new _O}
		M? {set new _M}
1519
		D_ {set new _D}
1520 1521 1522 1523 1524 1525
		D? {set new _?}
		?? {continue}
		}
		set info [lindex $s 2]
		if {$info eq {}} continue

1526
		puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1527 1528 1529 1530 1531 1532 1533 1534 1535 1536
		display_file $path $new
	}

	set ui_status_value [format \
		"$msg... %i/%i files (%.2f%%)" \
		$update_index_cp \
		$totalCnt \
		[expr {100.0 * $update_index_cp / $totalCnt}]]
}

1537
proc update_index {msg pathList after} {
1538
	global update_index_cp ui_status_value
1539

1540
	if {![lock_index update]} return
1541

1542
	set update_index_cp 0
1543
	set pathList [lsort $pathList]
1544 1545 1546 1547 1548
	set totalCnt [llength $pathList]
	set batch [expr {int($totalCnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

	set ui_status_value [format \
1549
		"$msg... %i/%i files (%.2f%%)" \
1550 1551 1552 1553
		$update_index_cp \
		$totalCnt \
		0.0]
	set fd [open "| git update-index --add --remove -z --stdin" w]
1554 1555 1556 1557
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
1558
		-encoding binary \
1559
		-translation binary
1560 1561 1562 1563 1564 1565
	fileevent $fd writable [list \
		write_update_index \
		$fd \
		$pathList \
		$totalCnt \
		$batch \
1566 1567
		$msg \
		$after \
1568 1569 1570
		]
}

1571
proc write_update_index {fd pathList totalCnt batch msg after} {
1572
	global update_index_cp ui_status_value
1573
	global file_states current_diff_path
1574

1575 1576 1577
	if {$update_index_cp >= $totalCnt} {
		close $fd
		unlock_index
1578
		uplevel #0 $after
1579
		return
1580 1581
	}

1582 1583 1584 1585 1586 1587
	for {set i $batch} \
		{$update_index_cp < $totalCnt && $i > 0} \
		{incr i -1} {
		set path [lindex $pathList $update_index_cp]
		incr update_index_cp

1588
		switch -glob -- [lindex $file_states($path) 0] {
1589 1590
		AD {set new __}
		?D {set new D_}
1591
		_O -
1592
		AM {set new A_}
1593 1594 1595 1596 1597 1598 1599
		U? {
			if {[file exists $path]} {
				set new M_
			} else {
				set new D_
			}
		}
1600
		?M {set new M_}
1601
		?? {continue}
1602
		}
1603
		puts -nonewline $fd "[encoding convertto $path]\0"
1604
		display_file $path $new
S
Shawn O. Pearce 已提交
1605 1606
	}

1607
	set ui_status_value [format \
1608
		"$msg... %i/%i files (%.2f%%)" \
1609 1610 1611
		$update_index_cp \
		$totalCnt \
		[expr {100.0 * $update_index_cp / $totalCnt}]]
S
Shawn O. Pearce 已提交
1612 1613
}

1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640
proc checkout_index {msg pathList after} {
	global update_index_cp ui_status_value

	if {![lock_index update]} return

	set update_index_cp 0
	set pathList [lsort $pathList]
	set totalCnt [llength $pathList]
	set batch [expr {int($totalCnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

	set ui_status_value [format \
		"$msg... %i/%i files (%.2f%%)" \
		$update_index_cp \
		$totalCnt \
		0.0]
	set cmd [list git checkout-index]
	lappend cmd --index
	lappend cmd --quiet
	lappend cmd --force
	lappend cmd -z
	lappend cmd --stdin
	set fd [open "| $cmd " w]
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
1641
		-encoding binary \
1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655
		-translation binary
	fileevent $fd writable [list \
		write_checkout_index \
		$fd \
		$pathList \
		$totalCnt \
		$batch \
		$msg \
		$after \
		]
}

proc write_checkout_index {fd pathList totalCnt batch msg after} {
	global update_index_cp ui_status_value
1656
	global file_states current_diff_path
1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670

	if {$update_index_cp >= $totalCnt} {
		close $fd
		unlock_index
		uplevel #0 $after
		return
	}

	for {set i $batch} \
		{$update_index_cp < $totalCnt && $i > 0} \
		{incr i -1} {
		set path [lindex $pathList $update_index_cp]
		incr update_index_cp
		switch -glob -- [lindex $file_states($path) 0] {
1671 1672 1673
		U? {continue}
		?M -
		?D {
1674
			puts -nonewline $fd "[encoding convertto $path]\0"
1675 1676
			display_file $path ?_
		}
1677 1678 1679 1680 1681 1682 1683 1684 1685 1686
		}
	}

	set ui_status_value [format \
		"$msg... %i/%i files (%.2f%%)" \
		$update_index_cp \
		$totalCnt \
		[expr {100.0 * $update_index_cp / $totalCnt}]]
}

S
Shawn O. Pearce 已提交
1687 1688 1689 1690
######################################################################
##
## branch management

1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704
proc is_tracking_branch {name} {
	global tracking_branches

	if {![catch {set info $tracking_branches($name)}]} {
		return 1
	}
	foreach t [array names tracking_branches] {
		if {[string match {*/\*} $t] && [string match $t $name]} {
			return 1
		}
	}
	return 0
}

1705
proc load_all_heads {} {
1706
	global all_heads
S
Shawn O. Pearce 已提交
1707

1708
	set all_heads [list]
1709
	set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
S
Shawn O. Pearce 已提交
1710
	while {[gets $fd line] > 0} {
1711
		if {[is_tracking_branch $line]} continue
1712
		if {![regsub ^refs/heads/ $line {} name]} continue
1713
		lappend all_heads $name
S
Shawn O. Pearce 已提交
1714 1715 1716
	}
	close $fd

1717
	set all_heads [lsort $all_heads]
S
Shawn O. Pearce 已提交
1718 1719
}

1720
proc populate_branch_menu {} {
1721
	global all_heads disable_on_lock
S
Shawn O. Pearce 已提交
1722

1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738
	set m .mbar.branch
	set last [$m index last]
	for {set i 0} {$i <= $last} {incr i} {
		if {[$m type $i] eq {separator}} {
			$m delete $i last
			set new_dol [list]
			foreach a $disable_on_lock {
				if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
					lappend new_dol $a
				}
			}
			set disable_on_lock $new_dol
			break
		}
	}

S
Shawn O. Pearce 已提交
1739
	$m add separator
1740
	foreach b $all_heads {
S
Shawn O. Pearce 已提交
1741 1742
		$m add radiobutton \
			-label $b \
1743
			-command [list switch_branch $b] \
S
Shawn O. Pearce 已提交
1744 1745 1746 1747 1748 1749 1750 1751
			-variable current_branch \
			-value $b \
			-font font_ui
		lappend disable_on_lock \
			[list $m entryconf [$m index last] -state]
	}
}

1752 1753 1754
proc all_tracking_branches {} {
	global tracking_branches

1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772
	set all_trackings {}
	set cmd {}
	foreach name [array names tracking_branches] {
		if {[regsub {/\*$} $name {} name]} {
			lappend cmd $name
		} else {
			regsub ^refs/(heads|remotes)/ $name {} name
			lappend all_trackings $name
		}
	}

	if {$cmd ne {}} {
		set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
		while {[gets $fd name] > 0} {
			regsub ^refs/(heads|remotes)/ $name {} name
			lappend all_trackings $name
		}
		close $fd
1773
	}
1774

1775 1776 1777
	return [lsort -unique $all_trackings]
}

1778
proc do_create_branch_action {w} {
1779
	global all_heads null_sha1 repo_config
1780 1781
	global create_branch_checkout create_branch_revtype
	global create_branch_head create_branch_trackinghead
1782

1783
	set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1784 1785
	if {$newbranch eq {}
		|| $newbranch eq $repo_config(gui.newbranchtemplate)} {
1786 1787 1788 1789 1790 1791 1792 1793 1794
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Please supply a branch name."
		focus $w.desc.name_t
		return
	}
1795 1796 1797 1798 1799 1800 1801
	if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Branch '$newbranch' already exists."
1802
		focus $w.desc.name_t
1803 1804 1805 1806 1807 1808 1809 1810 1811
		return
	}
	if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "We do not like '$newbranch' as a branch name."
1812
		focus $w.desc.name_t
1813 1814 1815 1816 1817 1818
		return
	}

	set rev {}
	switch -- $create_branch_revtype {
	head {set rev $create_branch_head}
1819
	tracking {set rev $create_branch_trackinghead}
1820
	expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850
	}
	if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Invalid starting revision: $rev"
		return
	}
	set cmd [list git update-ref]
	lappend cmd -m
	lappend cmd "branch: Created from $rev"
	lappend cmd "refs/heads/$newbranch"
	lappend cmd $cmt
	lappend cmd $null_sha1
	if {[catch {eval exec $cmd} err]} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Failed to create '$newbranch'.\n\n$err"
		return
	}

	lappend all_heads $newbranch
	set all_heads [lsort $all_heads]
	populate_branch_menu
	destroy $w
1851 1852 1853
	if {$create_branch_checkout} {
		switch_branch $newbranch
	}
1854 1855
}

1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870
proc radio_selector {varname value args} {
	upvar #0 $varname var
	set var $value
}

trace add variable create_branch_head write \
	[list radio_selector create_branch_revtype head]
trace add variable create_branch_trackinghead write \
	[list radio_selector create_branch_revtype tracking]

trace add variable delete_branch_head write \
	[list radio_selector delete_branch_checktype head]
trace add variable delete_branch_trackinghead write \
	[list radio_selector delete_branch_checktype tracking]

1871
proc do_create_branch {} {
1872
	global all_heads current_branch repo_config
1873 1874
	global create_branch_checkout create_branch_revtype
	global create_branch_head create_branch_trackinghead
1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895

	set w .branch_editor
	toplevel $w
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"

	label $w.header -text {Create New Branch} \
		-font font_uibold
	pack $w.header -side top -fill x

	frame $w.buttons
	button $w.buttons.create -text Create \
		-font font_ui \
		-default active \
		-command [list do_create_branch_action $w]
	pack $w.buttons.create -side right
	button $w.buttons.cancel -text {Cancel} \
		-font font_ui \
		-command [list destroy $w]
	pack $w.buttons.cancel -side right -padx 5
	pack $w.buttons -side bottom -fill x -pady 10 -padx 10

1896
	labelframe $w.desc \
1897 1898
		-text {Branch Description} \
		-font font_ui
1899 1900
	label $w.desc.name_l -text {Name:} -font font_ui
	text $w.desc.name_t \
1901 1902
		-borderwidth 1 \
		-relief sunken \
1903 1904 1905
		-height 1 \
		-width 40 \
		-font font_ui
1906
	$w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1907
	grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1908 1909
	bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
	bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1910 1911
	bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
	bind $w.desc.name_t <Key> {
1912 1913 1914 1915 1916 1917 1918 1919
		if {{%K} ne {BackSpace}
			&& {%K} ne {Tab}
			&& {%K} ne {Escape}
			&& {%K} ne {Return}} {
			if {%k <= 32} break
			if {[string first %A {~^:?*[}] >= 0} break
		}
	}
1920
	grid columnconfigure $w.desc 1 -weight 1
1921
	pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1922 1923 1924 1925

	labelframe $w.from \
		-text {Starting Revision} \
		-font font_ui
1926
	radiobutton $w.from.head_r \
1927 1928 1929 1930
		-text {Local Branch:} \
		-value head \
		-variable create_branch_revtype \
		-font font_ui
1931 1932
	eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
	grid $w.from.head_r $w.from.head_m -sticky w
1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945
	set all_trackings [all_tracking_branches]
	if {$all_trackings ne {}} {
		set create_branch_trackinghead [lindex $all_trackings 0]
		radiobutton $w.from.tracking_r \
			-text {Tracking Branch:} \
			-value tracking \
			-variable create_branch_revtype \
			-font font_ui
		eval tk_optionMenu $w.from.tracking_m \
			create_branch_trackinghead \
			$all_trackings
		grid $w.from.tracking_r $w.from.tracking_m -sticky w
	}
1946
	radiobutton $w.from.exp_r \
1947 1948 1949 1950
		-text {Revision Expression:} \
		-value expression \
		-variable create_branch_revtype \
		-font font_ui
1951
	text $w.from.exp_t \
1952 1953
		-borderwidth 1 \
		-relief sunken \
1954 1955 1956
		-height 1 \
		-width 50 \
		-font font_ui
1957
	grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
1958 1959
	bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
	bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
1960
	bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
1961 1962
	bind $w.from.exp_t <Key-space> break
	bind $w.from.exp_t <Key> {set create_branch_revtype expression}
1963
	grid columnconfigure $w.from 1 -weight 1
1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975
	pack $w.from -anchor nw -fill x -pady 5 -padx 5

	labelframe $w.postActions \
		-text {Post Creation Actions} \
		-font font_ui
	checkbutton $w.postActions.checkout \
		-text {Checkout after creation} \
		-variable create_branch_checkout \
		-font font_ui
	pack $w.postActions.checkout -anchor nw
	pack $w.postActions -anchor nw -fill x -pady 5 -padx 5

1976 1977 1978 1979
	set create_branch_checkout 1
	set create_branch_head $current_branch
	set create_branch_revtype head

1980
	bind $w <Visibility> "grab $w; focus $w.desc.name_t"
1981 1982 1983 1984
	bind $w <Key-Escape> "destroy $w"
	bind $w <Key-Return> "do_create_branch_action $w;break"
	wm title $w "[appname] ([reponame]): Create Branch"
	tkwait window $w
1985 1986
}

1987 1988
proc do_delete_branch_action {w} {
	global all_heads
1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007
	global delete_branch_checktype delete_branch_head delete_branch_trackinghead

	set check_rev {}
	switch -- $delete_branch_checktype {
	head {set check_rev $delete_branch_head}
	tracking {set check_rev $delete_branch_trackinghead}
	always {set check_rev {:none}}
	}
	if {$check_rev eq {:none}} {
		set check_cmt {}
	} elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Invalid check revision: $check_rev"
		return
	}
2008 2009

	set to_delete [list]
2010
	set not_merged [list]
2011 2012 2013
	foreach i [$w.list.l curselection] {
		set b [$w.list.l get $i]
		if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2014 2015 2016
		if {$check_cmt ne {}} {
			if {$b eq $check_rev} continue
			if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2017 2018 2019 2020
			if {$o ne $m} {
				lappend not_merged $b
				continue
			}
2021 2022 2023
		}
		lappend to_delete [list $b $o]
	}
2024
	if {$not_merged ne {}} {
2025
		set msg "The following branches are not completely merged into $check_rev:
2026 2027

 - [join $not_merged "\n - "]"
2028 2029 2030 2031 2032
		tk_messageBox \
			-icon info \
			-type ok \
			-title [wm title $w] \
			-parent $w \
2033
			-message $msg
2034
	}
2035
	if {$to_delete eq {}} return
2036
	if {$delete_branch_checktype eq {always}} {
2037
		set msg {Recovering deleted branches is difficult.
2038

2039 2040 2041 2042 2043 2044 2045 2046 2047
Delete the selected branches?}
		if {[tk_messageBox \
			-icon warning \
			-type yesno \
			-title [wm title $w] \
			-parent $w \
			-message $msg] ne yes} {
			return
		}
2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077
	}

	set failed {}
	foreach i $to_delete {
		set b [lindex $i 0]
		set o [lindex $i 1]
		if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
			append failed " - $b: $err\n"
		} else {
			set x [lsearch -sorted $all_heads $b]
			if {$x >= 0} {
				set all_heads [lreplace $all_heads $x $x]
			}
		}
	}

	if {$failed ne {}} {
		tk_messageBox \
			-icon error \
			-type ok \
			-title [wm title $w] \
			-parent $w \
			-message "Failed to delete branches:\n$failed"
	}

	set all_heads [lsort $all_heads]
	populate_branch_menu
	destroy $w
}

2078
proc do_delete_branch {} {
2079
	global all_heads tracking_branches current_branch
2080
	global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117

	set w .branch_editor
	toplevel $w
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"

	label $w.header -text {Delete Local Branch} \
		-font font_uibold
	pack $w.header -side top -fill x

	frame $w.buttons
	button $w.buttons.create -text Delete \
		-font font_ui \
		-command [list do_delete_branch_action $w]
	pack $w.buttons.create -side right
	button $w.buttons.cancel -text {Cancel} \
		-font font_ui \
		-command [list destroy $w]
	pack $w.buttons.cancel -side right -padx 5
	pack $w.buttons -side bottom -fill x -pady 10 -padx 10

	labelframe $w.list \
		-text {Local Branches} \
		-font font_ui
	listbox $w.list.l \
		-height 10 \
		-width 50 \
		-selectmode extended \
		-font font_ui
	foreach h $all_heads {
		if {$h ne $current_branch} {
			$w.list.l insert end $h
		}
	}
	pack $w.list.l -fill both -pady 5 -padx 5
	pack $w.list -fill both -pady 5 -padx 5

	labelframe $w.validate \
2118 2119 2120 2121 2122 2123 2124 2125 2126
		-text {Delete Only If} \
		-font font_ui
	radiobutton $w.validate.head_r \
		-text {Merged Into Local Branch:} \
		-value head \
		-variable delete_branch_checktype \
		-font font_ui
	eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
	grid $w.validate.head_r $w.validate.head_m -sticky w
2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139
	set all_trackings [all_tracking_branches]
	if {$all_trackings ne {}} {
		set delete_branch_trackinghead [lindex $all_trackings 0]
		radiobutton $w.validate.tracking_r \
			-text {Merged Into Tracking Branch:} \
			-value tracking \
			-variable delete_branch_checktype \
			-font font_ui
		eval tk_optionMenu $w.validate.tracking_m \
			delete_branch_trackinghead \
			$all_trackings
		grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
	}
2140 2141 2142 2143
	radiobutton $w.validate.always_r \
		-text {Always (Do not perform merge checks)} \
		-value always \
		-variable delete_branch_checktype \
2144
		-font font_ui
2145 2146
	grid $w.validate.always_r -columnspan 2 -sticky w
	grid columnconfigure $w.validate 1 -weight 1
2147 2148
	pack $w.validate -anchor nw -fill x -pady 5 -padx 5

2149 2150 2151
	set delete_branch_head $current_branch
	set delete_branch_checktype head

2152 2153 2154 2155
	bind $w <Visibility> "grab $w; focus $w"
	bind $w <Key-Escape> "destroy $w"
	wm title $w "[appname] ([reponame]): Delete Branch"
	tkwait window $w
2156 2157
}

2158 2159
proc switch_branch {new_branch} {
	global HEAD commit_type current_branch repo_config
2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182

	if {![lock_index switch]} return

	# -- Our in memory state should match the repository.
	#
	repository_state curType curHEAD curMERGE_HEAD
	if {[string match amend* $commit_type]
		&& $curType eq {normal}
		&& $curHEAD eq $HEAD} {
	} elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
		info_popup {Last scanned state does not match repository state.

Another Git program has modified this repository
since the last scan.  A rescan must be performed
before the current branch can be changed.

The rescan will be automatically started now.
}
		unlock_index
		rescan {set ui_status_value {Ready.}}
		return
	}

2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226
	if {$repo_config(gui.trustmtime) eq {true}} {
		switch_branch_stage2 {} $new_branch
	} else {
		set ui_status_value {Refreshing file status...}
		set cmd [list git update-index]
		lappend cmd -q
		lappend cmd --unmerged
		lappend cmd --ignore-missing
		lappend cmd --refresh
		set fd_rf [open "| $cmd" r]
		fconfigure $fd_rf -blocking 0 -translation binary
		fileevent $fd_rf readable \
			[list switch_branch_stage2 $fd_rf $new_branch]
	}
}

proc switch_branch_stage2 {fd_rf new_branch} {
	global ui_status_value HEAD

	if {$fd_rf ne {}} {
		read $fd_rf
		if {![eof $fd_rf]} return
		close $fd_rf
	}

	set ui_status_value "Updating working directory to '$new_branch'..."
	set cmd [list git read-tree]
	lappend cmd -m
	lappend cmd -u
	lappend cmd --exclude-per-directory=.gitignore
	lappend cmd $HEAD
	lappend cmd $new_branch
	set fd_rt [open "| $cmd" r]
	fconfigure $fd_rt -blocking 0 -translation binary
	fileevent $fd_rt readable \
		[list switch_branch_readtree_wait $fd_rt $new_branch]
}

proc switch_branch_readtree_wait {fd_rt new_branch} {
	global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
	global current_branch
	global ui_comm ui_status_value

	# -- We never get interesting output on stdout; only stderr.
2227
	#
2228 2229 2230 2231 2232
	read $fd_rt
	fconfigure $fd_rt -blocking 1
	if {![eof $fd_rt]} {
		fconfigure $fd_rt -blocking 0
		return
2233 2234
	}

2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263
	# -- The working directory wasn't in sync with the index and
	#    we'd have to overwrite something to make the switch. A
	#    merge is required.
	#
	if {[catch {close $fd_rt} err]} {
		regsub {^fatal: } $err {} err
		warn_popup "File level merge required.

$err

Staying on branch '$current_branch'."
		set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
		unlock_index
		return
	}

	# -- Update the symbolic ref.  Core git doesn't even check for failure
	#    here, it Just Works(tm).  If it doesn't we are in some really ugly
	#    state that is difficult to recover from within git-gui.
	#
	if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
		error_popup "Failed to set current branch.

This working directory is only partially switched.
We successfully updated your files, but failed to
update an internal Git file.

This should not have occurred.  [appname] will now
close and give up.
2264

2265 2266 2267 2268 2269 2270 2271 2272 2273 2274
$err"
		do_quit
		return
	}

	# -- Update our repository state.  If we were previously in amend mode
	#    we need to toss the current buffer and do a full rescan to update
	#    our file lists.  If we weren't in amend mode our file lists are
	#    accurate and we can avoid the rescan.
	#
2275
	unlock_index
2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286
	set selected_commit_type new
	if {[string match amend* $commit_type]} {
		$ui_comm delete 0.0 end
		$ui_comm edit reset
		$ui_comm edit modified false
		rescan {set ui_status_value "Checked out branch '$current_branch'."}
	} else {
		repository_state commit_type HEAD MERGE_HEAD
		set PARENT $HEAD
		set ui_status_value "Checked out branch '$current_branch'."
	}
2287 2288
}

2289 2290
######################################################################
##
2291
## remote management
2292

2293
proc load_all_remotes {} {
2294
	global repo_config
2295
	global all_remotes tracking_branches
2296 2297

	set all_remotes [list]
2298 2299
	array unset tracking_branches

2300
	set rm_dir [gitdir remotes]
2301
	if {[file isdirectory $rm_dir]} {
2302
		set all_remotes [glob \
2303 2304 2305
			-types f \
			-tails \
			-nocomplain \
2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321
			-directory $rm_dir *]

		foreach name $all_remotes {
			catch {
				set fd [open [file join $rm_dir $name] r]
				while {[gets $fd line] >= 0} {
					if {![regexp {^Pull:[ 	]*([^:]+):(.+)$} \
						$line line src dst]} continue
					if {![regexp ^refs/ $dst]} {
						set dst "refs/heads/$dst"
					}
					set tracking_branches($dst) [list $name $src]
				}
				close $fd
			}
		}
2322 2323
	}

2324
	foreach line [array names repo_config remote.*.url] {
2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336
		if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
		lappend all_remotes $name

		if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
			set fl {}
		}
		foreach line $fl {
			if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
			if {![regexp ^refs/ $dst]} {
				set dst "refs/heads/$dst"
			}
			set tracking_branches($dst) [list $name $src]
2337 2338 2339 2340 2341 2342
		}
	}

	set all_remotes [lsort -unique $all_remotes]
}

2343
proc populate_fetch_menu {m} {
2344
	global all_remotes repo_config
2345

2346 2347 2348 2349 2350 2351 2352 2353
	foreach r $all_remotes {
		set enable 0
		if {![catch {set a $repo_config(remote.$r.url)}]} {
			if {![catch {set a $repo_config(remote.$r.fetch)}]} {
				set enable 1
			}
		} else {
			catch {
2354
				set fd [open [gitdir remotes $r] r]
2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374
				while {[gets $fd n] >= 0} {
					if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
						set enable 1
						break
					}
				}
				close $fd
			}
		}

		if {$enable} {
			$m add command \
				-label "Fetch from $r..." \
				-command [list fetch_from $r] \
				-font font_ui
		}
	}
}

proc populate_push_menu {m} {
2375
	global all_remotes repo_config
2376 2377 2378 2379 2380 2381 2382 2383 2384

	foreach r $all_remotes {
		set enable 0
		if {![catch {set a $repo_config(remote.$r.url)}]} {
			if {![catch {set a $repo_config(remote.$r.push)}]} {
				set enable 1
			}
		} else {
			catch {
2385
				set fd [open [gitdir remotes $r] r]
2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401
				while {[gets $fd n] >= 0} {
					if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
						set enable 1
						break
					}
				}
				close $fd
			}
		}

		if {$enable} {
			$m add command \
				-label "Push to $r..." \
				-command [list push_to $r] \
				-font font_ui
		}
2402 2403 2404
	}
}

2405
proc populate_pull_menu {m} {
2406
	global repo_config all_remotes disable_on_lock
2407 2408

	foreach remote $all_remotes {
2409
		set rb_list [list]
2410 2411
		if {[array get repo_config remote.$remote.url] ne {}} {
			if {[array get repo_config remote.$remote.fetch] ne {}} {
2412 2413 2414 2415 2416
				foreach line $repo_config(remote.$remote.fetch) {
					if {[regexp {^([^:]+):} $line line rb]} {
						lappend rb_list $rb
					}
				}
2417 2418 2419
			}
		} else {
			catch {
2420
				set fd [open [gitdir remotes $remote] r]
2421 2422
				while {[gets $fd line] >= 0} {
					if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2423
						lappend rb_list $rb
2424 2425 2426 2427 2428 2429
					}
				}
				close $fd
			}
		}

2430 2431
		foreach rb $rb_list {
			regsub ^refs/heads/ $rb {} rb_short
2432 2433 2434
			$m add command \
				-label "Branch $rb_short from $remote..." \
				-command [list pull_remote $remote $rb] \
2435
				-font font_ui
2436 2437
			lappend disable_on_lock \
				[list $m entryconf [$m index last] -state]
2438 2439 2440 2441
		}
	}
}

S
Shawn O. Pearce 已提交
2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472
######################################################################
##
## icons

set filemask {
#define mask_width 14
#define mask_height 15
static unsigned char mask_bits[] = {
   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
}

image create bitmap file_plain -background white -foreground black -data {
#define plain_width 14
#define plain_height 15
static unsigned char plain_bits[] = {
   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

image create bitmap file_mod -background white -foreground blue -data {
#define mod_width 14
#define mod_height 15
static unsigned char mod_bits[] = {
   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

2473 2474 2475 2476
image create bitmap file_fulltick -background white -foreground "#007000" -data {
#define file_fulltick_width 14
#define file_fulltick_height 15
static unsigned char file_fulltick_bits[] = {
S
Shawn O. Pearce 已提交
2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517
   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

image create bitmap file_parttick -background white -foreground "#005050" -data {
#define parttick_width 14
#define parttick_height 15
static unsigned char parttick_bits[] = {
   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

image create bitmap file_question -background white -foreground black -data {
#define file_question_width 14
#define file_question_height 15
static unsigned char file_question_bits[] = {
   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

image create bitmap file_removed -background white -foreground red -data {
#define file_removed_width 14
#define file_removed_height 15
static unsigned char file_removed_bits[] = {
   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

image create bitmap file_merge -background white -foreground blue -data {
#define file_merge_width 14
#define file_merge_height 15
static unsigned char file_merge_bits[] = {
   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask

2518
set ui_index .vpane.files.index.list
2519
set ui_workdir .vpane.files.workdir.list
2520 2521 2522 2523 2524 2525 2526 2527 2528 2529

set all_icons(_$ui_index)   file_plain
set all_icons(A$ui_index)   file_fulltick
set all_icons(M$ui_index)   file_fulltick
set all_icons(D$ui_index)   file_removed
set all_icons(U$ui_index)   file_merge

set all_icons(_$ui_workdir) file_plain
set all_icons(M$ui_workdir) file_mod
set all_icons(D$ui_workdir) file_question
2530
set all_icons(U$ui_workdir) file_merge
2531 2532
set all_icons(O$ui_workdir) file_plain

2533
set max_status_desc 0
S
Shawn O. Pearce 已提交
2534
foreach i {
2535 2536
		{__ "Unmodified"}

2537 2538 2539 2540 2541 2542 2543 2544 2545
		{_M "Modified, not staged"}
		{M_ "Staged for commit"}
		{MM "Portions staged for commit"}
		{MD "Staged for commit, missing"}

		{_O "Untracked, not staged"}
		{A_ "Staged for commit"}
		{AM "Portions staged for commit"}
		{AD "Staged for commit, missing"}
2546 2547

		{_D "Missing"}
2548 2549
		{D_ "Staged for removal"}
		{DO "Staged for removal, still present"}
2550

2551
		{U_ "Requires merge resolution"}
2552
		{UU "Requires merge resolution"}
2553 2554
		{UM "Requires merge resolution"}
		{UD "Requires merge resolution"}
S
Shawn O. Pearce 已提交
2555
	} {
2556 2557
	if {$max_status_desc < [string length [lindex $i 1]]} {
		set max_status_desc [string length [lindex $i 1]]
2558
	}
2559
	set all_descs([lindex $i 0]) [lindex $i 1]
S
Shawn O. Pearce 已提交
2560
}
2561
unset i
S
Shawn O. Pearce 已提交
2562 2563 2564 2565 2566

######################################################################
##
## util

2567 2568
proc is_MacOSX {} {
	global tcl_platform tk_library
2569
	if {[tk windowingsystem] eq {aqua}} {
2570 2571 2572 2573 2574
		return 1
	}
	return 0
}

2575 2576 2577 2578 2579 2580 2581 2582
proc is_Windows {} {
	global tcl_platform
	if {$tcl_platform(platform) eq {windows}} {
		return 1
	}
	return 0
}

2583 2584 2585 2586 2587 2588 2589
proc bind_button3 {w cmd} {
	bind $w <Any-Button-3> $cmd
	if {[is_MacOSX]} {
		bind $w <Control-Button-1> $cmd
	}
}

2590 2591 2592 2593 2594 2595 2596
proc incr_font_size {font {amt 1}} {
	set sz [font configure $font -size]
	incr sz $amt
	font configure $font -size $sz
	font configure ${font}bold -size $sz
}

2597 2598 2599 2600 2601 2602 2603 2604
proc hook_failed_popup {hook msg} {
	set w .hookfail
	toplevel $w

	frame $w.m
	label $w.m.l1 -text "$hook hook failed:" \
		-anchor w \
		-justify left \
2605
		-font font_uibold
2606 2607 2608 2609
	text $w.m.t \
		-background white -borderwidth 1 \
		-relief sunken \
		-width 80 -height 10 \
2610
		-font font_diff \
2611 2612 2613 2614 2615
		-yscrollcommand [list $w.m.sby set]
	label $w.m.l2 \
		-text {You must correct the above errors before committing.} \
		-anchor w \
		-justify left \
2616
		-font font_uibold
2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628
	scrollbar $w.m.sby -command [list $w.m.t yview]
	pack $w.m.l1 -side top -fill x
	pack $w.m.l2 -side bottom -fill x
	pack $w.m.sby -side right -fill y
	pack $w.m.t -side left -fill both -expand 1
	pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10

	$w.m.t insert 1.0 $msg
	$w.m.t conf -state disabled

	button $w.ok -text OK \
		-width 15 \
2629
		-font font_ui \
2630
		-command "destroy $w"
2631
	pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2632 2633 2634

	bind $w <Visibility> "grab $w; focus $w"
	bind $w <Key-Return> "destroy $w"
2635
	wm title $w "[appname] ([reponame]): error"
2636 2637 2638
	tkwait window $w
}

2639 2640 2641
set next_console_id 0

proc new_console {short_title long_title} {
2642 2643 2644 2645 2646 2647 2648
	global next_console_id console_data
	set w .console[incr next_console_id]
	set console_data($w) [list $short_title $long_title]
	return [console_init $w]
}

proc console_init {w} {
2649
	global console_cr console_data M1B
2650

2651
	set console_cr($w) 1.0
2652 2653
	toplevel $w
	frame $w.m
2654
	label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2655 2656
		-anchor w \
		-justify left \
2657
		-font font_uibold
2658 2659 2660 2661
	text $w.m.t \
		-background white -borderwidth 1 \
		-relief sunken \
		-width 80 -height 10 \
2662
		-font font_diff \
2663 2664
		-state disabled \
		-yscrollcommand [list $w.m.sby set]
2665 2666
	label $w.m.s -text {Working... please wait...} \
		-anchor w \
2667
		-justify left \
2668
		-font font_uibold
2669 2670
	scrollbar $w.m.sby -command [list $w.m.t yview]
	pack $w.m.l1 -side top -fill x
2671
	pack $w.m.s -side bottom -fill x
2672 2673 2674 2675
	pack $w.m.sby -side right -fill y
	pack $w.m.t -side left -fill both -expand 1
	pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10

2676 2677
	menu $w.ctxm -tearoff 0
	$w.ctxm add command -label "Copy" \
2678
		-font font_ui \
2679 2680
		-command "tk_textCopy $w.m.t"
	$w.ctxm add command -label "Select All" \
2681
		-font font_ui \
2682
		-command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2683
	$w.ctxm add command -label "Copy All" \
2684
		-font font_ui \
2685 2686 2687 2688 2689 2690
		-command "
			$w.m.t tag add sel 0.0 end
			tk_textCopy $w.m.t
			$w.m.t tag remove sel 0.0 end
		"

2691
	button $w.ok -text {Close} \
2692
		-font font_ui \
2693 2694
		-state disabled \
		-command "destroy $w"
2695
	pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2696

2697
	bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2698 2699
	bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
	bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2700
	bind $w <Visibility> "focus $w"
2701
	wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2702 2703 2704
	return $w
}

2705
proc console_exec {w cmd {after {}}} {
2706 2707 2708
	# -- Windows tosses the enviroment when we exec our child.
	#    But most users need that so we have to relogin. :-(
	#
2709
	if {[is_Windows]} {
2710 2711 2712 2713 2714 2715 2716 2717 2718
		set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
	}

	# -- Tcl won't let us redirect both stdout and stderr to
	#    the same pipe.  So pass it through cat...
	#
	set cmd [concat | $cmd |& cat]

	set fd_f [open $cmd r]
2719
	fconfigure $fd_f -blocking 0 -translation binary
2720
	fileevent $fd_f readable [list console_read $w $fd_f $after]
2721 2722
}

2723
proc console_read {w fd after} {
2724
	global console_cr console_data
2725 2726

	set buf [read $fd]
2727
	if {$buf ne {}} {
2728 2729 2730 2731 2732 2733 2734
		if {![winfo exists $w]} {console_init $w}
		$w.m.t conf -state normal
		set c 0
		set n [string length $buf]
		while {$c < $n} {
			set cr [string first "\r" $buf $c]
			set lf [string first "\n" $buf $c]
2735 2736
			if {$cr < 0} {set cr [expr {$n + 1}]}
			if {$lf < 0} {set lf [expr {$n + 1}]}
2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749

			if {$lf < $cr} {
				$w.m.t insert end [string range $buf $c $lf]
				set console_cr($w) [$w.m.t index {end -1c}]
				set c $lf
				incr c
			} else {
				$w.m.t delete $console_cr($w) end
				$w.m.t insert end "\n"
				$w.m.t insert end [string range $buf $c $cr]
				set c $cr
				incr c
			}
2750
		}
2751 2752
		$w.m.t conf -state disabled
		$w.m.t see end
2753 2754
	}

2755
	fconfigure $fd -blocking 1
2756
	if {[eof $fd]} {
2757
		if {[catch {close $fd}]} {
2758
			if {![winfo exists $w]} {console_init $w}
2759
			$w.m.s conf -background red -text {Error: Command Failed}
2760
			$w.ok conf -state normal
2761
			set ok 0
2762
		} elseif {[winfo exists $w]} {
2763
			$w.m.s conf -background green -text {Success}
2764
			$w.ok conf -state normal
2765
			set ok 1
2766
		}
2767
		array unset console_cr $w
2768
		array unset console_data $w
2769
		if {$after ne {}} {
2770 2771
			uplevel #0 $after $ok
		}
2772
		return
2773
	}
2774
	fconfigure $fd -blocking 0
2775 2776
}

S
Shawn O. Pearce 已提交
2777 2778 2779 2780
######################################################################
##
## ui commands

2781
set starting_gitk_msg {Starting gitk... please wait...}
2782

2783
proc do_gitk {revs} {
2784
	global ui_status_value starting_gitk_msg
2785

2786 2787 2788 2789
	set cmd gitk
	if {$revs ne {}} {
		append cmd { }
		append cmd $revs
2790
	}
2791
	if {[is_Windows]} {
2792 2793 2794 2795 2796 2797
		set cmd "sh -c \"exec $cmd\""
	}
	append cmd { &}

	if {[catch {eval exec $cmd} err]} {
		error_popup "Failed to start gitk:\n\n$err"
S
Shawn O. Pearce 已提交
2798
	} else {
2799 2800 2801 2802 2803 2804
		set ui_status_value $starting_gitk_msg
		after 10000 {
			if {$ui_status_value eq $starting_gitk_msg} {
				set ui_status_value {Ready.}
			}
		}
S
Shawn O. Pearce 已提交
2805 2806 2807
	}
}

2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864
proc do_stats {} {
	set fd [open "| git count-objects -v" r]
	while {[gets $fd line] > 0} {
		if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
			set stats($name) $value
		}
	}
	close $fd

	set w .stats_view
	toplevel $w
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"

	label $w.header -text {Database Statistics} \
		-font font_uibold
	pack $w.header -side top -fill x

	frame $w.buttons -border 1
	button $w.buttons.close -text Close \
		-font font_ui \
		-command [list destroy $w]
	button $w.buttons.gc -text {Compress Database} \
		-font font_ui \
		-command "destroy $w;do_gc"
	pack $w.buttons.close -side right
	pack $w.buttons.gc -side left
	pack $w.buttons -side bottom -fill x -pady 10 -padx 10

	frame $w.stat -borderwidth 1 -relief solid
	foreach s {
		{count           {Number of loose objects}}
		{size            {Disk space used by loose objects} { KiB}}
		{in-pack         {Number of packed objects}}
		{packs           {Number of packs}}
		{prune-packable  {Packed objects waiting for pruning}}
		{garbage         {Garbage files}}
		} {
		set name [lindex $s 0]
		set label [lindex $s 1]
		if {[catch {set value $stats($name)}]} continue
		if {[llength $s] > 2} {
			set value "$value[lindex $s 2]"
		}

		label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
		label $w.stat.v_$name -text $value -anchor w -font font_ui
		grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
	}
	pack $w.stat

	bind $w <Visibility> "grab $w; focus $w"
	bind $w <Key-Escape> [list destroy $w]
	bind $w <Key-Return> [list destroy $w]
	wm title $w "[appname] ([reponame]): Database Statistics"
	tkwait window $w
}

2865 2866 2867
proc do_gc {} {
	set w [new_console {gc} {Compressing the object database}]
	console_exec $w {git gc}
2868 2869
}

2870
proc do_fsck_objects {} {
2871 2872
	set w [new_console {fsck-objects} \
		{Verifying the object database with fsck-objects}]
2873 2874 2875 2876 2877 2878 2879
	set cmd [list git fsck-objects]
	lappend cmd --full
	lappend cmd --cache
	lappend cmd --strict
	console_exec $w $cmd
}

2880
set is_quitting 0
2881

S
Shawn O. Pearce 已提交
2882
proc do_quit {} {
2883
	global ui_comm is_quitting repo_config commit_type
2884

2885 2886
	if {$is_quitting} return
	set is_quitting 1
2887

2888 2889
	# -- Stash our current commit buffer.
	#
2890
	set save [gitdir GITGUI_MSG]
2891
	set msg [string trim [$ui_comm get 0.0 end]]
2892 2893 2894
	if {![string match amend* $commit_type]
		&& [$ui_comm edit modified]
		&& $msg ne {}} {
2895 2896 2897 2898 2899
		catch {
			set fd [open $save w]
			puts $fd [string trim [$ui_comm get 0.0 end]]
			close $fd
		}
2900 2901
	} else {
		catch {file delete $save}
2902 2903
	}

2904 2905 2906 2907 2908 2909 2910 2911 2912
	# -- Stash our current window geometry into this repository.
	#
	set cfg_geometry [list]
	lappend cfg_geometry [wm geometry .]
	lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
	lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
	if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
		set rc_geometry {}
	}
2913
	if {$cfg_geometry ne $rc_geometry} {
2914 2915 2916
		catch {exec git repo-config gui.geometry $cfg_geometry}
	}

S
Shawn O. Pearce 已提交
2917 2918 2919 2920
	destroy .
}

proc do_rescan {} {
2921
	rescan {set ui_status_value {Ready.}}
S
Shawn O. Pearce 已提交
2922 2923
}

2924
proc unstage_helper {txt paths} {
2925
	global file_states current_diff_path
2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936

	if {![lock_index begin-update]} return

	set pathList [list]
	set after {}
	foreach path $paths {
		switch -glob -- [lindex $file_states($path) 0] {
		A? -
		M? -
		D? {
			lappend pathList $path
2937
			if {$path eq $current_diff_path} {
2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952
				set after {reshow_diff;}
			}
		}
		}
	}
	if {$pathList eq {}} {
		unlock_index
	} else {
		update_indexinfo \
			$txt \
			$pathList \
			[concat $after {set ui_status_value {Ready.}}]
	}
}

2953
proc do_unstage_selection {} {
2954
	global current_diff_path selected_paths
2955 2956

	if {[array size selected_paths] > 0} {
2957 2958
		unstage_helper \
			{Unstaging selected files from commit} \
2959
			[array names selected_paths]
2960
	} elseif {$current_diff_path ne {}} {
2961
		unstage_helper \
2962 2963
			"Unstaging [short_path $current_diff_path] from commit" \
			[list $current_diff_path]
2964 2965 2966
	}
}

2967
proc add_helper {txt paths} {
2968
	global file_states current_diff_path
2969 2970 2971 2972

	if {![lock_index begin-update]} return

	set pathList [list]
2973
	set after {}
2974
	foreach path $paths {
2975
		switch -glob -- [lindex $file_states($path) 0] {
2976 2977 2978 2979
		_O -
		?M -
		?D -
		U? {
2980
			lappend pathList $path
2981
			if {$path eq $current_diff_path} {
2982 2983 2984
				set after {reshow_diff;}
			}
		}
2985
		}
2986
	}
2987
	if {$pathList eq {}} {
2988 2989
		unlock_index
	} else {
2990
		update_index \
2991
			$txt \
2992
			$pathList \
2993
			[concat $after {set ui_status_value {Ready to commit.}}]
2994 2995 2996
	}
}

2997
proc do_add_selection {} {
2998
	global current_diff_path selected_paths
2999 3000

	if {[array size selected_paths] > 0} {
3001
		add_helper \
3002
			{Adding selected files} \
3003
			[array names selected_paths]
3004
	} elseif {$current_diff_path ne {}} {
3005
		add_helper \
3006 3007
			"Adding [short_path $current_diff_path]" \
			[list $current_diff_path]
3008 3009 3010
	}
}

3011
proc do_add_all {} {
3012
	global file_states
3013 3014 3015

	set paths [list]
	foreach path [array names file_states] {
3016 3017 3018 3019
		switch -glob -- [lindex $file_states($path) 0] {
		U? {continue}
		?M -
		?D {lappend paths $path}
3020 3021
		}
	}
3022
	add_helper {Adding all changed files} $paths
3023 3024
}

3025
proc revert_helper {txt paths} {
3026
	global file_states current_diff_path
3027 3028 3029 3030 3031 3032 3033

	if {![lock_index begin-update]} return

	set pathList [list]
	set after {}
	foreach path $paths {
		switch -glob -- [lindex $file_states($path) 0] {
3034 3035 3036
		U? {continue}
		?M -
		?D {
3037
			lappend pathList $path
3038
			if {$path eq $current_diff_path} {
3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056
				set after {reshow_diff;}
			}
		}
		}
	}

	set n [llength $pathList]
	if {$n == 0} {
		unlock_index
		return
	} elseif {$n == 1} {
		set s "[short_path [lindex $pathList]]"
	} else {
		set s "these $n files"
	}

	set reply [tk_dialog \
		.confirm_revert \
3057
		"[appname] ([reponame])" \
3058
		"Revert changes in $s?
3059

3060
Any unadded changes will be permanently lost by the revert." \
3061
		question \
3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076
		1 \
		{Do Nothing} \
		{Revert Changes} \
		]
	if {$reply == 1} {
		checkout_index \
			$txt \
			$pathList \
			[concat $after {set ui_status_value {Ready.}}]
	} else {
		unlock_index
	}
}

proc do_revert_selection {} {
3077
	global current_diff_path selected_paths
3078 3079 3080 3081 3082

	if {[array size selected_paths] > 0} {
		revert_helper \
			{Reverting selected files} \
			[array names selected_paths]
3083
	} elseif {$current_diff_path ne {}} {
3084
		revert_helper \
3085 3086
			"Reverting [short_path $current_diff_path]" \
			[list $current_diff_path]
3087 3088 3089
	}
}

3090
proc do_signoff {} {
3091
	global ui_comm
3092

3093 3094
	set me [committer_ident]
	if {$me eq {}} return
3095

3096
	set sob "Signed-off-by: $me"
3097
	set last [$ui_comm get {end -1c linestart} {end -1c}]
3098
	if {$last ne $sob} {
3099
		$ui_comm edit separator
3100
		if {$last ne {}
3101 3102 3103 3104
			&& ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
			$ui_comm insert end "\n"
		}
		$ui_comm insert end "\n$sob"
3105
		$ui_comm edit separator
3106
		$ui_comm see end
3107 3108 3109
	}
}

3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122
proc do_select_commit_type {} {
	global commit_type selected_commit_type

	if {$selected_commit_type eq {new}
		&& [string match amend* $commit_type]} {
		create_new_commit
	} elseif {$selected_commit_type eq {amend}
		&& ![string match amend* $commit_type]} {
		load_last_commit

		# The amend request was rejected...
		#
		if {![string match amend* $commit_type]} {
3123
			set selected_commit_type new
3124 3125
		}
	}
3126 3127
}

3128
proc do_commit {} {
3129
	commit_tree
3130 3131
}

S
Shawn O. Pearce 已提交
3132
proc do_about {} {
3133
	global appvers copyright
3134
	global tcl_patchLevel tk_patchLevel
S
Shawn O. Pearce 已提交
3135 3136 3137 3138 3139

	set w .about_dialog
	toplevel $w
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"

3140
	label $w.header -text "About [appname]" \
S
Shawn O. Pearce 已提交
3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151
		-font font_uibold
	pack $w.header -side top -fill x

	frame $w.buttons
	button $w.buttons.close -text {Close} \
		-font font_ui \
		-command [list destroy $w]
	pack $w.buttons.close -side right
	pack $w.buttons -side bottom -fill x -pady 10 -padx 10

	label $w.desc \
3152
		-text "[appname] - a commit creation tool for Git.
3153
$copyright" \
S
Shawn O. Pearce 已提交
3154 3155 3156 3157 3158 3159 3160 3161
		-padx 5 -pady 5 \
		-justify left \
		-anchor w \
		-borderwidth 1 \
		-relief solid \
		-font font_ui
	pack $w.desc -side top -fill x -padx 5 -pady 5

3162
	set v {}
3163
	append v "[appname] version $appvers\n"
3164 3165
	append v "[exec git version]\n"
	append v "\n"
3166 3167 3168 3169 3170 3171 3172
	if {$tcl_patchLevel eq $tk_patchLevel} {
		append v "Tcl/Tk version $tcl_patchLevel"
	} else {
		append v "Tcl version $tcl_patchLevel"
		append v ", Tk version $tk_patchLevel"
	}

S
Shawn O. Pearce 已提交
3173
	label $w.vers \
3174
		-text $v \
S
Shawn O. Pearce 已提交
3175 3176 3177 3178 3179 3180 3181 3182
		-padx 5 -pady 5 \
		-justify left \
		-anchor w \
		-borderwidth 1 \
		-relief solid \
		-font font_ui
	pack $w.vers -side top -fill x -padx 5 -pady 5

3183 3184 3185 3186 3187 3188 3189 3190 3191
	menu $w.ctxm -tearoff 0
	$w.ctxm add command \
		-label {Copy} \
		-font font_ui \
		-command "
		clipboard clear
		clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
	"

S
Shawn O. Pearce 已提交
3192 3193
	bind $w <Visibility> "grab $w; focus $w"
	bind $w <Key-Escape> "destroy $w"
3194
	bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3195
	wm title $w "About [appname]"
S
Shawn O. Pearce 已提交
3196 3197 3198
	tkwait window $w
}

3199
proc do_options {} {
3200
	global repo_config global_config font_descs
3201 3202 3203 3204 3205 3206 3207
	global repo_config_new global_config_new

	array unset repo_config_new
	array unset global_config_new
	foreach name [array names repo_config] {
		set repo_config_new($name) $repo_config($name)
	}
3208 3209 3210 3211 3212 3213 3214
	load_config 1
	foreach name [array names repo_config] {
		switch -- $name {
		gui.diffcontext {continue}
		}
		set repo_config_new($name) $repo_config($name)
	}
3215 3216 3217 3218 3219 3220
	foreach name [array names global_config] {
		set global_config_new($name) $global_config($name)
	}

	set w .options_editor
	toplevel $w
3221
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3222

3223
	label $w.header -text "[appname] Options" \
3224 3225 3226 3227
		-font font_uibold
	pack $w.header -side top -fill x

	frame $w.buttons
3228 3229 3230 3231
	button $w.buttons.restore -text {Restore Defaults} \
		-font font_ui \
		-command do_restore_defaults
	pack $w.buttons.restore -side left
3232 3233
	button $w.buttons.save -text Save \
		-font font_ui \
3234 3235 3236 3237
		-command "
			catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
			do_save_config $w
		"
3238 3239 3240
	pack $w.buttons.save -side right
	button $w.buttons.cancel -text {Cancel} \
		-font font_ui \
3241
		-command [list destroy $w]
3242
	pack $w.buttons.cancel -side right -padx 5
3243
	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3244

3245
	labelframe $w.repo -text "[reponame] Repository" \
3246
		-font font_ui
3247
	labelframe $w.global -text {Global (All Repositories)} \
3248
		-font font_ui
3249 3250 3251 3252
	pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
	pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5

	foreach option {
3253 3254 3255
		{b pullsummary {Show Pull Summary}}
		{b trustmtime  {Trust File Modification Timestamps}}
		{i diffcontext {Number of Diff Context Lines}}
3256
		{t newbranchtemplate {New Branch Name Template}}
3257
		} {
3258 3259 3260
		set type [lindex $option 0]
		set name [lindex $option 1]
		set text [lindex $option 2]
3261
		foreach f {repo global} {
3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279
			switch $type {
			b {
				checkbutton $w.$f.$name -text $text \
					-variable ${f}_config_new(gui.$name) \
					-onvalue true \
					-offvalue false \
					-font font_ui
				pack $w.$f.$name -side top -anchor w
			}
			i {
				frame $w.$f.$name
				label $w.$f.$name.l -text "$text:" -font font_ui
				pack $w.$f.$name.l -side left -anchor w -fill x
				spinbox $w.$f.$name.v \
					-textvariable ${f}_config_new(gui.$name) \
					-from 1 -to 99 -increment 1 \
					-width 3 \
					-font font_ui
3280
				bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293
				pack $w.$f.$name.v -side right -anchor e -padx 5
				pack $w.$f.$name -side top -anchor w -fill x
			}
			t {
				frame $w.$f.$name
				label $w.$f.$name.l -text "$text:" -font font_ui
				text $w.$f.$name.v \
					-borderwidth 1 \
					-relief sunken \
					-height 1 \
					-width 20 \
					-font font_ui
				$w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3294 3295
				bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
				bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3296
				bind $w.$f.$name.v <Key-Return> break
3297
				bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3298 3299 3300 3301 3302 3303 3304 3305
				bind $w.$f.$name.v <FocusOut> "
					set ${f}_config_new(gui.$name) \
					\[string trim \[$w.$f.$name.v get 0.0 end\]\]
				"
				pack $w.$f.$name.l -side left -anchor w
				pack $w.$f.$name.v -side left -anchor w \
					-fill x -expand 1 \
					-padx 5
3306 3307 3308
				pack $w.$f.$name -side top -anchor w -fill x
			}
			}
3309 3310 3311
		}
	}

3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333
	set all_fonts [lsort [font families]]
	foreach option $font_descs {
		set name [lindex $option 0]
		set font [lindex $option 1]
		set text [lindex $option 2]

		set global_config_new(gui.$font^^family) \
			[font configure $font -family]
		set global_config_new(gui.$font^^size) \
			[font configure $font -size]

		frame $w.global.$name
		label $w.global.$name.l -text "$text:" -font font_ui
		pack $w.global.$name.l -side left -anchor w -fill x
		eval tk_optionMenu $w.global.$name.family \
			global_config_new(gui.$font^^family) \
			$all_fonts
		spinbox $w.global.$name.size \
			-textvariable global_config_new(gui.$font^^size) \
			-from 2 -to 80 -increment 1 \
			-width 3 \
			-font font_ui
3334
		bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3335 3336 3337 3338 3339
		pack $w.global.$name.size -side right -anchor e
		pack $w.global.$name.family -side right -anchor e
		pack $w.global.$name -side top -anchor w -fill x
	}

3340 3341
	bind $w <Visibility> "grab $w; focus $w"
	bind $w <Key-Escape> "destroy $w"
3342
	wm title $w "[appname] ([reponame]): Options"
3343 3344 3345
	tkwait window $w
}

3346
proc do_restore_defaults {} {
3347
	global font_descs default_config repo_config
3348 3349 3350 3351 3352 3353 3354 3355 3356
	global repo_config_new global_config_new

	foreach name [array names default_config] {
		set repo_config_new($name) $default_config($name)
		set global_config_new($name) $default_config($name)
	}

	foreach option $font_descs {
		set name [lindex $option 0]
3357
		set repo_config(gui.$name) $default_config(gui.$name)
3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374
	}
	apply_config

	foreach option $font_descs {
		set name [lindex $option 0]
		set font [lindex $option 1]
		set global_config_new(gui.$font^^family) \
			[font configure $font -family]
		set global_config_new(gui.$font^^size) \
			[font configure $font -size]
	}
}

proc do_save_config {w} {
	if {[catch {save_config} err]} {
		error_popup "Failed to completely save options:\n\n$err"
	}
3375
	reshow_diff
3376 3377 3378
	destroy $w
}

3379
proc do_windows_shortcut {} {
3380
	global argv0
3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392

	if {[catch {
		set desktop [exec cygpath \
			--windows \
			--absolute \
			--long-name \
			--desktop]
		}]} {
			set desktop .
	}
	set fn [tk_getSaveFile \
		-parent . \
3393
		-title "[appname] ([reponame]): Create Desktop Icon" \
3394
		-initialdir $desktop \
3395
		-initialfile "Git [reponame].bat"]
3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409
	if {$fn != {}} {
		if {[catch {
				set fd [open $fn w]
				set sh [exec cygpath \
					--windows \
					--absolute \
					/bin/sh]
				set me [exec cygpath \
					--unix \
					--absolute \
					$argv0]
				set gd [exec cygpath \
					--unix \
					--absolute \
3410
					[gitdir]]
3411 3412 3413 3414
				set gw [exec cygpath \
					--windows \
					--absolute \
					[file dirname [gitdir]]]
3415 3416
				regsub -all ' $me "'\\''" me
				regsub -all ' $gd "'\\''" gd
3417 3418
				puts $fd "@ECHO Entering $gw"
				puts $fd "@ECHO Starting git-gui... please wait..."
3419
				puts -nonewline $fd "@\"$sh\" --login -c \""
3420 3421
				puts -nonewline $fd "GIT_DIR='$gd'"
				puts -nonewline $fd " '$me'"
3422 3423 3424 3425 3426 3427 3428 3429
				puts $fd "&\""
				close $fd
			} err]} {
			error_popup "Cannot write script:\n\n$err"
		}
	}
}

3430
proc do_macosx_app {} {
3431
	global argv0 env
3432 3433 3434

	set fn [tk_getSaveFile \
		-parent . \
3435
		-title "[appname] ([reponame]): Create Desktop Icon" \
3436
		-initialdir [file join $env(HOME) Desktop] \
3437
		-initialfile "Git [reponame].app"]
3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471
	if {$fn != {}} {
		if {[catch {
				set Contents [file join $fn Contents]
				set MacOS [file join $Contents MacOS]
				set exe [file join $MacOS git-gui]

				file mkdir $MacOS

				set fd [open [file join $Contents Info.plist] w]
				puts $fd {<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
	<key>CFBundleDevelopmentRegion</key>
	<string>English</string>
	<key>CFBundleExecutable</key>
	<string>git-gui</string>
	<key>CFBundleIdentifier</key>
	<string>org.spearce.git-gui</string>
	<key>CFBundleInfoDictionaryVersion</key>
	<string>6.0</string>
	<key>CFBundlePackageType</key>
	<string>APPL</string>
	<key>CFBundleSignature</key>
	<string>????</string>
	<key>CFBundleVersion</key>
	<string>1.0</string>
	<key>NSPrincipalClass</key>
	<string>NSApplication</string>
</dict>
</plist>}
				close $fd

				set fd [open $exe w]
3472
				set gd [file normalize [gitdir]]
3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494
				set ep [file normalize [exec git --exec-path]]
				regsub -all ' $gd "'\\''" gd
				regsub -all ' $ep "'\\''" ep
				puts $fd "#!/bin/sh"
				foreach name [array names env] {
					if {[string match GIT_* $name]} {
						regsub -all ' $env($name) "'\\''" v
						puts $fd "export $name='$v'"
					}
				}
				puts $fd "export PATH='$ep':\$PATH"
				puts $fd "export GIT_DIR='$gd'"
				puts $fd "exec [file normalize $argv0]"
				close $fd

				file attributes $exe -permissions u+x,g+x,o+x
			} err]} {
			error_popup "Cannot write icon:\n\n$err"
		}
	}
}

3495
proc toggle_or_diff {w x y} {
3496
	global file_states file_lists current_diff_path ui_index ui_workdir
3497
	global last_clicked selected_paths
3498

S
Shawn O. Pearce 已提交
3499 3500 3501
	set pos [split [$w index @$x,$y] .]
	set lno [lindex $pos 0]
	set col [lindex $pos 1]
3502 3503 3504 3505 3506 3507 3508 3509 3510
	set path [lindex $file_lists($w) [expr {$lno - 1}]]
	if {$path eq {}} {
		set last_clicked {}
		return
	}

	set last_clicked [list $w $lno]
	array unset selected_paths
	$ui_index tag remove in_sel 0.0 end
3511
	$ui_workdir tag remove in_sel 0.0 end
S
Shawn O. Pearce 已提交
3512

3513
	if {$col == 0} {
3514
		if {$current_diff_path eq $path} {
3515 3516 3517 3518
			set after {reshow_diff;}
		} else {
			set after {}
		}
3519
		if {$w eq $ui_index} {
3520
			update_indexinfo \
3521
				"Unstaging [short_path $path] from commit" \
3522 3523
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
3524
		} elseif {$w eq $ui_workdir} {
3525
			update_index \
3526
				"Adding [short_path $path]" \
3527 3528 3529
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
		}
3530
	} else {
3531
		show_diff $path $w $lno
S
Shawn O. Pearce 已提交
3532 3533 3534
	}
}

3535
proc add_one_to_selection {w x y} {
3536
	global file_lists last_clicked selected_paths
3537

3538
	set lno [lindex [split [$w index @$x,$y] .] 0]
3539 3540 3541 3542 3543
	set path [lindex $file_lists($w) [expr {$lno - 1}]]
	if {$path eq {}} {
		set last_clicked {}
		return
	}
S
Shawn O. Pearce 已提交
3544

3545 3546 3547 3548 3549 3550
	if {$last_clicked ne {}
		&& [lindex $last_clicked 0] ne $w} {
		array unset selected_paths
		[lindex $last_clicked 0] tag remove in_sel 0.0 end
	}

3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564
	set last_clicked [list $w $lno]
	if {[catch {set in_sel $selected_paths($path)}]} {
		set in_sel 0
	}
	if {$in_sel} {
		unset selected_paths($path)
		$w tag remove in_sel $lno.0 [expr {$lno + 1}].0
	} else {
		set selected_paths($path) 1
		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
	}
}

proc add_range_to_selection {w x y} {
3565
	global file_lists last_clicked selected_paths
3566 3567 3568 3569

	if {[lindex $last_clicked 0] ne $w} {
		toggle_or_diff $w $x $y
		return
S
Shawn O. Pearce 已提交
3570
	}
3571

3572
	set lno [lindex [split [$w index @$x,$y] .] 0]
3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587
	set lc [lindex $last_clicked 1]
	if {$lc < $lno} {
		set begin $lc
		set end $lno
	} else {
		set begin $lno
		set end $lc
	}

	foreach path [lrange $file_lists($w) \
		[expr {$begin - 1}] \
		[expr {$end - 1}]] {
		set selected_paths($path) 1
	}
	$w tag add in_sel $begin.0 [expr {$end + 1}].0
S
Shawn O. Pearce 已提交
3588 3589 3590 3591
}

######################################################################
##
3592
## config defaults
S
Shawn O. Pearce 已提交
3593

3594
set cursor_ptr arrow
3595 3596 3597 3598 3599 3600 3601 3602
font create font_diff -family Courier -size 10
font create font_ui
catch {
	label .dummy
	eval font configure font_ui [font actual [.dummy cget -font]]
	destroy .dummy
}

3603 3604
font create font_uibold
font create font_diffbold
S
Shawn O. Pearce 已提交
3605

3606
if {[is_Windows]} {
3607 3608 3609 3610 3611
	set M1B Control
	set M1T Ctrl
} elseif {[is_MacOSX]} {
	set M1B M1
	set M1T Cmd
3612 3613 3614
} else {
	set M1B M1
	set M1T M1
3615 3616
}

3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637
proc apply_config {} {
	global repo_config font_descs

	foreach option $font_descs {
		set name [lindex $option 0]
		set font [lindex $option 1]
		if {[catch {
			foreach {cn cv} $repo_config(gui.$name) {
				font configure $font $cn $cv
			}
			} err]} {
			error_popup "Invalid font specified in gui.$name:\n\n$err"
		}
		foreach {cn cv} [font configure $font] {
			font configure ${font}bold $cn $cv
		}
		font configure ${font}bold -weight bold
	}
}

set default_config(gui.trustmtime) false
3638
set default_config(gui.pullsummary) true
3639
set default_config(gui.diffcontext) 5
3640
set default_config(gui.newbranchtemplate) {}
3641 3642 3643 3644 3645 3646
set default_config(gui.fontui) [font configure font_ui]
set default_config(gui.fontdiff) [font configure font_diff]
set font_descs {
	{fontui   font_ui   {Main Font}}
	{fontdiff font_diff {Diff/Console Font}}
}
3647
load_config 0
3648 3649 3650 3651 3652 3653
apply_config

######################################################################
##
## ui construction

S
Shawn O. Pearce 已提交
3654
# -- Menu Bar
3655
#
3656
menu .mbar -tearoff 0
3657
.mbar add cascade -label Repository -menu .mbar.repository
3658
.mbar add cascade -label Edit -menu .mbar.edit
S
Shawn O. Pearce 已提交
3659 3660 3661
if {!$single_commit} {
	.mbar add cascade -label Branch -menu .mbar.branch
}
S
Shawn O. Pearce 已提交
3662
.mbar add cascade -label Commit -menu .mbar.commit
3663 3664 3665 3666 3667
if {!$single_commit} {
	.mbar add cascade -label Fetch -menu .mbar.fetch
	.mbar add cascade -label Pull -menu .mbar.pull
	.mbar add cascade -label Push -menu .mbar.push
}
S
Shawn O. Pearce 已提交
3668 3669
. configure -menu .mbar

3670
# -- Repository Menu
3671
#
3672
menu .mbar.repository
3673 3674 3675
.mbar.repository add command \
	-label {Visualize Current Branch} \
	-command {do_gitk {}} \
3676
	-font font_ui
3677 3678 3679 3680 3681 3682
if {![is_MacOSX]} {
	.mbar.repository add command \
		-label {Visualize All Branches} \
		-command {do_gitk {--all}} \
		-font font_ui
}
3683
.mbar.repository add separator
3684

3685
if {!$single_commit} {
3686 3687 3688 3689
	.mbar.repository add command -label {Database Statistics} \
		-command do_stats \
		-font font_ui

3690 3691
	.mbar.repository add command -label {Compress Database} \
		-command do_gc \
3692
		-font font_ui
3693

3694
	.mbar.repository add command -label {Verify Database} \
3695 3696 3697
		-command do_fsck_objects \
		-font font_ui

3698
	.mbar.repository add separator
3699

3700
	if {[is_Windows]} {
3701
		.mbar.repository add command \
3702 3703 3704
			-label {Create Desktop Icon} \
			-command do_windows_shortcut \
			-font font_ui
3705
	} elseif {[is_MacOSX]} {
3706
		.mbar.repository add command \
3707 3708 3709
			-label {Create Desktop Icon} \
			-command do_macosx_app \
			-font font_ui
3710
	}
3711
}
3712

3713
.mbar.repository add command -label Quit \
S
Shawn O. Pearce 已提交
3714
	-command do_quit \
3715
	-accelerator $M1T-Q \
3716
	-font font_ui
S
Shawn O. Pearce 已提交
3717

3718 3719 3720 3721 3722 3723
# -- Edit Menu
#
menu .mbar.edit
.mbar.edit add command -label Undo \
	-command {catch {[focus] edit undo}} \
	-accelerator $M1T-Z \
3724
	-font font_ui
3725 3726 3727
.mbar.edit add command -label Redo \
	-command {catch {[focus] edit redo}} \
	-accelerator $M1T-Y \
3728
	-font font_ui
3729 3730 3731 3732
.mbar.edit add separator
.mbar.edit add command -label Cut \
	-command {catch {tk_textCut [focus]}} \
	-accelerator $M1T-X \
3733
	-font font_ui
3734 3735 3736
.mbar.edit add command -label Copy \
	-command {catch {tk_textCopy [focus]}} \
	-accelerator $M1T-C \
3737
	-font font_ui
3738 3739 3740
.mbar.edit add command -label Paste \
	-command {catch {tk_textPaste [focus]; [focus] see insert}} \
	-accelerator $M1T-V \
3741
	-font font_ui
3742 3743 3744
.mbar.edit add command -label Delete \
	-command {catch {[focus] delete sel.first sel.last}} \
	-accelerator Del \
3745
	-font font_ui
3746 3747 3748 3749
.mbar.edit add separator
.mbar.edit add command -label {Select All} \
	-command {catch {[focus] tag add sel 0.0 end}} \
	-accelerator $M1T-A \
3750
	-font font_ui
3751

3752 3753
# -- Branch Menu
#
S
Shawn O. Pearce 已提交
3754 3755 3756 3757 3758
if {!$single_commit} {
	menu .mbar.branch

	.mbar.branch add command -label {Create...} \
		-command do_create_branch \
3759
		-accelerator $M1T-N \
S
Shawn O. Pearce 已提交
3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770
		-font font_ui
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]

	.mbar.branch add command -label {Delete...} \
		-command do_delete_branch \
		-font font_ui
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]
}

S
Shawn O. Pearce 已提交
3771
# -- Commit Menu
3772
#
S
Shawn O. Pearce 已提交
3773
menu .mbar.commit
3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788

.mbar.commit add radiobutton \
	-label {New Commit} \
	-command do_select_commit_type \
	-variable selected_commit_type \
	-value new \
	-font font_ui
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]

.mbar.commit add radiobutton \
	-label {Amend Last Commit} \
	-command do_select_commit_type \
	-variable selected_commit_type \
	-value amend \
3789
	-font font_ui
3790 3791
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]
3792 3793 3794 3795 3796 3797

.mbar.commit add separator

.mbar.commit add command -label Rescan \
	-command do_rescan \
	-accelerator F5 \
3798
	-font font_ui
3799 3800
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]
3801

3802
.mbar.commit add command -label {Add To Commit} \
3803
	-command do_add_selection \
3804 3805 3806
	-font font_ui
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]
3807

3808
.mbar.commit add command -label {Add All To Commit} \
3809
	-command do_add_all \
3810
	-accelerator $M1T-I \
3811
	-font font_ui
3812 3813
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]
3814

3815 3816
.mbar.commit add command -label {Unstage From Commit} \
	-command do_unstage_selection \
3817 3818 3819 3820 3821 3822 3823 3824 3825 3826
	-font font_ui
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]

.mbar.commit add command -label {Revert Changes} \
	-command do_revert_selection \
	-font font_ui
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]

3827 3828
.mbar.commit add separator

3829 3830
.mbar.commit add command -label {Sign Off} \
	-command do_signoff \
3831
	-accelerator $M1T-S \
3832
	-font font_ui
3833

3834 3835
.mbar.commit add command -label Commit \
	-command do_commit \
3836
	-accelerator $M1T-Return \
3837
	-font font_ui
3838 3839
lappend disable_on_lock \
	[list .mbar.commit entryconf [.mbar.commit index last] -state]
S
Shawn O. Pearce 已提交
3840

3841 3842
# -- Transport menus
#
3843 3844 3845 3846 3847
if {!$single_commit} {
	menu .mbar.fetch
	menu .mbar.pull
	menu .mbar.push
}
3848

S
Shawn O. Pearce 已提交
3849 3850 3851 3852 3853 3854
if {[is_MacOSX]} {
	# -- Apple Menu (Mac OS X only)
	#
	.mbar add cascade -label Apple -menu .mbar.apple
	menu .mbar.apple

3855
	.mbar.apple add command -label "About [appname]" \
S
Shawn O. Pearce 已提交
3856 3857
		-command do_about \
		-font font_ui
3858
	.mbar.apple add command -label "[appname] Options..." \
S
Shawn O. Pearce 已提交
3859 3860 3861 3862 3863 3864 3865 3866 3867 3868
		-command do_options \
		-font font_ui
} else {
	# -- Edit Menu
	#
	.mbar.edit add separator
	.mbar.edit add command -label {Options...} \
		-command do_options \
		-font font_ui

3869 3870
	# -- Tools Menu
	#
3871 3872
	if {[file exists /usr/local/miga/lib/gui-miga]
		&& [file exists .pvcsrc]} {
3873
	proc do_miga {} {
3874
		global ui_status_value
3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898
		if {![lock_index update]} return
		set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
		set miga_fd [open "|$cmd" r]
		fconfigure $miga_fd -blocking 0
		fileevent $miga_fd readable [list miga_done $miga_fd]
		set ui_status_value {Running miga...}
	}
	proc miga_done {fd} {
		read $fd 512
		if {[eof $fd]} {
			close $fd
			unlock_index
			rescan [list set ui_status_value {Ready.}]
		}
	}
	.mbar add cascade -label Tools -menu .mbar.tools
	menu .mbar.tools
	.mbar.tools add command -label "Migrate" \
		-command do_miga \
		-font font_ui
	lappend disable_on_lock \
		[list .mbar.tools entryconf [.mbar.tools index last] -state]
	}

S
Shawn O. Pearce 已提交
3899 3900 3901 3902 3903
	# -- Help Menu
	#
	.mbar add cascade -label Help -menu .mbar.help
	menu .mbar.help

3904
	.mbar.help add command -label "About [appname]" \
S
Shawn O. Pearce 已提交
3905 3906 3907
		-command do_about \
		-font font_ui
}
S
Shawn O. Pearce 已提交
3908 3909


3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928
# -- Branch Control
#
frame .branch \
	-borderwidth 1 \
	-relief sunken
label .branch.l1 \
	-text {Current Branch:} \
	-anchor w \
	-justify left \
	-font font_ui
label .branch.cb \
	-textvariable current_branch \
	-anchor w \
	-justify left \
	-font font_ui
pack .branch.l1 -side left
pack .branch.cb -side left -fill x
pack .branch -side top -fill x

S
Shawn O. Pearce 已提交
3929
# -- Main Window Layout
3930
#
S
Shawn O. Pearce 已提交
3931 3932
panedwindow .vpane -orient vertical
panedwindow .vpane.files -orient horizontal
3933
.vpane add .vpane.files -sticky nsew -height 100 -width 200
S
Shawn O. Pearce 已提交
3934 3935 3936
pack .vpane -anchor n -side top -fill both -expand 1

# -- Index File List
3937
#
3938
frame .vpane.files.index -height 100 -width 200
3939
label .vpane.files.index.title -text {Changes To Be Committed} \
S
Shawn O. Pearce 已提交
3940
	-background green \
3941
	-font font_ui
S
Shawn O. Pearce 已提交
3942
text $ui_index -background white -borderwidth 0 \
3943
	-width 20 -height 10 \
3944
	-wrap none \
3945
	-font font_ui \
3946
	-cursor $cursor_ptr \
3947 3948
	-xscrollcommand {.vpane.files.index.sx set} \
	-yscrollcommand {.vpane.files.index.sy set} \
S
Shawn O. Pearce 已提交
3949
	-state disabled
3950 3951
scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
S
Shawn O. Pearce 已提交
3952
pack .vpane.files.index.title -side top -fill x
3953 3954
pack .vpane.files.index.sx -side bottom -fill x
pack .vpane.files.index.sy -side right -fill y
S
Shawn O. Pearce 已提交
3955 3956 3957
pack $ui_index -side left -fill both -expand 1
.vpane.files add .vpane.files.index -sticky nsew

3958
# -- Working Directory File List
3959
#
3960
frame .vpane.files.workdir -height 100 -width 200
3961
label .vpane.files.workdir.title -text {Changed But Not Updated} \
S
Shawn O. Pearce 已提交
3962
	-background red \
3963
	-font font_ui
3964
text $ui_workdir -background white -borderwidth 0 \
3965
	-width 20 -height 10 \
3966
	-wrap none \
3967
	-font font_ui \
3968
	-cursor $cursor_ptr \
3969 3970
	-xscrollcommand {.vpane.files.workdir.sx set} \
	-yscrollcommand {.vpane.files.workdir.sy set} \
S
Shawn O. Pearce 已提交
3971
	-state disabled
3972 3973
scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3974
pack .vpane.files.workdir.title -side top -fill x
3975 3976
pack .vpane.files.workdir.sx -side bottom -fill x
pack .vpane.files.workdir.sy -side right -fill y
3977 3978
pack $ui_workdir -side left -fill both -expand 1
.vpane.files add .vpane.files.workdir -sticky nsew
S
Shawn O. Pearce 已提交
3979

3980
foreach i [list $ui_index $ui_workdir] {
3981 3982 3983 3984 3985 3986
	$i tag conf in_diff -font font_uibold
	$i tag conf in_sel \
		-background [$i cget -foreground] \
		-foreground [$i cget -background]
}
unset i
3987

3988
# -- Diff and Commit Area
3989
#
3990
frame .vpane.lower -height 300 -width 400
3991 3992 3993 3994
frame .vpane.lower.commarea
frame .vpane.lower.diff -relief sunken -borderwidth 1
pack .vpane.lower.commarea -side top -fill x
pack .vpane.lower.diff -side bottom -fill both -expand 1
3995
.vpane add .vpane.lower -sticky nsew
S
Shawn O. Pearce 已提交
3996 3997

# -- Commit Area Buttons
3998
#
3999 4000
frame .vpane.lower.commarea.buttons
label .vpane.lower.commarea.buttons.l -text {} \
S
Shawn O. Pearce 已提交
4001 4002
	-anchor w \
	-justify left \
4003
	-font font_ui
4004 4005
pack .vpane.lower.commarea.buttons.l -side top -fill x
pack .vpane.lower.commarea.buttons -side left -fill y
4006

4007
button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
S
Shawn O. Pearce 已提交
4008
	-command do_rescan \
4009
	-font font_ui
4010
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4011 4012
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.rescan conf -state}
4013

4014
button .vpane.lower.commarea.buttons.incall -text {Add All} \
4015
	-command do_add_all \
4016
	-font font_ui
4017
pack .vpane.lower.commarea.buttons.incall -side top -fill x
4018 4019
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.incall conf -state}
4020

4021
button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4022
	-command do_signoff \
4023
	-font font_ui
4024
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4025

4026
button .vpane.lower.commarea.buttons.commit -text {Commit} \
S
Shawn O. Pearce 已提交
4027
	-command do_commit \
4028
	-font font_ui
4029
pack .vpane.lower.commarea.buttons.commit -side top -fill x
4030 4031
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.commit conf -state}
S
Shawn O. Pearce 已提交
4032 4033

# -- Commit Message Buffer
4034
#
4035
frame .vpane.lower.commarea.buffer
4036
frame .vpane.lower.commarea.buffer.header
4037
set ui_comm .vpane.lower.commarea.buffer.t
4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054
set ui_coml .vpane.lower.commarea.buffer.header.l
radiobutton .vpane.lower.commarea.buffer.header.new \
	-text {New Commit} \
	-command do_select_commit_type \
	-variable selected_commit_type \
	-value new \
	-font font_ui
lappend disable_on_lock \
	[list .vpane.lower.commarea.buffer.header.new conf -state]
radiobutton .vpane.lower.commarea.buffer.header.amend \
	-text {Amend Last Commit} \
	-command do_select_commit_type \
	-variable selected_commit_type \
	-value amend \
	-font font_ui
lappend disable_on_lock \
	[list .vpane.lower.commarea.buffer.header.amend conf -state]
4055
label $ui_coml \
S
Shawn O. Pearce 已提交
4056 4057
	-anchor w \
	-justify left \
4058
	-font font_ui
4059 4060 4061 4062 4063 4064
proc trace_commit_type {varname args} {
	global ui_coml commit_type
	switch -glob -- $commit_type {
	initial       {set txt {Initial Commit Message:}}
	amend         {set txt {Amended Commit Message:}}
	amend-initial {set txt {Amended Initial Commit Message:}}
4065
	amend-merge   {set txt {Amended Merge Commit Message:}}
4066 4067 4068 4069 4070 4071
	merge         {set txt {Merge Commit Message:}}
	*             {set txt {Commit Message:}}
	}
	$ui_coml conf -text $txt
}
trace add variable commit_type write trace_commit_type
4072 4073 4074 4075
pack $ui_coml -side left -fill x
pack .vpane.lower.commarea.buffer.header.amend -side right
pack .vpane.lower.commarea.buffer.header.new -side right

S
Shawn O. Pearce 已提交
4076
text $ui_comm -background white -borderwidth 1 \
4077
	-undo true \
4078
	-maxundo 20 \
4079
	-autoseparators true \
S
Shawn O. Pearce 已提交
4080
	-relief sunken \
4081
	-width 75 -height 9 -wrap none \
4082
	-font font_diff \
4083
	-yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4084 4085
scrollbar .vpane.lower.commarea.buffer.sby \
	-command [list $ui_comm yview]
4086
pack .vpane.lower.commarea.buffer.header -side top -fill x
4087
pack .vpane.lower.commarea.buffer.sby -side right -fill y
S
Shawn O. Pearce 已提交
4088
pack $ui_comm -side left -fill y
4089 4090
pack .vpane.lower.commarea.buffer -side left -fill y

4091 4092
# -- Commit Message Buffer Context Menu
#
4093 4094 4095 4096
set ctxm .vpane.lower.commarea.buffer.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
	-label {Cut} \
4097
	-font font_ui \
4098 4099 4100
	-command {tk_textCut $ui_comm}
$ctxm add command \
	-label {Copy} \
4101
	-font font_ui \
4102 4103 4104
	-command {tk_textCopy $ui_comm}
$ctxm add command \
	-label {Paste} \
4105
	-font font_ui \
4106 4107 4108
	-command {tk_textPaste $ui_comm}
$ctxm add command \
	-label {Delete} \
4109
	-font font_ui \
4110 4111 4112 4113
	-command {$ui_comm delete sel.first sel.last}
$ctxm add separator
$ctxm add command \
	-label {Select All} \
4114
	-font font_ui \
4115
	-command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4116 4117
$ctxm add command \
	-label {Copy All} \
4118
	-font font_ui \
4119
	-command {
4120 4121 4122
		$ui_comm tag add sel 0.0 end
		tk_textCopy $ui_comm
		$ui_comm tag remove sel 0.0 end
4123 4124 4125 4126
	}
$ctxm add separator
$ctxm add command \
	-label {Sign Off} \
4127
	-font font_ui \
4128
	-command do_signoff
4129
bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4130

4131
# -- Diff Header
4132
#
4133
set current_diff_path {}
4134
set diff_actions [list]
4135 4136 4137
proc trace_current_diff_path {varname args} {
	global current_diff_path diff_actions file_states
	if {$current_diff_path eq {}} {
4138 4139 4140 4141 4142
		set s {}
		set f {}
		set p {}
		set o disabled
	} else {
4143
		set p $current_diff_path
4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156
		set s [mapdesc [lindex $file_states($p) 0] $p]
		set f {File:}
		set p [escape_path $p]
		set o normal
	}

	.vpane.lower.diff.header.status configure -text $s
	.vpane.lower.diff.header.file configure -text $f
	.vpane.lower.diff.header.path configure -text $p
	foreach w $diff_actions {
		uplevel #0 $w $o
	}
}
4157
trace add variable current_diff_path write trace_current_diff_path
4158

4159
frame .vpane.lower.diff.header -background orange
4160
label .vpane.lower.diff.header.status \
4161 4162 4163 4164 4165
	-background orange \
	-width $max_status_desc \
	-anchor w \
	-justify left \
	-font font_ui
4166
label .vpane.lower.diff.header.file \
4167
	-background orange \
4168 4169
	-anchor w \
	-justify left \
4170
	-font font_ui
4171
label .vpane.lower.diff.header.path \
4172
	-background orange \
4173 4174
	-anchor w \
	-justify left \
4175
	-font font_ui
4176 4177 4178 4179 4180 4181 4182
pack .vpane.lower.diff.header.status -side left
pack .vpane.lower.diff.header.file -side left
pack .vpane.lower.diff.header.path -fill x
set ctxm .vpane.lower.diff.header.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
	-label {Copy} \
4183
	-font font_ui \
4184 4185 4186 4187 4188
	-command {
		clipboard clear
		clipboard append \
			-format STRING \
			-type STRING \
4189
			-- $current_diff_path
4190
	}
4191 4192
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4193 4194

# -- Diff Body
4195
#
4196 4197 4198 4199
frame .vpane.lower.diff.body
set ui_diff .vpane.lower.diff.body.t
text $ui_diff -background white -borderwidth 0 \
	-width 80 -height 15 -wrap none \
4200
	-font font_diff \
4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213
	-xscrollcommand {.vpane.lower.diff.body.sbx set} \
	-yscrollcommand {.vpane.lower.diff.body.sby set} \
	-state disabled
scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
	-command [list $ui_diff xview]
scrollbar .vpane.lower.diff.body.sby -orient vertical \
	-command [list $ui_diff yview]
pack .vpane.lower.diff.body.sbx -side bottom -fill x
pack .vpane.lower.diff.body.sby -side right -fill y
pack $ui_diff -side left -fill both -expand 1
pack .vpane.lower.diff.header -side top -fill x
pack .vpane.lower.diff.body -side bottom -fill both -expand 1

4214 4215
$ui_diff tag conf d_@ -foreground blue -font font_diffbold
$ui_diff tag conf d_+ -foreground {#00a000}
4216 4217
$ui_diff tag conf d_- -foreground red

4218
$ui_diff tag conf d_++ -foreground {#00a000}
4219 4220
$ui_diff tag conf d_-- -foreground red
$ui_diff tag conf d_+s \
4221 4222
	-foreground {#00a000} \
	-background {#e2effa}
4223 4224
$ui_diff tag conf d_-s \
	-foreground red \
4225
	-background {#e2effa}
4226
$ui_diff tag conf d_s+ \
4227 4228
	-foreground {#00a000} \
	-background ivory1
4229 4230
$ui_diff tag conf d_s- \
	-foreground red \
4231
	-background ivory1
4232 4233 4234 4235 4236 4237 4238 4239 4240 4241

$ui_diff tag conf d<<<<<<< \
	-foreground orange \
	-font font_diffbold
$ui_diff tag conf d======= \
	-foreground orange \
	-font font_diffbold
$ui_diff tag conf d>>>>>>> \
	-foreground orange \
	-font font_diffbold
S
Shawn O. Pearce 已提交
4242

4243 4244
$ui_diff tag raise sel

4245 4246
# -- Diff Body Context Menu
#
4247 4248
set ctxm .vpane.lower.diff.body.ctxm
menu $ctxm -tearoff 0
4249 4250 4251 4252
$ctxm add command \
	-label {Refresh} \
	-font font_ui \
	-command reshow_diff
4253 4254
$ctxm add command \
	-label {Copy} \
4255
	-font font_ui \
4256 4257 4258 4259
	-command {tk_textCopy $ui_diff}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Select All} \
4260
	-font font_ui \
4261
	-command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4262 4263 4264
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Copy All} \
4265
	-font font_ui \
4266
	-command {
4267 4268 4269
		$ui_diff tag add sel 0.0 end
		tk_textCopy $ui_diff
		$ui_diff tag remove sel 0.0 end
4270 4271 4272 4273 4274
	}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command \
	-label {Decrease Font Size} \
4275 4276
	-font font_ui \
	-command {incr_font_size font_diff -1}
4277 4278 4279
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Increase Font Size} \
4280 4281
	-font font_ui \
	-command {incr_font_size font_diff 1}
4282 4283 4284 4285
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command \
	-label {Show Less Context} \
4286
	-font font_ui \
4287
	-command {if {$repo_config(gui.diffcontext) >= 2} {
4288 4289 4290
		incr repo_config(gui.diffcontext) -1
		reshow_diff
	}}
4291 4292 4293
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Show More Context} \
4294
	-font font_ui \
4295
	-command {
4296 4297
		incr repo_config(gui.diffcontext)
		reshow_diff
4298 4299 4300 4301
	}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command -label {Options...} \
4302 4303
	-font font_ui \
	-command do_options
4304
bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
4305

S
Shawn O. Pearce 已提交
4306
# -- Status Bar
4307
#
S
Shawn O. Pearce 已提交
4308 4309 4310 4311 4312 4313
set ui_status_value {Initializing...}
label .status -textvariable ui_status_value \
	-anchor w \
	-justify left \
	-borderwidth 1 \
	-relief sunken \
4314
	-font font_ui
S
Shawn O. Pearce 已提交
4315 4316
pack .status -anchor w -side bottom -fill x

4317
# -- Load geometry
4318
#
4319
catch {
4320
set gm $repo_config(gui.geometry)
4321 4322 4323 4324 4325 4326 4327 4328
wm geometry . [lindex $gm 0]
.vpane sash place 0 \
	[lindex [.vpane sash coord 0] 0] \
	[lindex $gm 1]
.vpane.files sash place 0 \
	[lindex $gm 2] \
	[lindex [.vpane.files sash coord 0] 1]
unset gm
4329
}
4330

S
Shawn O. Pearce 已提交
4331
# -- Key Bindings
4332
#
4333
bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4334 4335
bind $ui_comm <$M1B-Key-i> {do_add_all;break}
bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352
bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}

bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-v> {break}
bind $ui_diff <$M1B-Key-V> {break}
bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4353 4354 4355 4356
bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4357

4358 4359 4360 4361 4362
if {!$single_commit} {
	bind . <$M1B-Key-n> do_create_branch
	bind . <$M1B-Key-N> do_create_branch
}

4363 4364 4365 4366 4367 4368
bind .   <Destroy> do_quit
bind all <Key-F5> do_rescan
bind all <$M1B-Key-r> do_rescan
bind all <$M1B-Key-R> do_rescan
bind .   <$M1B-Key-s> do_signoff
bind .   <$M1B-Key-S> do_signoff
4369 4370
bind .   <$M1B-Key-i> do_add_all
bind .   <$M1B-Key-I> do_add_all
4371 4372 4373 4374 4375
bind .   <$M1B-Key-Return> do_commit
bind all <$M1B-Key-q> do_quit
bind all <$M1B-Key-Q> do_quit
bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4376
foreach i [list $ui_index $ui_workdir] {
4377 4378 4379
	bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
	bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
	bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
S
Shawn O. Pearce 已提交
4380
}
4381 4382 4383
unset i

set file_lists($ui_index) [list]
4384
set file_lists($ui_workdir) [list]
4385 4386 4387

set HEAD {}
set PARENT {}
4388
set MERGE_HEAD [list]
4389 4390
set commit_type {}
set empty_tree {}
4391
set current_branch {}
4392
set current_diff_path {}
4393
set selected_commit_type new
S
Shawn O. Pearce 已提交
4394

4395
wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
S
Shawn O. Pearce 已提交
4396
focus -force $ui_comm
4397

4398 4399 4400
# -- Warn the user about environmental problems.  Cygwin's Tcl
#    does *not* pass its env array onto any processes it spawns.
#    This means that git processes get none of our environment.
4401 4402 4403 4404 4405 4406 4407 4408
#
if {[is_Windows]} {
	set ignored_env 0
	set suggest_user {}
	set msg "Possible environment issues exist.

The following environment variables are probably
going to be ignored by any Git subprocess run
4409
by [appname]:
4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452

"
	foreach name [array names env] {
		switch -regexp -- $name {
		{^GIT_INDEX_FILE$} -
		{^GIT_OBJECT_DIRECTORY$} -
		{^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
		{^GIT_DIFF_OPTS$} -
		{^GIT_EXTERNAL_DIFF$} -
		{^GIT_PAGER$} -
		{^GIT_TRACE$} -
		{^GIT_CONFIG$} -
		{^GIT_CONFIG_LOCAL$} -
		{^GIT_(AUTHOR|COMMITTER)_DATE$} {
			append msg " - $name\n"
			incr ignored_env
		}
		{^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
			append msg " - $name\n"
			incr ignored_env
			set suggest_user $name
		}
		}
	}
	if {$ignored_env > 0} {
		append msg "
This is due to a known issue with the
Tcl binary distributed by Cygwin."

		if {$suggest_user ne {}} {
			append msg "

A good replacement for $suggest_user
is placing values for the user.name and
user.email settings into your personal
~/.gitconfig file.
"
		}
		warn_popup $msg
	}
	unset ignored_env msg suggest_user name
}

4453 4454
# -- Only initialize complex UI if we are going to stay running.
#
4455 4456
if {!$single_commit} {
	load_all_remotes
4457
	load_all_heads
4458

4459
	populate_branch_menu
4460
	populate_fetch_menu .mbar.fetch
4461
	populate_pull_menu .mbar.pull
4462
	populate_push_menu .mbar.push
4463
}
4464

4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485
# -- Only suggest a gc run if we are going to stay running.
#
if {!$single_commit} {
	set object_limit 2000
	if {[is_Windows]} {set object_limit 200}
	regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
	if {$objects_current >= $object_limit} {
		if {[ask_popup \
			"This repository currently has $objects_current loose objects.

To maintain optimal performance it is strongly
recommended that you compress the database
when more than $object_limit loose objects exist.

Compress the database now?"] eq yes} {
			do_gc
		}
	}
	unset object_limit _junk objects_current
}

4486
lock_index begin-read
4487
after 1 do_rescan