git-gui.sh 56.0 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 {@@GITGUI_VERSION@@}
6
set copyright {
7
Copyright  2006, 2007 Shawn Pearce, et. al.
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 36 37 38 39 40
######################################################################
##
## enable verbose loading?

if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
	unset _verbose
	rename auto_load real__auto_load
	proc auto_load {name args} {
		puts stderr "auto_load $name"
		return [uplevel 1 real__auto_load $name $args]
	}
	rename source real__source
	proc source {name} {
		puts stderr "source    $name"
		uplevel 1 real__source $name
	}
}

41 42 43 44 45
######################################################################
##
## configure our library

set oguilib {@@GITGUI_LIBDIR@@}
46 47 48 49 50
set oguirel {@@GITGUI_RELATIVE@@}
if {$oguirel eq {1}} {
	set oguilib [file dirname [file dirname [file normalize $argv0]]]
	set oguilib [file join $oguilib share git-gui lib]
} elseif {[string match @@* $oguirel]} {
51 52
	set oguilib [file join [file dirname [file normalize $argv0]] lib]
}
53

54
set idx [file join $oguilib tclIndex]
55 56 57 58 59 60 61 62 63 64 65 66 67 68
if {[catch {set fd [open $idx r]} err]} {
	catch {wm withdraw .}
	tk_messageBox \
		-icon error \
		-type ok \
		-title "git-gui: fatal error" \
		-message $err
	exit 1
}
if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
	set idx [list]
	while {[gets $fd n] >= 0} {
		if {$n ne {} && ![string match #* $n]} {
			lappend idx $n
69 70
		}
	}
71 72
} else {
	set idx {}
73
}
74 75
close $fd

76 77 78 79 80 81 82 83 84 85 86
if {$idx ne {}} {
	set loaded [list]
	foreach p $idx {
		if {[lsearch -exact $loaded $p] >= 0} continue
		source [file join $oguilib $p]
		lappend loaded $p
	}
	unset loaded p
} else {
	set auto_path [concat [list $oguilib] $auto_path]
}
87
unset -nocomplain oguirel idx fd
88

89 90 91 92 93 94
######################################################################
##
## read only globals

set _appname [lindex [file split $argv0] end]
set _gitdir {}
95
set _gitexec {}
96
set _reponame {}
97
set _iscygwin {}
98 99 100 101 102 103

proc appname {} {
	global _appname
	return $_appname
}

104
proc gitdir {args} {
105
	global _gitdir
106 107 108 109
	if {$args eq {}} {
		return $_gitdir
	}
	return [eval [concat [list file join $_gitdir] $args]]
110 111
}

112 113 114
proc gitexec {args} {
	global _gitexec
	if {$_gitexec eq {}} {
115
		if {[catch {set _gitexec [git --exec-path]} err]} {
116 117 118 119 120 121 122 123 124
			error "Git not installed?\n\n$err"
		}
	}
	if {$args eq {}} {
		return $_gitexec
	}
	return [eval [concat [list file join $_gitexec] $args]]
}

125 126 127 128
proc reponame {} {
	global _reponame
	return $_reponame
}
129

130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
proc is_MacOSX {} {
	global tcl_platform tk_library
	if {[tk windowingsystem] eq {aqua}} {
		return 1
	}
	return 0
}

proc is_Windows {} {
	global tcl_platform
	if {$tcl_platform(platform) eq {windows}} {
		return 1
	}
	return 0
}

proc is_Cygwin {} {
	global tcl_platform _iscygwin
	if {$_iscygwin eq {}} {
		if {$tcl_platform(platform) eq {windows}} {
			if {[catch {set p [exec cygpath --windir]} err]} {
				set _iscygwin 0
			} else {
				set _iscygwin 1
			}
		} else {
			set _iscygwin 0
		}
	}
	return $_iscygwin
}

162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
proc is_enabled {option} {
	global enabled_options
	if {[catch {set on $enabled_options($option)}]} {return 0}
	return $on
}

proc enable_option {option} {
	global enabled_options
	set enabled_options($option) 1
}

proc disable_option {option} {
	global enabled_options
	set enabled_options($option) 0
}

178 179 180 181
######################################################################
##
## config

182 183 184 185 186 187 188 189 190
proc is_many_config {name} {
	switch -glob -- $name {
	remote.*.fetch -
	remote.*.push
		{return 1}
	*
		{return 0}
	}
}
191

192 193 194 195 196 197 198 199 200 201 202
proc is_config_true {name} {
	global repo_config
	if {[catch {set v $repo_config($name)}]} {
		return 0
	} elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
		return 1
	} else {
		return 0
	}
}

203
proc load_config {include_global} {
204 205 206
	global repo_config global_config default_config

	array unset global_config
207 208
	if {$include_global} {
		catch {
209
			set fd_rc [open "| git config --global --list" r]
210 211 212 213 214 215 216
			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
					}
217 218
				}
			}
219
			close $fd_rc
220 221
		}
	}
222 223

	array unset repo_config
224
	catch {
225
		set fd_rc [open "| git config --list" r]
226 227
		while {[gets $fd_rc line] >= 0} {
			if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
228 229 230 231 232
				if {[is_many_config $name]} {
					lappend repo_config($name) $value
				} else {
					set repo_config($name) $value
				}
233 234 235 236 237
			}
		}
		close $fd_rc
	}

238 239 240 241 242 243 244
	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)
		}
245 246 247
	}
}

248 249 250 251 252 253 254 255
######################################################################
##
## handy utils

proc git {args} {
	return [eval exec git $args]
}

256 257 258 259 260 261 262 263 264
auto_load tk_optionMenu
rename tk_optionMenu real__tkOptionMenu
proc tk_optionMenu {w varName args} {
	set m [eval real__tkOptionMenu $w $varName $args]
	$m configure -font font_ui
	$w configure -font font_ui
	return $m
}

265 266 267 268
######################################################################
##
## version check

269 270 271 272 273
if {{--version} eq $argv || {version} eq $argv} {
	puts "git-gui version $appvers"
	exit
}

274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
set req_maj 1
set req_min 5

if {[catch {set v [git --version]} err]} {
	catch {wm withdraw .}
	error_popup "Cannot determine Git version:

$err

[appname] requires Git $req_maj.$req_min or later."
	exit 1
}
if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
	if {$act_maj < $req_maj
		|| ($act_maj == $req_maj && $act_min < $req_min)} {
		catch {wm withdraw .}
		error_popup "[appname] requires Git $req_maj.$req_min or later.

You are using $v."
		exit 1
	}
} else {
	catch {wm withdraw .}
	error_popup "Cannot parse Git version string:\n\n$v"
	exit 1
}
unset -nocomplain v _junk act_maj act_min req_maj req_min

302 303 304 305
######################################################################
##
## repository setup

306 307 308 309 310 311 312 313
if {[catch {
		set _gitdir $env(GIT_DIR)
		set _prefix {}
		}]
	&& [catch {
		set _gitdir [git rev-parse --git-dir]
		set _prefix [git rev-parse --show-prefix]
	} err]} {
314 315
	catch {wm withdraw .}
	error_popup "Cannot find the git directory:\n\n$err"
316 317
	exit 1
}
318 319 320
if {![file isdirectory $_gitdir] && [is_Cygwin]} {
	catch {set _gitdir [exec cygpath --unix $_gitdir]}
}
321
if {![file isdirectory $_gitdir]} {
322
	catch {wm withdraw .}
323
	error_popup "Git directory not found:\n\n$_gitdir"
324 325
	exit 1
}
326
if {[lindex [file split $_gitdir] end] ne {.git}} {
327
	catch {wm withdraw .}
328
	error_popup "Cannot use funny .git directory:\n\n$_gitdir"
329 330
	exit 1
}
331
if {[catch {cd [file dirname $_gitdir]} err]} {
332
	catch {wm withdraw .}
333
	error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
334
	exit 1
335
}
336 337
set _reponame [lindex [file split \
	[file normalize [file dirname $_gitdir]]] \
338
	end]
339

340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357
######################################################################
##
## global init

set current_diff_path {}
set current_diff_side {}
set diff_actions [list]
set ui_status_value {Initializing...}

set HEAD {}
set PARENT {}
set MERGE_HEAD [list]
set commit_type {}
set empty_tree {}
set current_branch {}
set current_diff_path {}
set selected_commit_type new

S
Shawn O. Pearce 已提交
358 359
######################################################################
##
360
## task management
S
Shawn O. Pearce 已提交
361

362
set rescan_active 0
363
set diff_active 0
364
set last_clicked {}
365

366 367 368 369 370
set disable_on_lock [list]
set index_lock_type none

proc lock_index {type} {
	global index_lock_type disable_on_lock
371

372
	if {$index_lock_type eq {none}} {
373 374 375 376 377
		set index_lock_type $type
		foreach w $disable_on_lock {
			uplevel #0 $w disabled
		}
		return 1
378
	} elseif {$index_lock_type eq "begin-$type"} {
379
		set index_lock_type $type
380 381 382 383
		return 1
	}
	return 0
}
S
Shawn O. Pearce 已提交
384

385 386 387 388 389 390 391 392 393 394 395 396 397
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

398
proc repository_state {ctvar hdvar mhvar} {
399
	global current_branch
400 401 402
	upvar $ctvar ct $hdvar hd $mhvar mh

	set mh [list]
403

404
	if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
405 406
		set current_branch {}
	} else {
407
		regsub ^refs/((heads|tags|remotes)/)? \
408 409 410 411 412
			$current_branch \
			{} \
			current_branch
	}

413
	if {[catch {set hd [git rev-parse --verify HEAD]}]} {
414
		set hd {}
415
		set ct initial
416 417 418
		return
	}

419
	set merge_head [gitdir MERGE_HEAD]
420
	if {[file exists $merge_head]} {
421
		set ct merge
422 423 424 425 426 427
		set fd_mh [open $merge_head r]
		while {[gets $fd_mh line] >= 0} {
			lappend mh $line
		}
		close $fd_mh
		return
428
	}
429 430

	set ct normal
431 432
}

433 434 435
proc PARENT {} {
	global PARENT empty_tree

436 437 438
	set p [lindex $PARENT 0]
	if {$p ne {}} {
		return $p
439 440
	}
	if {$empty_tree eq {}} {
441
		set empty_tree [git mktree << {}]
442 443 444 445
	}
	return $empty_tree
}

446
proc rescan {after {honor_trustmtime 1}} {
447
	global HEAD PARENT MERGE_HEAD commit_type
448
	global ui_index ui_workdir ui_status_value ui_comm
449
	global rescan_active file_states
450
	global repo_config
S
Shawn O. Pearce 已提交
451

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

454
	repository_state newType newHEAD newMERGE_HEAD
455
	if {[string match amend* $commit_type]
456 457
		&& $newType eq {normal}
		&& $newHEAD eq $HEAD} {
458
	} else {
459 460 461 462
		set HEAD $newHEAD
		set PARENT $newHEAD
		set MERGE_HEAD $newMERGE_HEAD
		set commit_type $newType
463 464
	}

S
Shawn O. Pearce 已提交
465 466
	array unset file_states

467
	if {![$ui_comm edit modified]
468
		|| [string trim [$ui_comm get 0.0 end]] eq {}} {
469 470 471 472
		if {[load_message GITGUI_MSG]} {
		} elseif {[load_message MERGE_MSG]} {
		} elseif {[load_message SQUASH_MSG]} {
		}
473
		$ui_comm edit reset
474
		$ui_comm edit modified false
475 476
	}

477
	if {[is_enabled branch]} {
478 479 480 481
		load_all_heads
		populate_branch_menu
	}

482
	if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
483
		rescan_stage2 {} $after
484
	} else {
485
		set rescan_active 1
486
		set ui_status_value {Refreshing file status...}
487 488 489 490 491 492
		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]
493
		fconfigure $fd_rf -blocking 0 -translation binary
494
		fileevent $fd_rf readable \
495
			[list rescan_stage2 $fd_rf $after]
496
	}
497 498
}

499
proc rescan_stage2 {fd after} {
500
	global ui_status_value
501
	global rescan_active buf_rdi buf_rdf buf_rlo
502

503
	if {$fd ne {}} {
504 505 506 507
		read $fd
		if {![eof $fd]} return
		close $fd
	}
508

S
Shawn O. Pearce 已提交
509 510
	set ls_others [list | git ls-files --others -z \
		--exclude-per-directory=.gitignore]
511
	set info_exclude [gitdir info exclude]
S
Shawn O. Pearce 已提交
512 513 514 515
	if {[file readable $info_exclude]} {
		lappend ls_others "--exclude-from=$info_exclude"
	}

516 517 518 519
	set buf_rdi {}
	set buf_rdf {}
	set buf_rlo {}

520
	set rescan_active 3
521
	set ui_status_value {Scanning for modified files ...}
522
	set fd_di [open "| git diff-index --cached -z [PARENT]" r]
S
Shawn O. Pearce 已提交
523 524 525
	set fd_df [open "| git diff-files -z" r]
	set fd_lo [open $ls_others r]

526 527 528
	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
529 530 531
	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 已提交
532 533
}

534
proc load_message {file} {
535
	global ui_comm
536

537
	set f [gitdir $file]
538
	if {[file isfile $f]} {
539 540 541
		if {[catch {set fd [open $f r]}]} {
			return 0
		}
542
		set content [string trim [read $fd]]
543
		close $fd
544
		regsub -all -line {[ \r\t]+$} $content {} content
545 546 547 548 549 550 551
		$ui_comm delete 0.0 end
		$ui_comm insert end $content
		return 1
	}
	return 0
}

552
proc read_diff_index {fd after} {
S
Shawn O. Pearce 已提交
553 554 555
	global buf_rdi

	append buf_rdi [read $fd]
556 557 558 559 560 561 562 563 564 565
	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
566
		set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
567
		set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
568
		merge_state \
569
			[encoding convertfrom $p] \
570 571
			[lindex $i 4]? \
			[list [lindex $i 0] [lindex $i 2]] \
572 573
			[list]
		set c $z2
574
		incr c
S
Shawn O. Pearce 已提交
575
	}
576 577 578 579 580 581
	if {$c < $n} {
		set buf_rdi [string range $buf_rdi $c end]
	} else {
		set buf_rdi {}
	}

582
	rescan_done $fd buf_rdi $after
S
Shawn O. Pearce 已提交
583 584
}

585
proc read_diff_files {fd after} {
S
Shawn O. Pearce 已提交
586 587 588
	global buf_rdf

	append buf_rdf [read $fd]
589 590 591 592 593 594 595 596 597 598
	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
599
		set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
600
		set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
601
		merge_state \
602
			[encoding convertfrom $p] \
603
			?[lindex $i 4] \
604
			[list] \
605
			[list [lindex $i 0] [lindex $i 2]]
606
		set c $z2
607
		incr c
608 609 610 611 612
	}
	if {$c < $n} {
		set buf_rdf [string range $buf_rdf $c end]
	} else {
		set buf_rdf {}
S
Shawn O. Pearce 已提交
613
	}
614

615
	rescan_done $fd buf_rdf $after
S
Shawn O. Pearce 已提交
616 617
}

618
proc read_ls_others {fd after} {
S
Shawn O. Pearce 已提交
619 620 621 622 623 624
	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] {
625
		merge_state [encoding convertfrom $p] ?O
S
Shawn O. Pearce 已提交
626
	}
627
	rescan_done $fd buf_rlo $after
S
Shawn O. Pearce 已提交
628 629
}

630
proc rescan_done {fd buf after} {
631
	global rescan_active current_diff_path
632
	global file_states repo_config
633
	upvar $buf to_clear
S
Shawn O. Pearce 已提交
634

635 636 637
	if {![eof $fd]} return
	set to_clear {}
	close $fd
638
	if {[incr rescan_active -1] > 0} return
639

640
	prune_selection
641 642
	unlock_index
	display_all_files
643
	if {$current_diff_path ne {}} reshow_diff
644
	uplevel #0 $after
S
Shawn O. Pearce 已提交
645 646
}

647 648 649 650 651 652 653 654 655 656
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 已提交
657 658
######################################################################
##
659
## ui helpers
S
Shawn O. Pearce 已提交
660

661 662 663 664 665 666 667 668 669
proc mapicon {w state path} {
	global all_icons

	if {[catch {set r $all_icons($state$w)}]} {
		puts "error: no icon for $w state={$state} $path"
		return file_plain
	}
	return $r
}
S
Shawn O. Pearce 已提交
670

671 672
proc mapdesc {state path} {
	global all_descs
673

674 675 676 677 678 679
	if {[catch {set r $all_descs($state)}]} {
		puts "error: no desc for state={$state} $path"
		return $state
	}
	return $r
}
680

681 682 683 684
proc escape_path {path} {
	regsub -all {\\} $path "\\\\" path
	regsub -all "\n" $path "\\n" path
	return $path
S
Shawn O. Pearce 已提交
685 686
}

687 688
proc short_path {path} {
	return [escape_path [lindex [file split $path] end]]
689 690
}

691 692
set next_icon_id 0
set null_sha1 [string repeat 0 40]
693

694 695
proc merge_state {path new_state {head_info {}} {index_info {}}} {
	global file_states next_icon_id null_sha1
696

697 698
	set s0 [string index $new_state 0]
	set s1 [string index $new_state 1]
699

700 701 702 703 704 705 706 707 708
	if {[catch {set info $file_states($path)}]} {
		set state __
		set icon n[incr next_icon_id]
	} else {
		set state [lindex $info 0]
		set icon [lindex $info 1]
		if {$head_info eq {}}  {set head_info  [lindex $info 2]}
		if {$index_info eq {}} {set index_info [lindex $info 3]}
	}
709

710 711
	if     {$s0 eq {?}} {set s0 [string index $state 0]} \
	elseif {$s0 eq {_}} {set s0 _}
712

713 714
	if     {$s1 eq {?}} {set s1 [string index $state 1]} \
	elseif {$s1 eq {_}} {set s1 _}
715

716 717 718 719 720 721
	if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
		set head_info [list 0 $null_sha1]
	} elseif {$s0 ne {_} && [string index $state 0] eq {_}
		&& $head_info eq {}} {
		set head_info $index_info
	}
722

723 724 725 726 727
	set file_states($path) [list $s0$s1 $icon \
		$head_info $index_info \
		]
	return $state
}
S
Shawn O. Pearce 已提交
728

729 730
proc display_file_helper {w path icon_name old_m new_m} {
	global file_lists
S
Shawn O. Pearce 已提交
731

732
	if {$new_m eq {_}} {
733
		set lno [lsearch -sorted -exact $file_lists($w) $path]
734
		if {$lno >= 0} {
735
			set file_lists($w) [lreplace $file_lists($w) $lno $lno]
736
			incr lno
737 738 739
			$w conf -state normal
			$w delete $lno.0 [expr {$lno + 1}].0
			$w conf -state disabled
740
		}
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756
	} 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 -exact $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
757
	}
758 759 760 761 762
}

proc display_file {path state} {
	global file_states selected_paths
	global ui_index ui_workdir
763

764
	set old_m [merge_state $path $state]
S
Shawn O. Pearce 已提交
765
	set s $file_states($path)
766 767
	set new_m [lindex $s 0]
	set icon_name [lindex $s 1]
768

769 770 771 772 773 774 775
	set o [string index $old_m 0]
	set n [string index $new_m 0]
	if {$o eq {U}} {
		set o _
	}
	if {$n eq {U}} {
		set n _
S
Shawn O. Pearce 已提交
776
	}
777
	display_file_helper	$ui_index $path $icon_name $o $n
S
Shawn O. Pearce 已提交
778

779 780 781 782
	if {[string index $old_m 0] eq {U}} {
		set o U
	} else {
		set o [string index $old_m 1]
783
	}
784 785 786 787
	if {[string index $new_m 0] eq {U}} {
		set n U
	} else {
		set n [string index $new_m 1]
788
	}
789 790 791 792 793
	display_file_helper	$ui_workdir $path $icon_name $o $n

	if {$new_m eq {__}} {
		unset file_states($path)
		catch {unset selected_paths($path)}
S
Shawn O. Pearce 已提交
794
	}
795
}
S
Shawn O. Pearce 已提交
796

797 798 799 800 801 802 803 804 805 806
proc display_all_files_helper {w path icon_name m} {
	global file_lists

	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"
S
Shawn O. Pearce 已提交
807 808
}

809 810 811 812
proc display_all_files {} {
	global ui_index ui_workdir
	global file_states file_lists
	global last_clicked
S
Shawn O. Pearce 已提交
813

814 815
	$ui_index conf -state normal
	$ui_workdir conf -state normal
S
Shawn O. Pearce 已提交
816

817 818 819
	$ui_index delete 0.0 end
	$ui_workdir delete 0.0 end
	set last_clicked {}
S
Shawn O. Pearce 已提交
820

821 822
	set file_lists($ui_index) [list]
	set file_lists($ui_workdir) [list]
823

824 825 826 827 828 829 830 831 832
	foreach path [lsort [array names file_states]] {
		set s $file_states($path)
		set m [lindex $s 0]
		set icon_name [lindex $s 1]

		set s [string index $m 0]
		if {$s ne {U} && $s ne {_}} {
			display_all_files_helper $ui_index $path \
				$icon_name $s
833
		}
S
Shawn O. Pearce 已提交
834

835 836 837 838
		if {[string index $m 0] eq {U}} {
			set s U
		} else {
			set s [string index $m 1]
839
		}
840 841 842
		if {$s ne {_}} {
			display_all_files_helper $ui_workdir $path \
				$icon_name $s
843 844 845
		}
	}

846 847
	$ui_index conf -state disabled
	$ui_workdir conf -state disabled
848 849
}

850 851
######################################################################
##
852
## icons
853

854 855 856 857 858 859 860 861
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};
}
S
Shawn O. Pearce 已提交
862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880

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

881 882 883 884
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 已提交
885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925
   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

926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950
set file_dir_data {
#define file_width 18
#define file_height 18
static unsigned char file_bits[] = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
  0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
  0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
  0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}
image create bitmap file_dir -background white -foreground blue \
	-data $file_dir_data -maskdata $file_dir_data
unset file_dir_data

set file_uplevel_data {
#define up_width 15
#define up_height 15
static unsigned char up_bits[] = {
  0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
  0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
  0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
}
image create bitmap file_uplevel -background white -foreground red \
	-data $file_uplevel_data -maskdata $file_uplevel_data
unset file_uplevel_data
951

952
set ui_index .vpane.files.index.list
953
set ui_workdir .vpane.files.workdir.list
954 955 956 957 958 959 960 961 962 963

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
964
set all_icons(U$ui_workdir) file_merge
965 966
set all_icons(O$ui_workdir) file_plain

967
set max_status_desc 0
S
Shawn O. Pearce 已提交
968
foreach i {
969 970
		{__ "Unmodified"}

971 972 973 974 975 976 977 978 979
		{_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"}
980 981

		{_D "Missing"}
982 983
		{D_ "Staged for removal"}
		{DO "Staged for removal, still present"}
984

985
		{U_ "Requires merge resolution"}
986
		{UU "Requires merge resolution"}
987 988
		{UM "Requires merge resolution"}
		{UD "Requires merge resolution"}
S
Shawn O. Pearce 已提交
989
	} {
990 991
	if {$max_status_desc < [string length [lindex $i 1]]} {
		set max_status_desc [string length [lindex $i 1]]
992
	}
993
	set all_descs([lindex $i 0]) [lindex $i 1]
S
Shawn O. Pearce 已提交
994
}
995
unset i
S
Shawn O. Pearce 已提交
996 997 998 999 1000

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

1001 1002 1003 1004 1005 1006 1007
proc bind_button3 {w cmd} {
	bind $w <Any-Button-3> $cmd
	if {[is_MacOSX]} {
		bind $w <Control-Button-1> $cmd
	}
}

1008 1009 1010 1011 1012 1013 1014 1015 1016
proc scrollbar2many {list mode args} {
	foreach w $list {eval $w $mode $args}
}

proc many2scrollbar {list mode sb top bottom} {
	$sb set $top $bottom
	foreach w $list {$w $mode moveto $top}
}

1017 1018 1019 1020 1021 1022 1023
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
}

S
Shawn O. Pearce 已提交
1024 1025 1026 1027
######################################################################
##
## ui commands

1028
set starting_gitk_msg {Starting gitk... please wait...}
1029

1030
proc do_gitk {revs} {
1031 1032 1033 1034 1035
	global env ui_status_value starting_gitk_msg

	# -- Always start gitk through whatever we were loaded with.  This
	#    lets us bypass using shell process on Windows systems.
	#
1036
	set cmd [list [info nameofexecutable]]
1037
	lappend cmd [gitexec gitk]
1038 1039 1040
	if {$revs ne {}} {
		append cmd { }
		append cmd $revs
1041
	}
1042

1043
	if {[catch {eval exec $cmd &} err]} {
1044
		error_popup "Failed to start gitk:\n\n$err"
S
Shawn O. Pearce 已提交
1045
	} else {
1046 1047 1048 1049 1050 1051
		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 已提交
1052 1053 1054
	}
}

1055
set is_quitting 0
1056

S
Shawn O. Pearce 已提交
1057
proc do_quit {} {
1058
	global ui_comm is_quitting repo_config commit_type
1059

1060 1061
	if {$is_quitting} return
	set is_quitting 1
1062

1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
	if {[winfo exists $ui_comm]} {
		# -- Stash our current commit buffer.
		#
		set save [gitdir GITGUI_MSG]
		set msg [string trim [$ui_comm get 0.0 end]]
		regsub -all -line {[ \r\t]+$} $msg {} msg
		if {(![string match amend* $commit_type]
			|| [$ui_comm edit modified])
			&& $msg ne {}} {
			catch {
				set fd [open $save w]
				puts -nonewline $fd $msg
				close $fd
			}
		} else {
			catch {file delete $save}
1079 1080
		}

1081 1082 1083 1084 1085 1086 1087 1088 1089 1090
		# -- 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 {}
		}
		if {$cfg_geometry ne $rc_geometry} {
1091
			catch {git config gui.geometry $cfg_geometry}
1092
		}
1093 1094
	}

S
Shawn O. Pearce 已提交
1095 1096 1097 1098
	destroy .
}

proc do_rescan {} {
1099
	rescan {set ui_status_value {Ready.}}
S
Shawn O. Pearce 已提交
1100 1101
}

1102
proc do_commit {} {
1103
	commit_tree
1104 1105
}

1106
proc toggle_or_diff {w x y} {
1107
	global file_states file_lists current_diff_path ui_index ui_workdir
1108
	global last_clicked selected_paths
1109

S
Shawn O. Pearce 已提交
1110 1111 1112
	set pos [split [$w index @$x,$y] .]
	set lno [lindex $pos 0]
	set col [lindex $pos 1]
1113 1114 1115 1116 1117 1118 1119 1120 1121
	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
1122
	$ui_workdir tag remove in_sel 0.0 end
S
Shawn O. Pearce 已提交
1123

1124
	if {$col == 0} {
1125
		if {$current_diff_path eq $path} {
1126 1127 1128 1129
			set after {reshow_diff;}
		} else {
			set after {}
		}
1130
		if {$w eq $ui_index} {
1131
			update_indexinfo \
1132
				"Unstaging [short_path $path] from commit" \
1133 1134
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
1135
		} elseif {$w eq $ui_workdir} {
1136
			update_index \
1137
				"Adding [short_path $path]" \
1138 1139 1140
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
		}
1141
	} else {
1142
		show_diff $path $w $lno
S
Shawn O. Pearce 已提交
1143 1144 1145
	}
}

1146
proc add_one_to_selection {w x y} {
1147
	global file_lists last_clicked selected_paths
1148

1149
	set lno [lindex [split [$w index @$x,$y] .] 0]
1150 1151 1152 1153 1154
	set path [lindex $file_lists($w) [expr {$lno - 1}]]
	if {$path eq {}} {
		set last_clicked {}
		return
	}
S
Shawn O. Pearce 已提交
1155

1156 1157 1158 1159 1160 1161
	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
	}

1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175
	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} {
1176
	global file_lists last_clicked selected_paths
1177 1178 1179 1180

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

1183
	set lno [lindex [split [$w index @$x,$y] .] 0]
1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198
	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 已提交
1199 1200 1201 1202
}

######################################################################
##
1203
## config defaults
S
Shawn O. Pearce 已提交
1204

1205
set cursor_ptr arrow
1206 1207 1208 1209 1210 1211 1212 1213
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
}

1214 1215
font create font_uibold
font create font_diffbold
S
Shawn O. Pearce 已提交
1216

1217 1218 1219 1220 1221 1222 1223
foreach class {Button Checkbutton Entry Label
		Labelframe Listbox Menu Message
		Radiobutton Text} {
	option add *$class.font font_ui
}
unset class

1224
if {[is_MacOSX]} {
1225 1226
	set M1B M1
	set M1T Cmd
1227
} else {
1228 1229
	set M1B Control
	set M1T Ctrl
1230 1231
}

1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251
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
	}
}

1252
set default_config(merge.summary) false
1253
set default_config(merge.verbosity) 2
1254 1255 1256
set default_config(user.name) {}
set default_config(user.email) {}

1257
set default_config(gui.pruneduringfetch) false
1258
set default_config(gui.trustmtime) false
1259
set default_config(gui.diffcontext) 5
1260
set default_config(gui.newbranchtemplate) {}
1261 1262 1263 1264 1265 1266
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}}
}
1267
load_config 0
1268 1269
apply_config

1270 1271 1272 1273
######################################################################
##
## feature option selection

1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286
if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
	unset _junk
} else {
	set subcommand gui
}
if {$subcommand eq {gui.sh}} {
	set subcommand gui
}
if {$subcommand eq {gui} && [llength $argv] > 0} {
	set subcommand [lindex $argv 0]
	set argv [lrange $argv 1 end]
}

1287 1288 1289 1290
enable_option multicommit
enable_option branch
enable_option transport

1291
switch -- $subcommand {
1292
browser -
1293
blame {
1294 1295 1296 1297
	disable_option multicommit
	disable_option branch
	disable_option transport
}
1298 1299
citool {
	enable_option singlecommit
1300 1301 1302 1303 1304 1305 1306

	disable_option multicommit
	disable_option branch
	disable_option transport
}
}

1307 1308 1309 1310
######################################################################
##
## ui construction

1311 1312
set ui_comm {}

S
Shawn O. Pearce 已提交
1313
# -- Menu Bar
1314
#
1315
menu .mbar -tearoff 0
1316 1317
.mbar add cascade -label Repository -menu .mbar.repository
.mbar add cascade -label Edit -menu .mbar.edit
1318
if {[is_enabled branch]} {
1319
	.mbar add cascade -label Branch -menu .mbar.branch
S
Shawn O. Pearce 已提交
1320
}
1321
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1322
	.mbar add cascade -label Commit -menu .mbar.commit
1323
}
1324
if {[is_enabled transport]} {
1325 1326 1327
	.mbar add cascade -label Merge -menu .mbar.merge
	.mbar add cascade -label Fetch -menu .mbar.fetch
	.mbar add cascade -label Push -menu .mbar.push
1328
}
S
Shawn O. Pearce 已提交
1329 1330
. configure -menu .mbar

1331
# -- Repository Menu
1332
#
1333
menu .mbar.repository
1334 1335 1336

.mbar.repository add command \
	-label {Browse Current Branch} \
1337
	-command {browser::new $current_branch}
1338
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1339 1340
.mbar.repository add separator

1341 1342
.mbar.repository add command \
	-label {Visualize Current Branch} \
1343
	-command {do_gitk $current_branch}
1344
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1345 1346
.mbar.repository add command \
	-label {Visualize All Branches} \
1347
	-command {do_gitk --all}
1348
.mbar.repository add separator
1349

1350
if {[is_enabled multicommit]} {
1351
	.mbar.repository add command -label {Database Statistics} \
1352
		-command do_stats
1353

1354
	.mbar.repository add command -label {Compress Database} \
1355
		-command do_gc
1356

1357
	.mbar.repository add command -label {Verify Database} \
1358
		-command do_fsck_objects
1359

1360
	.mbar.repository add separator
1361

1362 1363 1364
	if {[is_Cygwin]} {
		.mbar.repository add command \
			-label {Create Desktop Icon} \
1365
			-command do_cygwin_shortcut
1366
	} elseif {[is_Windows]} {
1367
		.mbar.repository add command \
1368
			-label {Create Desktop Icon} \
1369
			-command do_windows_shortcut
1370
	} elseif {[is_MacOSX]} {
1371
		.mbar.repository add command \
1372
			-label {Create Desktop Icon} \
1373
			-command do_macosx_app
1374
	}
1375
}
1376

1377
.mbar.repository add command -label Quit \
S
Shawn O. Pearce 已提交
1378
	-command do_quit \
1379
	-accelerator $M1T-Q
S
Shawn O. Pearce 已提交
1380

1381 1382 1383 1384 1385
# -- Edit Menu
#
menu .mbar.edit
.mbar.edit add command -label Undo \
	-command {catch {[focus] edit undo}} \
1386
	-accelerator $M1T-Z
1387 1388
.mbar.edit add command -label Redo \
	-command {catch {[focus] edit redo}} \
1389
	-accelerator $M1T-Y
1390 1391 1392
.mbar.edit add separator
.mbar.edit add command -label Cut \
	-command {catch {tk_textCut [focus]}} \
1393
	-accelerator $M1T-X
1394 1395
.mbar.edit add command -label Copy \
	-command {catch {tk_textCopy [focus]}} \
1396
	-accelerator $M1T-C
1397 1398
.mbar.edit add command -label Paste \
	-command {catch {tk_textPaste [focus]; [focus] see insert}} \
1399
	-accelerator $M1T-V
1400 1401
.mbar.edit add command -label Delete \
	-command {catch {[focus] delete sel.first sel.last}} \
1402
	-accelerator Del
1403 1404 1405
.mbar.edit add separator
.mbar.edit add command -label {Select All} \
	-command {catch {[focus] tag add sel 0.0 end}} \
1406
	-accelerator $M1T-A
1407

1408 1409
# -- Branch Menu
#
1410
if {[is_enabled branch]} {
S
Shawn O. Pearce 已提交
1411 1412 1413 1414
	menu .mbar.branch

	.mbar.branch add command -label {Create...} \
		-command do_create_branch \
1415
		-accelerator $M1T-N
S
Shawn O. Pearce 已提交
1416 1417 1418 1419
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]

	.mbar.branch add command -label {Delete...} \
1420
		-command do_delete_branch
S
Shawn O. Pearce 已提交
1421 1422
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]
1423 1424

	.mbar.branch add command -label {Reset...} \
1425
		-command merge::reset_hard
1426 1427
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]
S
Shawn O. Pearce 已提交
1428 1429
}

S
Shawn O. Pearce 已提交
1430
# -- Commit Menu
1431
#
1432 1433 1434 1435 1436 1437 1438
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
	menu .mbar.commit

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

1443 1444 1445 1446
	.mbar.commit add radiobutton \
		-label {Amend Last Commit} \
		-command do_select_commit_type \
		-variable selected_commit_type \
1447
		-value amend
1448 1449
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1450

1451
	.mbar.commit add separator
1452

1453 1454
	.mbar.commit add command -label Rescan \
		-command do_rescan \
1455
		-accelerator F5
1456 1457
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1458

1459
	.mbar.commit add command -label {Add To Commit} \
1460
		-command do_add_selection
1461 1462
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1463

1464
	.mbar.commit add command -label {Add Existing To Commit} \
1465
		-command do_add_all \
1466
		-accelerator $M1T-I
1467 1468
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1469

1470
	.mbar.commit add command -label {Unstage From Commit} \
1471
		-command do_unstage_selection
1472 1473
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1474

1475
	.mbar.commit add command -label {Revert Changes} \
1476
		-command do_revert_selection
1477 1478
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1479

1480
	.mbar.commit add separator
1481

1482 1483
	.mbar.commit add command -label {Sign Off} \
		-command do_signoff \
1484
		-accelerator $M1T-S
1485

1486 1487
	.mbar.commit add command -label Commit \
		-command do_commit \
1488
		-accelerator $M1T-Return
1489 1490 1491
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
}
S
Shawn O. Pearce 已提交
1492

1493 1494 1495 1496 1497
# -- Merge Menu
#
if {[is_enabled branch]} {
	menu .mbar.merge
	.mbar.merge add command -label {Local Merge...} \
1498
		-command merge::dialog
1499 1500 1501
	lappend disable_on_lock \
		[list .mbar.merge entryconf [.mbar.merge index last] -state]
	.mbar.merge add command -label {Abort Merge...} \
1502
		-command merge::reset_hard
1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514
	lappend disable_on_lock \
		[list .mbar.merge entryconf [.mbar.merge index last] -state]

}

# -- Transport Menu
#
if {[is_enabled transport]} {
	menu .mbar.fetch

	menu .mbar.push
	.mbar.push add command -label {Push...} \
1515
		-command do_push_anywhere
1516 1517
}

S
Shawn O. Pearce 已提交
1518 1519 1520 1521 1522 1523
if {[is_MacOSX]} {
	# -- Apple Menu (Mac OS X only)
	#
	.mbar add cascade -label Apple -menu .mbar.apple
	menu .mbar.apple

1524
	.mbar.apple add command -label "About [appname]" \
1525
		-command do_about
1526
	.mbar.apple add command -label "Options..." \
1527
		-command do_options
S
Shawn O. Pearce 已提交
1528 1529 1530 1531 1532
} else {
	# -- Edit Menu
	#
	.mbar.edit add separator
	.mbar.edit add command -label {Options...} \
1533
		-command do_options
S
Shawn O. Pearce 已提交
1534

1535 1536
	# -- Tools Menu
	#
1537 1538
	if {[file exists /usr/local/miga/lib/gui-miga]
		&& [file exists .pvcsrc]} {
1539
	proc do_miga {} {
1540
		global ui_status_value
1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558
		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" \
1559
		-command do_miga
1560 1561 1562
	lappend disable_on_lock \
		[list .mbar.tools entryconf [.mbar.tools index last] -state]
	}
1563
}
1564

1565 1566
# -- Help Menu
#
1567
.mbar add cascade -label Help -menu .mbar.help
1568
menu .mbar.help
S
Shawn O. Pearce 已提交
1569

1570
if {![is_MacOSX]} {
1571
	.mbar.help add command -label "About [appname]" \
1572
		-command do_about
S
Shawn O. Pearce 已提交
1573
}
S
Shawn O. Pearce 已提交
1574

1575 1576
set browser {}
catch {set browser $repo_config(instaweb.browser)}
1577
set doc_path [file dirname [gitexec]]
1578 1579
set doc_path [file join $doc_path Documentation index.html]

1580
if {[is_Cygwin]} {
1581
	set doc_path [exec cygpath --mixed $doc_path]
1582 1583 1584 1585 1586
}

if {$browser eq {}} {
	if {[is_MacOSX]} {
		set browser open
1587
	} elseif {[is_Cygwin]} {
1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608
		set program_files [file dirname [exec cygpath --windir]]
		set program_files [file join $program_files {Program Files}]
		set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
		set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
		if {[file exists $firefox]} {
			set browser $firefox
		} elseif {[file exists $ie]} {
			set browser $ie
		}
		unset program_files firefox ie
	}
}

if {[file isfile $doc_path]} {
	set doc_url "file:$doc_path"
} else {
	set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
}

if {$browser ne {}} {
	.mbar.help add command -label {Online Documentation} \
1609
		-command [list exec $browser $doc_url &]
1610 1611
}
unset browser doc_path doc_url
S
Shawn O. Pearce 已提交
1612

1613 1614 1615 1616 1617 1618 1619 1620
# -- Standard bindings
#
bind .   <Destroy> do_quit
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]}

1621 1622 1623 1624 1625 1626
set subcommand_args {}
proc usage {} {
	puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
	exit 1
}

1627 1628
# -- Not a normal commit type invocation?  Do that instead!
#
1629
switch -- $subcommand {
1630
browser {
1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641
	set subcommand_args {rev?}
	switch [llength $argv] {
	0 {
		set current_branch [git symbolic-ref HEAD]
		regsub ^refs/((heads|tags|remotes)/)? \
			$current_branch {} current_branch
	}
	1 {
		set current_branch [lindex $argv 0]
	}
	default usage
1642
	}
1643
	browser::new $current_branch
1644 1645
	return
}
1646
blame {
1647
	set subcommand_args {rev? path?}
1648
	set head {}
1649 1650 1651 1652 1653
	set path {}
	set is_path 0
	foreach a $argv {
		if {$is_path || [file exists $_prefix$a]} {
			if {$path ne {}} usage
1654
			set path $_prefix$a
1655 1656 1657
			break
		} elseif {$a eq {--}} {
			if {$path ne {}} {
1658 1659
				if {$head ne {}} usage
				set head $path
1660 1661 1662
				set path {}
			}
			set is_path 1
1663 1664 1665
		} elseif {$head eq {}} {
			if {$head ne {}} usage
			set head $a
1666 1667 1668 1669 1670 1671
		} else {
			usage
		}
	}
	unset is_path

1672
	if {$head eq {}} {
1673 1674 1675
		set current_branch [git symbolic-ref HEAD]
		regsub ^refs/((heads|tags|remotes)/)? \
			$current_branch {} current_branch
1676 1677
	} else {
		set current_branch $head
1678
	}
1679 1680 1681

	if {$path eq {}} usage
	blame::new $head $path
1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694
	return
}
citool -
gui {
	if {[llength $argv] != 0} {
		puts -nonewline stderr "usage: $argv0"
		if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
			puts -nonewline stderr " $subcommand"
		}
		puts stderr {}
		exit 1
	}
	# fall through to setup UI for commits
1695 1696
}
default {
1697
	puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
1698 1699 1700 1701
	exit 1
}
}

1702 1703 1704 1705 1706 1707 1708 1709
# -- Branch Control
#
frame .branch \
	-borderwidth 1 \
	-relief sunken
label .branch.l1 \
	-text {Current Branch:} \
	-anchor w \
1710
	-justify left
1711 1712 1713
label .branch.cb \
	-textvariable current_branch \
	-anchor w \
1714
	-justify left
1715 1716 1717 1718
pack .branch.l1 -side left
pack .branch.cb -side left -fill x
pack .branch -side top -fill x

S
Shawn O. Pearce 已提交
1719
# -- Main Window Layout
1720
#
S
Shawn O. Pearce 已提交
1721 1722
panedwindow .vpane -orient vertical
panedwindow .vpane.files -orient horizontal
1723
.vpane add .vpane.files -sticky nsew -height 100 -width 200
S
Shawn O. Pearce 已提交
1724 1725 1726
pack .vpane -anchor n -side top -fill both -expand 1

# -- Index File List
1727
#
1728
frame .vpane.files.index -height 100 -width 200
1729
label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
1730
	-background green
S
Shawn O. Pearce 已提交
1731
text $ui_index -background white -borderwidth 0 \
1732
	-width 20 -height 10 \
1733
	-wrap none \
1734
	-cursor $cursor_ptr \
1735 1736
	-xscrollcommand {.vpane.files.index.sx set} \
	-yscrollcommand {.vpane.files.index.sy set} \
S
Shawn O. Pearce 已提交
1737
	-state disabled
1738 1739
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 已提交
1740
pack .vpane.files.index.title -side top -fill x
1741 1742
pack .vpane.files.index.sx -side bottom -fill x
pack .vpane.files.index.sy -side right -fill y
S
Shawn O. Pearce 已提交
1743 1744 1745
pack $ui_index -side left -fill both -expand 1
.vpane.files add .vpane.files.index -sticky nsew

1746
# -- Working Directory File List
1747
#
1748
frame .vpane.files.workdir -height 100 -width 200
1749
label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
1750
	-background red
1751
text $ui_workdir -background white -borderwidth 0 \
1752
	-width 20 -height 10 \
1753
	-wrap none \
1754
	-cursor $cursor_ptr \
1755 1756
	-xscrollcommand {.vpane.files.workdir.sx set} \
	-yscrollcommand {.vpane.files.workdir.sy set} \
S
Shawn O. Pearce 已提交
1757
	-state disabled
1758 1759
scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
1760
pack .vpane.files.workdir.title -side top -fill x
1761 1762
pack .vpane.files.workdir.sx -side bottom -fill x
pack .vpane.files.workdir.sy -side right -fill y
1763 1764
pack $ui_workdir -side left -fill both -expand 1
.vpane.files add .vpane.files.workdir -sticky nsew
S
Shawn O. Pearce 已提交
1765

1766
foreach i [list $ui_index $ui_workdir] {
1767 1768 1769 1770 1771 1772
	$i tag conf in_diff -font font_uibold
	$i tag conf in_sel \
		-background [$i cget -foreground] \
		-foreground [$i cget -background]
}
unset i
1773

1774
# -- Diff and Commit Area
1775
#
1776
frame .vpane.lower -height 300 -width 400
1777 1778 1779 1780
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
1781
.vpane add .vpane.lower -sticky nsew
S
Shawn O. Pearce 已提交
1782 1783

# -- Commit Area Buttons
1784
#
1785 1786
frame .vpane.lower.commarea.buttons
label .vpane.lower.commarea.buttons.l -text {} \
S
Shawn O. Pearce 已提交
1787
	-anchor w \
1788
	-justify left
1789 1790
pack .vpane.lower.commarea.buttons.l -side top -fill x
pack .vpane.lower.commarea.buttons -side left -fill y
1791

1792
button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1793
	-command do_rescan
1794
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1795 1796
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.rescan conf -state}
1797

1798
button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
1799
	-command do_add_all
1800
pack .vpane.lower.commarea.buttons.incall -side top -fill x
1801 1802
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.incall conf -state}
1803

1804
button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1805
	-command do_signoff
1806
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1807

1808
button .vpane.lower.commarea.buttons.commit -text {Commit} \
1809
	-command do_commit
1810
pack .vpane.lower.commarea.buttons.commit -side top -fill x
1811 1812
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.commit conf -state}
S
Shawn O. Pearce 已提交
1813 1814

# -- Commit Message Buffer
1815
#
1816
frame .vpane.lower.commarea.buffer
1817
frame .vpane.lower.commarea.buffer.header
1818
set ui_comm .vpane.lower.commarea.buffer.t
1819 1820 1821 1822 1823
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 \
1824
	-value new
1825 1826 1827 1828 1829 1830
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 \
1831
	-value amend
1832 1833
lappend disable_on_lock \
	[list .vpane.lower.commarea.buffer.header.amend conf -state]
1834
label $ui_coml \
S
Shawn O. Pearce 已提交
1835
	-anchor w \
1836
	-justify left
1837 1838 1839 1840 1841 1842
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:}}
1843
	amend-merge   {set txt {Amended Merge Commit Message:}}
1844 1845 1846 1847 1848 1849
	merge         {set txt {Merge Commit Message:}}
	*             {set txt {Commit Message:}}
	}
	$ui_coml conf -text $txt
}
trace add variable commit_type write trace_commit_type
1850 1851 1852 1853
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 已提交
1854
text $ui_comm -background white -borderwidth 1 \
1855
	-undo true \
1856
	-maxundo 20 \
1857
	-autoseparators true \
S
Shawn O. Pearce 已提交
1858
	-relief sunken \
1859
	-width 75 -height 9 -wrap none \
1860
	-font font_diff \
1861
	-yscrollcommand {.vpane.lower.commarea.buffer.sby set}
1862 1863
scrollbar .vpane.lower.commarea.buffer.sby \
	-command [list $ui_comm yview]
1864
pack .vpane.lower.commarea.buffer.header -side top -fill x
1865
pack .vpane.lower.commarea.buffer.sby -side right -fill y
S
Shawn O. Pearce 已提交
1866
pack $ui_comm -side left -fill y
1867 1868
pack .vpane.lower.commarea.buffer -side left -fill y

1869 1870
# -- Commit Message Buffer Context Menu
#
1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887
set ctxm .vpane.lower.commarea.buffer.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
	-label {Cut} \
	-command {tk_textCut $ui_comm}
$ctxm add command \
	-label {Copy} \
	-command {tk_textCopy $ui_comm}
$ctxm add command \
	-label {Paste} \
	-command {tk_textPaste $ui_comm}
$ctxm add command \
	-label {Delete} \
	-command {$ui_comm delete sel.first sel.last}
$ctxm add separator
$ctxm add command \
	-label {Select All} \
1888
	-command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
1889 1890 1891
$ctxm add command \
	-label {Copy All} \
	-command {
1892 1893 1894
		$ui_comm tag add sel 0.0 end
		tk_textCopy $ui_comm
		$ui_comm tag remove sel 0.0 end
1895 1896 1897 1898
	}
$ctxm add separator
$ctxm add command \
	-label {Sign Off} \
1899
	-command do_signoff
1900
bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
1901

1902
# -- Diff Header
1903
#
1904 1905 1906
proc trace_current_diff_path {varname args} {
	global current_diff_path diff_actions file_states
	if {$current_diff_path eq {}} {
1907 1908 1909 1910 1911
		set s {}
		set f {}
		set p {}
		set o disabled
	} else {
1912
		set p $current_diff_path
1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925
		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
	}
}
1926
trace add variable current_diff_path write trace_current_diff_path
1927

1928
frame .vpane.lower.diff.header -background orange
1929
label .vpane.lower.diff.header.status \
1930 1931 1932
	-background orange \
	-width $max_status_desc \
	-anchor w \
1933
	-justify left
1934
label .vpane.lower.diff.header.file \
1935
	-background orange \
1936
	-anchor w \
1937
	-justify left
1938
label .vpane.lower.diff.header.path \
1939
	-background orange \
1940
	-anchor w \
1941
	-justify left
1942 1943 1944 1945 1946 1947 1948
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} \
1949 1950 1951 1952 1953
	-command {
		clipboard clear
		clipboard append \
			-format STRING \
			-type STRING \
1954
			-- $current_diff_path
1955
	}
1956 1957
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
1958 1959

# -- Diff Body
1960
#
1961 1962 1963 1964
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 \
1965
	-font font_diff \
1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978
	-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

1979
$ui_diff tag conf d_cr -elide true
1980 1981
$ui_diff tag conf d_@ -foreground blue -font font_diffbold
$ui_diff tag conf d_+ -foreground {#00a000}
1982 1983
$ui_diff tag conf d_- -foreground red

1984
$ui_diff tag conf d_++ -foreground {#00a000}
1985 1986
$ui_diff tag conf d_-- -foreground red
$ui_diff tag conf d_+s \
1987 1988
	-foreground {#00a000} \
	-background {#e2effa}
1989 1990
$ui_diff tag conf d_-s \
	-foreground red \
1991
	-background {#e2effa}
1992
$ui_diff tag conf d_s+ \
1993 1994
	-foreground {#00a000} \
	-background ivory1
1995 1996
$ui_diff tag conf d_s- \
	-foreground red \
1997
	-background ivory1
1998 1999 2000 2001 2002 2003 2004 2005 2006 2007

$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 已提交
2008

2009 2010
$ui_diff tag raise sel

2011 2012
# -- Diff Body Context Menu
#
2013 2014
set ctxm .vpane.lower.diff.body.ctxm
menu $ctxm -tearoff 0
2015 2016 2017
$ctxm add command \
	-label {Refresh} \
	-command reshow_diff
2018
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2019 2020 2021 2022 2023 2024
$ctxm add command \
	-label {Copy} \
	-command {tk_textCopy $ui_diff}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Select All} \
2025
	-command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2026 2027 2028 2029
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Copy All} \
	-command {
2030 2031 2032
		$ui_diff tag add sel 0.0 end
		tk_textCopy $ui_diff
		$ui_diff tag remove sel 0.0 end
2033 2034 2035
	}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
2036 2037 2038 2039 2040 2041
$ctxm add command \
	-label {Apply/Reverse Hunk} \
	-command {apply_hunk $cursorX $cursorY}
set ui_diff_applyhunk [$ctxm index last]
lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
$ctxm add separator
2042 2043
$ctxm add command \
	-label {Decrease Font Size} \
2044
	-command {incr_font_size font_diff -1}
2045 2046 2047
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Increase Font Size} \
2048
	-command {incr_font_size font_diff 1}
2049 2050 2051 2052 2053
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command \
	-label {Show Less Context} \
	-command {if {$repo_config(gui.diffcontext) >= 2} {
2054 2055 2056
		incr repo_config(gui.diffcontext) -1
		reshow_diff
	}}
2057 2058 2059 2060
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Show More Context} \
	-command {
2061 2062
		incr repo_config(gui.diffcontext)
		reshow_diff
2063 2064 2065 2066
	}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command -label {Options...} \
2067
	-command do_options
2068 2069 2070 2071 2072 2073 2074 2075 2076 2077
bind_button3 $ui_diff "
	set cursorX %x
	set cursorY %y
	if {\$ui_index eq \$current_diff_side} {
		$ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
	} else {
		$ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
	}
	tk_popup $ctxm %X %Y
"
2078
unset ui_diff_applyhunk
2079

S
Shawn O. Pearce 已提交
2080
# -- Status Bar
2081
#
S
Shawn O. Pearce 已提交
2082 2083 2084 2085
label .status -textvariable ui_status_value \
	-anchor w \
	-justify left \
	-borderwidth 1 \
2086
	-relief sunken
S
Shawn O. Pearce 已提交
2087 2088
pack .status -anchor w -side bottom -fill x

2089
# -- Load geometry
2090
#
2091
catch {
2092
set gm $repo_config(gui.geometry)
2093 2094 2095 2096 2097 2098 2099 2100
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
2101
}
2102

S
Shawn O. Pearce 已提交
2103
# -- Key Bindings
2104
#
2105
bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2106 2107
bind $ui_comm <$M1B-Key-i> {do_add_all;break}
bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124
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}
2125 2126 2127 2128
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}
2129 2130 2131 2132 2133 2134
bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2135
bind $ui_diff <Button-1>   {focus %W}
2136

2137
if {[is_enabled branch]} {
2138 2139 2140 2141
	bind . <$M1B-Key-n> do_create_branch
	bind . <$M1B-Key-N> do_create_branch
}

2142 2143 2144 2145 2146
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
2147 2148
bind .   <$M1B-Key-i> do_add_all
bind .   <$M1B-Key-I> do_add_all
2149
bind .   <$M1B-Key-Return> do_commit
2150
foreach i [list $ui_index $ui_workdir] {
2151 2152 2153
	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 已提交
2154
}
2155 2156 2157
unset i

set file_lists($ui_index) [list]
2158
set file_lists($ui_workdir) [list]
2159

2160
wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
S
Shawn O. Pearce 已提交
2161
focus -force $ui_comm
2162

2163 2164 2165
# -- 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.
2166
#
2167
if {[is_Cygwin]} {
2168 2169 2170 2171 2172 2173
	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
2174
by [appname]:
2175 2176 2177 2178 2179 2180 2181 2182 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

"
	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
}

2218 2219
# -- Only initialize complex UI if we are going to stay running.
#
2220
if {[is_enabled transport]} {
2221
	load_all_remotes
2222
	load_all_heads
2223

2224
	populate_branch_menu
2225 2226
	populate_fetch_menu
	populate_push_menu
2227
}
2228

2229 2230
# -- Only suggest a gc run if we are going to stay running.
#
2231
if {[is_enabled multicommit]} {
2232 2233
	set object_limit 2000
	if {[is_Windows]} {set object_limit 200}
2234
	regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2235 2236 2237 2238
	if {$objects_current >= $object_limit} {
		if {[ask_popup \
			"This repository currently has $objects_current loose objects.

2239
To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2240 2241 2242 2243 2244 2245 2246 2247

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

2248
lock_index begin-read
2249
after 1 do_rescan