git-gui.sh 56.4 KB
Newer Older
1
#!/bin/sh
S
Shawn O. Pearce 已提交
2
# Tcl ignores the next line -*- tcl -*- \
3 4 5 6 7 8 9
 if test "z$*" = zversion \
 || test "z$*" = z--version; \
 then \
	echo 'git-gui version @@GITGUI_VERSION@@'; \
	exit; \
 fi; \
 exec wish "$0" -- "$@"
S
Shawn O. Pearce 已提交
10

11
set appvers {@@GITGUI_VERSION@@}
12
set copyright {
13
Copyright  2006, 2007 Shawn Pearce, et. al.
14

15 16 17 18 19 20 21 22 23 24 25 26 27
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 已提交
28

29
######################################################################
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
##
## Tcl/Tk sanity check

if {[catch {package require Tcl 8.4} err]
 || [catch {package require Tk  8.4} err]
} {
	catch {wm withdraw .}
	tk_messageBox \
		-icon error \
		-type ok \
		-title "git-gui: fatal error" \
		-message $err
	exit 1
}

######################################################################
46 47 48 49
##
## configure our library

set oguilib {@@GITGUI_LIBDIR@@}
50 51 52 53 54
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]} {
55 56
	set oguilib [file join [file dirname [file normalize $argv0]] lib]
}
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
set idx [file join $oguilib tclIndex]
catch {
	set fd [open $idx r]
	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
			}
		}
	} else {
		set idx {}
	}
	close $fd
}
if {$idx ne {}} {
	set loaded [list]
	foreach p $idx {
		if {[lsearch -exact $loaded $p] >= 0} continue
		puts $p
		source [file join $oguilib $p]
		lappend loaded $p
	}
	unset loaded p
} else {
	set auto_path [concat [list $oguilib] $auto_path]
}
84
unset -nocomplain oguilib oguirel idx fd
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99

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

100 101 102 103 104 105
######################################################################
##
## read only globals

set _appname [lindex [file split $argv0] end]
set _gitdir {}
106
set _gitexec {}
107
set _reponame {}
108
set _iscygwin {}
109 110 111 112 113 114

proc appname {} {
	global _appname
	return $_appname
}

115
proc gitdir {args} {
116
	global _gitdir
117 118 119 120
	if {$args eq {}} {
		return $_gitdir
	}
	return [eval [concat [list file join $_gitdir] $args]]
121 122
}

123 124 125
proc gitexec {args} {
	global _gitexec
	if {$_gitexec eq {}} {
126
		if {[catch {set _gitexec [git --exec-path]} err]} {
127 128 129 130 131 132 133 134 135
			error "Git not installed?\n\n$err"
		}
	}
	if {$args eq {}} {
		return $_gitexec
	}
	return [eval [concat [list file join $_gitexec] $args]]
}

136 137 138 139
proc reponame {} {
	global _reponame
	return $_reponame
}
140

141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
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
}

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
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
}

189 190 191 192
######################################################################
##
## config

193 194 195 196 197 198 199 200 201
proc is_many_config {name} {
	switch -glob -- $name {
	remote.*.fetch -
	remote.*.push
		{return 1}
	*
		{return 0}
	}
}
202

203 204 205 206 207 208 209 210 211 212 213
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
	}
}

214
proc load_config {include_global} {
215 216 217
	global repo_config global_config default_config

	array unset global_config
218 219
	if {$include_global} {
		catch {
220
			set fd_rc [open "| git config --global --list" r]
221 222 223 224 225 226 227
			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
					}
228 229
				}
			}
230
			close $fd_rc
231 232
		}
	}
233 234

	array unset repo_config
235
	catch {
236
		set fd_rc [open "| git config --list" r]
237 238
		while {[gets $fd_rc line] >= 0} {
			if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
239 240 241 242 243
				if {[is_many_config $name]} {
					lappend repo_config($name) $value
				} else {
					set repo_config($name) $value
				}
244 245 246 247 248
			}
		}
		close $fd_rc
	}

249 250 251 252 253 254 255
	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)
		}
256 257 258
	}
}

259 260 261 262 263 264 265 266
######################################################################
##
## handy utils

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

267 268 269 270 271 272 273 274 275
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
}

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 302 303 304 305 306 307
######################################################################
##
## version check

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

308 309 310 311
######################################################################
##
## repository setup

312 313 314 315 316 317 318 319
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]} {
320 321
	catch {wm withdraw .}
	error_popup "Cannot find the git directory:\n\n$err"
322 323
	exit 1
}
324 325 326
if {![file isdirectory $_gitdir] && [is_Cygwin]} {
	catch {set _gitdir [exec cygpath --unix $_gitdir]}
}
327
if {![file isdirectory $_gitdir]} {
328
	catch {wm withdraw .}
329
	error_popup "Git directory not found:\n\n$_gitdir"
330 331
	exit 1
}
332
if {[lindex [file split $_gitdir] end] ne {.git}} {
333
	catch {wm withdraw .}
334
	error_popup "Cannot use funny .git directory:\n\n$_gitdir"
335 336
	exit 1
}
337
if {[catch {cd [file dirname $_gitdir]} err]} {
338
	catch {wm withdraw .}
339
	error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
340
	exit 1
341
}
342 343
set _reponame [lindex [file split \
	[file normalize [file dirname $_gitdir]]] \
344
	end]
345

346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363
######################################################################
##
## 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 已提交
364 365
######################################################################
##
366
## task management
S
Shawn O. Pearce 已提交
367

368
set rescan_active 0
369
set diff_active 0
370
set last_clicked {}
371

372 373 374 375 376
set disable_on_lock [list]
set index_lock_type none

proc lock_index {type} {
	global index_lock_type disable_on_lock
377

378
	if {$index_lock_type eq {none}} {
379 380 381 382 383
		set index_lock_type $type
		foreach w $disable_on_lock {
			uplevel #0 $w disabled
		}
		return 1
384
	} elseif {$index_lock_type eq "begin-$type"} {
385
		set index_lock_type $type
386 387 388 389
		return 1
	}
	return 0
}
S
Shawn O. Pearce 已提交
390

391 392 393 394 395 396 397 398 399 400 401 402 403
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

404
proc repository_state {ctvar hdvar mhvar} {
405
	global current_branch
406 407 408
	upvar $ctvar ct $hdvar hd $mhvar mh

	set mh [list]
409

410
	if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
411 412
		set current_branch {}
	} else {
413
		regsub ^refs/((heads|tags|remotes)/)? \
414 415 416 417 418
			$current_branch \
			{} \
			current_branch
	}

419
	if {[catch {set hd [git rev-parse --verify HEAD]}]} {
420
		set hd {}
421
		set ct initial
422 423 424
		return
	}

425
	set merge_head [gitdir MERGE_HEAD]
426
	if {[file exists $merge_head]} {
427
		set ct merge
428 429 430 431 432 433
		set fd_mh [open $merge_head r]
		while {[gets $fd_mh line] >= 0} {
			lappend mh $line
		}
		close $fd_mh
		return
434
	}
435 436

	set ct normal
437 438
}

439 440 441
proc PARENT {} {
	global PARENT empty_tree

442 443 444
	set p [lindex $PARENT 0]
	if {$p ne {}} {
		return $p
445 446
	}
	if {$empty_tree eq {}} {
447
		set empty_tree [git mktree << {}]
448 449 450 451
	}
	return $empty_tree
}

452
proc rescan {after {honor_trustmtime 1}} {
453
	global HEAD PARENT MERGE_HEAD commit_type
454
	global ui_index ui_workdir ui_status_value ui_comm
455
	global rescan_active file_states
456
	global repo_config
S
Shawn O. Pearce 已提交
457

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

460
	repository_state newType newHEAD newMERGE_HEAD
461
	if {[string match amend* $commit_type]
462 463
		&& $newType eq {normal}
		&& $newHEAD eq $HEAD} {
464
	} else {
465 466 467 468
		set HEAD $newHEAD
		set PARENT $newHEAD
		set MERGE_HEAD $newMERGE_HEAD
		set commit_type $newType
469 470
	}

S
Shawn O. Pearce 已提交
471 472
	array unset file_states

473
	if {![$ui_comm edit modified]
474
		|| [string trim [$ui_comm get 0.0 end]] eq {}} {
475 476
		if {[string match amend* $commit_type]} {
		} elseif {[load_message GITGUI_MSG]} {
477 478 479
		} elseif {[load_message MERGE_MSG]} {
		} elseif {[load_message SQUASH_MSG]} {
		}
480
		$ui_comm edit reset
481
		$ui_comm edit modified false
482 483
	}

484
	if {[is_enabled branch]} {
485 486 487 488
		load_all_heads
		populate_branch_menu
	}

489
	if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
490
		rescan_stage2 {} $after
491
	} else {
492
		set rescan_active 1
493
		set ui_status_value {Refreshing file status...}
494 495 496 497 498 499
		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]
500
		fconfigure $fd_rf -blocking 0 -translation binary
501
		fileevent $fd_rf readable \
502
			[list rescan_stage2 $fd_rf $after]
503
	}
504 505
}

506
proc rescan_stage2 {fd after} {
507
	global ui_status_value
508
	global rescan_active buf_rdi buf_rdf buf_rlo
509

510
	if {$fd ne {}} {
511 512 513 514
		read $fd
		if {![eof $fd]} return
		close $fd
	}
515

S
Shawn O. Pearce 已提交
516 517
	set ls_others [list | git ls-files --others -z \
		--exclude-per-directory=.gitignore]
518
	set info_exclude [gitdir info exclude]
S
Shawn O. Pearce 已提交
519 520 521 522
	if {[file readable $info_exclude]} {
		lappend ls_others "--exclude-from=$info_exclude"
	}

523 524 525 526
	set buf_rdi {}
	set buf_rdf {}
	set buf_rlo {}

527
	set rescan_active 3
528
	set ui_status_value {Scanning for modified files ...}
529
	set fd_di [open "| git diff-index --cached -z [PARENT]" r]
S
Shawn O. Pearce 已提交
530 531 532
	set fd_df [open "| git diff-files -z" r]
	set fd_lo [open $ls_others r]

533 534 535
	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
536 537 538
	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 已提交
539 540
}

541
proc load_message {file} {
542
	global ui_comm
543

544
	set f [gitdir $file]
545
	if {[file isfile $f]} {
546 547 548
		if {[catch {set fd [open $f r]}]} {
			return 0
		}
549
		set content [string trim [read $fd]]
550
		close $fd
551
		regsub -all -line {[ \r\t]+$} $content {} content
552 553 554 555 556 557 558
		$ui_comm delete 0.0 end
		$ui_comm insert end $content
		return 1
	}
	return 0
}

559
proc read_diff_index {fd after} {
S
Shawn O. Pearce 已提交
560 561 562
	global buf_rdi

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

589
	rescan_done $fd buf_rdi $after
S
Shawn O. Pearce 已提交
590 591
}

592
proc read_diff_files {fd after} {
S
Shawn O. Pearce 已提交
593 594 595
	global buf_rdf

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

622
	rescan_done $fd buf_rdf $after
S
Shawn O. Pearce 已提交
623 624
}

625
proc read_ls_others {fd after} {
S
Shawn O. Pearce 已提交
626 627 628 629 630 631
	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] {
632
		merge_state [encoding convertfrom $p] ?O
S
Shawn O. Pearce 已提交
633
	}
634
	rescan_done $fd buf_rlo $after
S
Shawn O. Pearce 已提交
635 636
}

637
proc rescan_done {fd buf after} {
638
	global rescan_active current_diff_path
639
	global file_states repo_config
640
	upvar $buf to_clear
S
Shawn O. Pearce 已提交
641

642 643 644
	if {![eof $fd]} return
	set to_clear {}
	close $fd
645
	if {[incr rescan_active -1] > 0} return
646

647
	prune_selection
648 649
	unlock_index
	display_all_files
650
	if {$current_diff_path ne {}} reshow_diff
651
	uplevel #0 $after
S
Shawn O. Pearce 已提交
652 653
}

654 655 656 657 658 659 660 661 662 663
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 已提交
664 665
######################################################################
##
666
## ui helpers
S
Shawn O. Pearce 已提交
667

668 669 670 671 672 673 674 675 676
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 已提交
677

678 679
proc mapdesc {state path} {
	global all_descs
680

681 682 683 684 685 686
	if {[catch {set r $all_descs($state)}]} {
		puts "error: no desc for state={$state} $path"
		return $state
	}
	return $r
}
687

688 689 690 691
proc escape_path {path} {
	regsub -all {\\} $path "\\\\" path
	regsub -all "\n" $path "\\n" path
	return $path
S
Shawn O. Pearce 已提交
692 693
}

694 695
proc short_path {path} {
	return [escape_path [lindex [file split $path] end]]
696 697
}

698 699
set next_icon_id 0
set null_sha1 [string repeat 0 40]
700

701 702
proc merge_state {path new_state {head_info {}} {index_info {}}} {
	global file_states next_icon_id null_sha1
703

704 705
	set s0 [string index $new_state 0]
	set s1 [string index $new_state 1]
706

707 708 709 710 711 712 713 714 715
	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]}
	}
716

717 718
	if     {$s0 eq {?}} {set s0 [string index $state 0]} \
	elseif {$s0 eq {_}} {set s0 _}
719

720 721
	if     {$s1 eq {?}} {set s1 [string index $state 1]} \
	elseif {$s1 eq {_}} {set s1 _}
722

723 724 725 726 727 728
	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
	}
729

730 731 732 733 734
	set file_states($path) [list $s0$s1 $icon \
		$head_info $index_info \
		]
	return $state
}
S
Shawn O. Pearce 已提交
735

736 737
proc display_file_helper {w path icon_name old_m new_m} {
	global file_lists
S
Shawn O. Pearce 已提交
738

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

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

771
	set old_m [merge_state $path $state]
S
Shawn O. Pearce 已提交
772
	set s $file_states($path)
773 774
	set new_m [lindex $s 0]
	set icon_name [lindex $s 1]
775

776 777 778 779 780 781 782
	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 已提交
783
	}
784
	display_file_helper	$ui_index $path $icon_name $o $n
S
Shawn O. Pearce 已提交
785

786 787 788 789
	if {[string index $old_m 0] eq {U}} {
		set o U
	} else {
		set o [string index $old_m 1]
790
	}
791 792 793 794
	if {[string index $new_m 0] eq {U}} {
		set n U
	} else {
		set n [string index $new_m 1]
795
	}
796 797 798 799 800
	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 已提交
801
	}
802
}
S
Shawn O. Pearce 已提交
803

804 805 806 807 808 809 810 811 812 813
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 已提交
814 815
}

816 817 818 819
proc display_all_files {} {
	global ui_index ui_workdir
	global file_states file_lists
	global last_clicked
S
Shawn O. Pearce 已提交
820

821 822
	$ui_index conf -state normal
	$ui_workdir conf -state normal
S
Shawn O. Pearce 已提交
823

824 825 826
	$ui_index delete 0.0 end
	$ui_workdir delete 0.0 end
	set last_clicked {}
S
Shawn O. Pearce 已提交
827

828 829
	set file_lists($ui_index) [list]
	set file_lists($ui_workdir) [list]
830

831 832 833 834 835 836 837 838 839
	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
840
		}
S
Shawn O. Pearce 已提交
841

842 843 844 845
		if {[string index $m 0] eq {U}} {
			set s U
		} else {
			set s [string index $m 1]
846
		}
847 848 849
		if {$s ne {_}} {
			display_all_files_helper $ui_workdir $path \
				$icon_name $s
850 851 852
		}
	}

853 854
	$ui_index conf -state disabled
	$ui_workdir conf -state disabled
855 856
}

857 858
######################################################################
##
859
## icons
860

861 862 863 864 865 866 867 868
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 已提交
869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887

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

888 889 890 891
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 已提交
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 926 927 928 929 930 931 932
   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

933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957
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
958

959
set ui_index .vpane.files.index.list
960
set ui_workdir .vpane.files.workdir.list
961 962 963 964 965 966 967 968 969 970

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
971
set all_icons(U$ui_workdir) file_merge
972 973
set all_icons(O$ui_workdir) file_plain

974
set max_status_desc 0
S
Shawn O. Pearce 已提交
975
foreach i {
976 977
		{__ "Unmodified"}

978 979 980 981 982 983 984 985 986
		{_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"}
987 988

		{_D "Missing"}
989 990
		{D_ "Staged for removal"}
		{DO "Staged for removal, still present"}
991

992
		{U_ "Requires merge resolution"}
993
		{UU "Requires merge resolution"}
994 995
		{UM "Requires merge resolution"}
		{UD "Requires merge resolution"}
S
Shawn O. Pearce 已提交
996
	} {
997 998
	if {$max_status_desc < [string length [lindex $i 1]]} {
		set max_status_desc [string length [lindex $i 1]]
999
	}
1000
	set all_descs([lindex $i 0]) [lindex $i 1]
S
Shawn O. Pearce 已提交
1001
}
1002
unset i
S
Shawn O. Pearce 已提交
1003 1004 1005 1006 1007

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

1008 1009 1010 1011 1012 1013 1014
proc bind_button3 {w cmd} {
	bind $w <Any-Button-3> $cmd
	if {[is_MacOSX]} {
		bind $w <Control-Button-1> $cmd
	}
}

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

1024 1025 1026 1027 1028
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
1029
	font configure ${font}italic -size $sz
1030 1031
}

S
Shawn O. Pearce 已提交
1032 1033 1034 1035
######################################################################
##
## ui commands

1036
set starting_gitk_msg {Starting gitk... please wait...}
1037

1038
proc do_gitk {revs} {
1039 1040 1041 1042 1043
	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.
	#
1044
	set cmd [list [info nameofexecutable]]
1045
	lappend cmd [gitexec gitk]
1046 1047 1048
	if {$revs ne {}} {
		append cmd { }
		append cmd $revs
1049
	}
1050

1051
	if {[catch {eval exec $cmd &} err]} {
1052
		error_popup "Failed to start gitk:\n\n$err"
S
Shawn O. Pearce 已提交
1053
	} else {
1054 1055 1056 1057 1058 1059
		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 已提交
1060 1061 1062
	}
}

1063
set is_quitting 0
1064

S
Shawn O. Pearce 已提交
1065
proc do_quit {} {
1066
	global ui_comm is_quitting repo_config commit_type
1067

1068 1069
	if {$is_quitting} return
	set is_quitting 1
1070

1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086
	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}
1087 1088
		}

1089 1090 1091 1092 1093 1094 1095 1096 1097 1098
		# -- 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} {
1099
			catch {git config gui.geometry $cfg_geometry}
1100
		}
1101 1102
	}

S
Shawn O. Pearce 已提交
1103 1104 1105 1106
	destroy .
}

proc do_rescan {} {
1107
	rescan {set ui_status_value {Ready.}}
S
Shawn O. Pearce 已提交
1108 1109
}

1110
proc do_commit {} {
1111
	commit_tree
1112 1113
}

1114
proc toggle_or_diff {w x y} {
1115
	global file_states file_lists current_diff_path ui_index ui_workdir
1116
	global last_clicked selected_paths
1117

S
Shawn O. Pearce 已提交
1118 1119 1120
	set pos [split [$w index @$x,$y] .]
	set lno [lindex $pos 0]
	set col [lindex $pos 1]
1121 1122 1123 1124 1125 1126 1127 1128 1129
	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
1130
	$ui_workdir tag remove in_sel 0.0 end
S
Shawn O. Pearce 已提交
1131

1132
	if {$col == 0} {
1133
		if {$current_diff_path eq $path} {
1134 1135 1136 1137
			set after {reshow_diff;}
		} else {
			set after {}
		}
1138
		if {$w eq $ui_index} {
1139
			update_indexinfo \
1140
				"Unstaging [short_path $path] from commit" \
1141 1142
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
1143
		} elseif {$w eq $ui_workdir} {
1144
			update_index \
1145
				"Adding [short_path $path]" \
1146 1147 1148
				[list $path] \
				[concat $after {set ui_status_value {Ready.}}]
		}
1149
	} else {
1150
		show_diff $path $w $lno
S
Shawn O. Pearce 已提交
1151 1152 1153
	}
}

1154
proc add_one_to_selection {w x y} {
1155
	global file_lists last_clicked selected_paths
1156

1157
	set lno [lindex [split [$w index @$x,$y] .] 0]
1158 1159 1160 1161 1162
	set path [lindex $file_lists($w) [expr {$lno - 1}]]
	if {$path eq {}} {
		set last_clicked {}
		return
	}
S
Shawn O. Pearce 已提交
1163

1164 1165 1166 1167 1168 1169
	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
	}

1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183
	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} {
1184
	global file_lists last_clicked selected_paths
1185 1186 1187 1188

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

1191
	set lno [lindex [split [$w index @$x,$y] .] 0]
1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206
	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 已提交
1207 1208 1209 1210
}

######################################################################
##
1211
## config defaults
S
Shawn O. Pearce 已提交
1212

1213
set cursor_ptr arrow
1214 1215 1216 1217 1218 1219 1220 1221
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
}

1222
font create font_uiitalic
1223 1224
font create font_uibold
font create font_diffbold
1225
font create font_diffitalic
S
Shawn O. Pearce 已提交
1226

1227 1228
foreach class {Button Checkbutton Entry Label
		Labelframe Listbox Menu Message
1229
		Radiobutton Spinbox Text} {
1230 1231 1232 1233
	option add *$class.font font_ui
}
unset class

1234
if {[is_MacOSX]} {
1235 1236
	set M1B M1
	set M1T Cmd
1237
} else {
1238 1239
	set M1B Control
	set M1T Ctrl
1240 1241
}

1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256
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
1257
			font configure ${font}italic $cn $cv
1258 1259
		}
		font configure ${font}bold -weight bold
1260
		font configure ${font}italic -slant italic
1261 1262 1263
	}
}

1264
set default_config(merge.summary) false
1265
set default_config(merge.verbosity) 2
1266 1267 1268
set default_config(user.name) {}
set default_config(user.email) {}

1269
set default_config(gui.trustmtime) false
1270
set default_config(gui.diffcontext) 5
1271
set default_config(gui.newbranchtemplate) {}
1272 1273 1274 1275 1276 1277
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}}
}
1278
load_config 0
1279 1280
apply_config

1281 1282 1283 1284
######################################################################
##
## feature option selection

1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297
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]
}

1298 1299 1300 1301
enable_option multicommit
enable_option branch
enable_option transport

1302
switch -- $subcommand {
1303
browser -
1304
blame {
1305 1306 1307 1308
	disable_option multicommit
	disable_option branch
	disable_option transport
}
1309 1310
citool {
	enable_option singlecommit
1311 1312 1313 1314 1315 1316 1317

	disable_option multicommit
	disable_option branch
	disable_option transport
}
}

1318 1319 1320 1321
######################################################################
##
## ui construction

1322 1323
set ui_comm {}

S
Shawn O. Pearce 已提交
1324
# -- Menu Bar
1325
#
1326
menu .mbar -tearoff 0
1327 1328
.mbar add cascade -label Repository -menu .mbar.repository
.mbar add cascade -label Edit -menu .mbar.edit
1329
if {[is_enabled branch]} {
1330
	.mbar add cascade -label Branch -menu .mbar.branch
S
Shawn O. Pearce 已提交
1331
}
1332
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1333
	.mbar add cascade -label Commit -menu .mbar.commit
1334
}
1335
if {[is_enabled transport]} {
1336 1337 1338
	.mbar add cascade -label Merge -menu .mbar.merge
	.mbar add cascade -label Fetch -menu .mbar.fetch
	.mbar add cascade -label Push -menu .mbar.push
1339
}
S
Shawn O. Pearce 已提交
1340 1341
. configure -menu .mbar

1342
# -- Repository Menu
1343
#
1344
menu .mbar.repository
1345 1346 1347

.mbar.repository add command \
	-label {Browse Current Branch} \
1348
	-command {browser::new $current_branch}
1349
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1350 1351
.mbar.repository add separator

1352 1353
.mbar.repository add command \
	-label {Visualize Current Branch} \
1354
	-command {do_gitk $current_branch}
1355
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1356 1357
.mbar.repository add command \
	-label {Visualize All Branches} \
1358
	-command {do_gitk --all}
1359
.mbar.repository add separator
1360

1361
if {[is_enabled multicommit]} {
1362
	.mbar.repository add command -label {Database Statistics} \
1363
		-command do_stats
1364

1365
	.mbar.repository add command -label {Compress Database} \
1366
		-command do_gc
1367

1368
	.mbar.repository add command -label {Verify Database} \
1369
		-command do_fsck_objects
1370

1371
	.mbar.repository add separator
1372

1373 1374 1375
	if {[is_Cygwin]} {
		.mbar.repository add command \
			-label {Create Desktop Icon} \
1376
			-command do_cygwin_shortcut
1377
	} elseif {[is_Windows]} {
1378
		.mbar.repository add command \
1379
			-label {Create Desktop Icon} \
1380
			-command do_windows_shortcut
1381
	} elseif {[is_MacOSX]} {
1382
		.mbar.repository add command \
1383
			-label {Create Desktop Icon} \
1384
			-command do_macosx_app
1385
	}
1386
}
1387

1388
.mbar.repository add command -label Quit \
S
Shawn O. Pearce 已提交
1389
	-command do_quit \
1390
	-accelerator $M1T-Q
S
Shawn O. Pearce 已提交
1391

1392 1393 1394 1395 1396
# -- Edit Menu
#
menu .mbar.edit
.mbar.edit add command -label Undo \
	-command {catch {[focus] edit undo}} \
1397
	-accelerator $M1T-Z
1398 1399
.mbar.edit add command -label Redo \
	-command {catch {[focus] edit redo}} \
1400
	-accelerator $M1T-Y
1401 1402 1403
.mbar.edit add separator
.mbar.edit add command -label Cut \
	-command {catch {tk_textCut [focus]}} \
1404
	-accelerator $M1T-X
1405 1406
.mbar.edit add command -label Copy \
	-command {catch {tk_textCopy [focus]}} \
1407
	-accelerator $M1T-C
1408 1409
.mbar.edit add command -label Paste \
	-command {catch {tk_textPaste [focus]; [focus] see insert}} \
1410
	-accelerator $M1T-V
1411 1412
.mbar.edit add command -label Delete \
	-command {catch {[focus] delete sel.first sel.last}} \
1413
	-accelerator Del
1414 1415 1416
.mbar.edit add separator
.mbar.edit add command -label {Select All} \
	-command {catch {[focus] tag add sel 0.0 end}} \
1417
	-accelerator $M1T-A
1418

1419 1420
# -- Branch Menu
#
1421
if {[is_enabled branch]} {
S
Shawn O. Pearce 已提交
1422 1423 1424 1425
	menu .mbar.branch

	.mbar.branch add command -label {Create...} \
		-command do_create_branch \
1426
		-accelerator $M1T-N
S
Shawn O. Pearce 已提交
1427 1428 1429 1430
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]

	.mbar.branch add command -label {Delete...} \
1431
		-command do_delete_branch
S
Shawn O. Pearce 已提交
1432 1433
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]
1434 1435

	.mbar.branch add command -label {Reset...} \
1436
		-command merge::reset_hard
1437 1438
	lappend disable_on_lock [list .mbar.branch entryconf \
		[.mbar.branch index last] -state]
S
Shawn O. Pearce 已提交
1439 1440
}

S
Shawn O. Pearce 已提交
1441
# -- Commit Menu
1442
#
1443 1444 1445 1446 1447 1448 1449
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 \
1450
		-value new
1451 1452
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1453

1454 1455 1456 1457
	.mbar.commit add radiobutton \
		-label {Amend Last Commit} \
		-command do_select_commit_type \
		-variable selected_commit_type \
1458
		-value amend
1459 1460
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1461

1462
	.mbar.commit add separator
1463

1464 1465
	.mbar.commit add command -label Rescan \
		-command do_rescan \
1466
		-accelerator F5
1467 1468
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1469

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

1475
	.mbar.commit add command -label {Add Existing To Commit} \
1476
		-command do_add_all \
1477
		-accelerator $M1T-I
1478 1479
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1480

1481
	.mbar.commit add command -label {Unstage From Commit} \
1482
		-command do_unstage_selection
1483 1484
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1485

1486
	.mbar.commit add command -label {Revert Changes} \
1487
		-command do_revert_selection
1488 1489
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
1490

1491
	.mbar.commit add separator
1492

1493 1494
	.mbar.commit add command -label {Sign Off} \
		-command do_signoff \
1495
		-accelerator $M1T-S
1496

1497 1498
	.mbar.commit add command -label Commit \
		-command do_commit \
1499
		-accelerator $M1T-Return
1500 1501 1502
	lappend disable_on_lock \
		[list .mbar.commit entryconf [.mbar.commit index last] -state]
}
S
Shawn O. Pearce 已提交
1503

1504 1505 1506 1507 1508
# -- Merge Menu
#
if {[is_enabled branch]} {
	menu .mbar.merge
	.mbar.merge add command -label {Local Merge...} \
1509
		-command merge::dialog
1510 1511 1512
	lappend disable_on_lock \
		[list .mbar.merge entryconf [.mbar.merge index last] -state]
	.mbar.merge add command -label {Abort Merge...} \
1513
		-command merge::reset_hard
1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525
	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...} \
1526
		-command do_push_anywhere
1527 1528
}

S
Shawn O. Pearce 已提交
1529 1530 1531 1532 1533 1534
if {[is_MacOSX]} {
	# -- Apple Menu (Mac OS X only)
	#
	.mbar add cascade -label Apple -menu .mbar.apple
	menu .mbar.apple

1535
	.mbar.apple add command -label "About [appname]" \
1536
		-command do_about
1537
	.mbar.apple add command -label "Options..." \
1538
		-command do_options
S
Shawn O. Pearce 已提交
1539 1540 1541 1542 1543
} else {
	# -- Edit Menu
	#
	.mbar.edit add separator
	.mbar.edit add command -label {Options...} \
1544
		-command do_options
S
Shawn O. Pearce 已提交
1545

1546 1547
	# -- Tools Menu
	#
1548 1549
	if {[file exists /usr/local/miga/lib/gui-miga]
		&& [file exists .pvcsrc]} {
1550
	proc do_miga {} {
1551
		global ui_status_value
1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569
		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" \
1570
		-command do_miga
1571 1572 1573
	lappend disable_on_lock \
		[list .mbar.tools entryconf [.mbar.tools index last] -state]
	}
1574
}
1575

1576 1577
# -- Help Menu
#
1578
.mbar add cascade -label Help -menu .mbar.help
1579
menu .mbar.help
S
Shawn O. Pearce 已提交
1580

1581
if {![is_MacOSX]} {
1582
	.mbar.help add command -label "About [appname]" \
1583
		-command do_about
S
Shawn O. Pearce 已提交
1584
}
S
Shawn O. Pearce 已提交
1585

1586 1587
set browser {}
catch {set browser $repo_config(instaweb.browser)}
1588
set doc_path [file dirname [gitexec]]
1589 1590
set doc_path [file join $doc_path Documentation index.html]

1591
if {[is_Cygwin]} {
1592
	set doc_path [exec cygpath --mixed $doc_path]
1593 1594 1595 1596 1597
}

if {$browser eq {}} {
	if {[is_MacOSX]} {
		set browser open
1598
	} elseif {[is_Cygwin]} {
1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619
		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} \
1620
		-command [list exec $browser $doc_url &]
1621 1622
}
unset browser doc_path doc_url
S
Shawn O. Pearce 已提交
1623

1624 1625
# -- Standard bindings
#
1626
wm protocol . WM_DELETE_WINDOW do_quit
1627 1628 1629 1630 1631
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]}

1632 1633 1634 1635 1636 1637
set subcommand_args {}
proc usage {} {
	puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
	exit 1
}

1638 1639
# -- Not a normal commit type invocation?  Do that instead!
#
1640
switch -- $subcommand {
1641
browser {
1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652
	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
1653
	}
1654
	browser::new $current_branch
1655 1656
	return
}
1657
blame {
1658
	set subcommand_args {rev? path?}
1659
	set head {}
1660 1661 1662 1663 1664
	set path {}
	set is_path 0
	foreach a $argv {
		if {$is_path || [file exists $_prefix$a]} {
			if {$path ne {}} usage
1665
			set path $_prefix$a
1666 1667 1668
			break
		} elseif {$a eq {--}} {
			if {$path ne {}} {
1669 1670
				if {$head ne {}} usage
				set head $path
1671 1672 1673
				set path {}
			}
			set is_path 1
1674 1675 1676
		} elseif {$head eq {}} {
			if {$head ne {}} usage
			set head $a
1677 1678 1679 1680 1681 1682
		} else {
			usage
		}
	}
	unset is_path

1683
	if {$head eq {}} {
1684 1685 1686
		set current_branch [git symbolic-ref HEAD]
		regsub ^refs/((heads|tags|remotes)/)? \
			$current_branch {} current_branch
1687 1688
	} else {
		set current_branch $head
1689
	}
1690 1691 1692

	if {$path eq {}} usage
	blame::new $head $path
1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705
	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
1706 1707
}
default {
1708
	puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
1709 1710 1711 1712
	exit 1
}
}

1713 1714 1715 1716 1717 1718 1719 1720
# -- Branch Control
#
frame .branch \
	-borderwidth 1 \
	-relief sunken
label .branch.l1 \
	-text {Current Branch:} \
	-anchor w \
1721
	-justify left
1722 1723 1724
label .branch.cb \
	-textvariable current_branch \
	-anchor w \
1725
	-justify left
1726 1727 1728 1729
pack .branch.l1 -side left
pack .branch.cb -side left -fill x
pack .branch -side top -fill x

S
Shawn O. Pearce 已提交
1730
# -- Main Window Layout
1731
#
S
Shawn O. Pearce 已提交
1732 1733
panedwindow .vpane -orient vertical
panedwindow .vpane.files -orient horizontal
1734
.vpane add .vpane.files -sticky nsew -height 100 -width 200
S
Shawn O. Pearce 已提交
1735 1736 1737
pack .vpane -anchor n -side top -fill both -expand 1

# -- Index File List
1738
#
1739
frame .vpane.files.index -height 100 -width 200
1740
label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
1741
	-background lightgreen
S
Shawn O. Pearce 已提交
1742
text $ui_index -background white -borderwidth 0 \
1743
	-width 20 -height 10 \
1744
	-wrap none \
1745
	-cursor $cursor_ptr \
1746 1747
	-xscrollcommand {.vpane.files.index.sx set} \
	-yscrollcommand {.vpane.files.index.sy set} \
S
Shawn O. Pearce 已提交
1748
	-state disabled
1749 1750
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 已提交
1751
pack .vpane.files.index.title -side top -fill x
1752 1753
pack .vpane.files.index.sx -side bottom -fill x
pack .vpane.files.index.sy -side right -fill y
S
Shawn O. Pearce 已提交
1754 1755 1756
pack $ui_index -side left -fill both -expand 1
.vpane.files add .vpane.files.index -sticky nsew

1757
# -- Working Directory File List
1758
#
1759
frame .vpane.files.workdir -height 100 -width 200
1760
label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
1761
	-background lightsalmon
1762
text $ui_workdir -background white -borderwidth 0 \
1763
	-width 20 -height 10 \
1764
	-wrap none \
1765
	-cursor $cursor_ptr \
1766 1767
	-xscrollcommand {.vpane.files.workdir.sx set} \
	-yscrollcommand {.vpane.files.workdir.sy set} \
S
Shawn O. Pearce 已提交
1768
	-state disabled
1769 1770
scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
1771
pack .vpane.files.workdir.title -side top -fill x
1772 1773
pack .vpane.files.workdir.sx -side bottom -fill x
pack .vpane.files.workdir.sy -side right -fill y
1774 1775
pack $ui_workdir -side left -fill both -expand 1
.vpane.files add .vpane.files.workdir -sticky nsew
S
Shawn O. Pearce 已提交
1776

1777
foreach i [list $ui_index $ui_workdir] {
1778 1779
	$i tag conf in_diff -background lightgray
	$i tag conf in_sel  -background lightgray
1780 1781
}
unset i
1782

1783
# -- Diff and Commit Area
1784
#
1785
frame .vpane.lower -height 300 -width 400
1786 1787 1788 1789
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
1790
.vpane add .vpane.lower -sticky nsew
S
Shawn O. Pearce 已提交
1791 1792

# -- Commit Area Buttons
1793
#
1794 1795
frame .vpane.lower.commarea.buttons
label .vpane.lower.commarea.buttons.l -text {} \
S
Shawn O. Pearce 已提交
1796
	-anchor w \
1797
	-justify left
1798 1799
pack .vpane.lower.commarea.buttons.l -side top -fill x
pack .vpane.lower.commarea.buttons -side left -fill y
1800

1801
button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1802
	-command do_rescan
1803
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1804 1805
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.rescan conf -state}
1806

1807
button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
1808
	-command do_add_all
1809
pack .vpane.lower.commarea.buttons.incall -side top -fill x
1810 1811
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.incall conf -state}
1812

1813
button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1814
	-command do_signoff
1815
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1816

1817
button .vpane.lower.commarea.buttons.commit -text {Commit} \
1818
	-command do_commit
1819
pack .vpane.lower.commarea.buttons.commit -side top -fill x
1820 1821
lappend disable_on_lock \
	{.vpane.lower.commarea.buttons.commit conf -state}
S
Shawn O. Pearce 已提交
1822 1823

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

1878 1879
# -- Commit Message Buffer Context Menu
#
1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896
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} \
1897
	-command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
1898 1899 1900
$ctxm add command \
	-label {Copy All} \
	-command {
1901 1902 1903
		$ui_comm tag add sel 0.0 end
		tk_textCopy $ui_comm
		$ui_comm tag remove sel 0.0 end
1904 1905 1906 1907
	}
$ctxm add separator
$ctxm add command \
	-label {Sign Off} \
1908
	-command do_signoff
1909
bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
1910

1911
# -- Diff Header
1912
#
1913 1914 1915
proc trace_current_diff_path {varname args} {
	global current_diff_path diff_actions file_states
	if {$current_diff_path eq {}} {
1916 1917 1918 1919 1920
		set s {}
		set f {}
		set p {}
		set o disabled
	} else {
1921
		set p $current_diff_path
1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934
		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
	}
}
1935
trace add variable current_diff_path write trace_current_diff_path
1936

1937
frame .vpane.lower.diff.header -background gold
1938
label .vpane.lower.diff.header.status \
1939
	-background gold \
1940 1941
	-width $max_status_desc \
	-anchor w \
1942
	-justify left
1943
label .vpane.lower.diff.header.file \
1944
	-background gold \
1945
	-anchor w \
1946
	-justify left
1947
label .vpane.lower.diff.header.path \
1948
	-background gold \
1949
	-anchor w \
1950
	-justify left
1951 1952 1953 1954 1955 1956 1957
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} \
1958 1959 1960 1961 1962
	-command {
		clipboard clear
		clipboard append \
			-format STRING \
			-type STRING \
1963
			-- $current_diff_path
1964
	}
1965 1966
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
1967 1968

# -- Diff Body
1969
#
1970 1971 1972 1973
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 \
1974
	-font font_diff \
1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987
	-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

1988
$ui_diff tag conf d_cr -elide true
1989 1990
$ui_diff tag conf d_@ -foreground blue -font font_diffbold
$ui_diff tag conf d_+ -foreground {#00a000}
1991 1992
$ui_diff tag conf d_- -foreground red

1993
$ui_diff tag conf d_++ -foreground {#00a000}
1994 1995
$ui_diff tag conf d_-- -foreground red
$ui_diff tag conf d_+s \
1996 1997
	-foreground {#00a000} \
	-background {#e2effa}
1998 1999
$ui_diff tag conf d_-s \
	-foreground red \
2000
	-background {#e2effa}
2001
$ui_diff tag conf d_s+ \
2002 2003
	-foreground {#00a000} \
	-background ivory1
2004 2005
$ui_diff tag conf d_s- \
	-foreground red \
2006
	-background ivory1
2007 2008 2009 2010 2011 2012 2013 2014 2015 2016

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

2018 2019
$ui_diff tag raise sel

2020 2021
# -- Diff Body Context Menu
#
2022 2023
set ctxm .vpane.lower.diff.body.ctxm
menu $ctxm -tearoff 0
2024 2025 2026
$ctxm add command \
	-label {Refresh} \
	-command reshow_diff
2027
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2028 2029 2030 2031 2032 2033
$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} \
2034
	-command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2035 2036 2037 2038
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Copy All} \
	-command {
2039 2040 2041
		$ui_diff tag add sel 0.0 end
		tk_textCopy $ui_diff
		$ui_diff tag remove sel 0.0 end
2042 2043 2044
	}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
2045 2046 2047 2048 2049 2050
$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
2051 2052
$ctxm add command \
	-label {Decrease Font Size} \
2053
	-command {incr_font_size font_diff -1}
2054 2055 2056
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Increase Font Size} \
2057
	-command {incr_font_size font_diff 1}
2058 2059 2060 2061
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command \
	-label {Show Less Context} \
2062
	-command {if {$repo_config(gui.diffcontext) >= 1} {
2063 2064 2065
		incr repo_config(gui.diffcontext) -1
		reshow_diff
	}}
2066 2067 2068
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
	-label {Show More Context} \
2069
	-command {if {$repo_config(gui.diffcontext) < 99} {
2070 2071
		incr repo_config(gui.diffcontext)
		reshow_diff
2072
	}}
2073 2074 2075
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command -label {Options...} \
2076
	-command do_options
2077 2078 2079 2080 2081 2082 2083 2084 2085 2086
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
"
2087
unset ui_diff_applyhunk
2088

S
Shawn O. Pearce 已提交
2089
# -- Status Bar
2090
#
S
Shawn O. Pearce 已提交
2091 2092 2093 2094
label .status -textvariable ui_status_value \
	-anchor w \
	-justify left \
	-borderwidth 1 \
2095
	-relief sunken
S
Shawn O. Pearce 已提交
2096 2097
pack .status -anchor w -side bottom -fill x

2098
# -- Load geometry
2099
#
2100
catch {
2101
set gm $repo_config(gui.geometry)
2102 2103 2104 2105 2106 2107 2108 2109
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
2110
}
2111

S
Shawn O. Pearce 已提交
2112
# -- Key Bindings
2113
#
2114
bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2115 2116
bind $ui_comm <$M1B-Key-i> {do_add_all;break}
bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133
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}
2134 2135 2136 2137
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}
2138 2139 2140 2141 2142 2143
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}
2144
bind $ui_diff <Button-1>   {focus %W}
2145

2146
if {[is_enabled branch]} {
2147 2148 2149 2150
	bind . <$M1B-Key-n> do_create_branch
	bind . <$M1B-Key-N> do_create_branch
}

2151 2152 2153 2154 2155
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
2156 2157
bind .   <$M1B-Key-i> do_add_all
bind .   <$M1B-Key-I> do_add_all
2158
bind .   <$M1B-Key-Return> do_commit
2159
foreach i [list $ui_index $ui_workdir] {
2160 2161 2162
	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 已提交
2163
}
2164 2165 2166
unset i

set file_lists($ui_index) [list]
2167
set file_lists($ui_workdir) [list]
2168

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

2172 2173 2174
# -- 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.
2175
#
2176
if {[is_Cygwin]} {
2177 2178 2179 2180 2181 2182
	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
2183
by [appname]:
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

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

2227 2228
# -- Only initialize complex UI if we are going to stay running.
#
2229
if {[is_enabled transport]} {
2230
	load_all_remotes
2231
	load_all_heads
2232

2233
	populate_branch_menu
2234 2235
	populate_fetch_menu
	populate_push_menu
2236
}
2237

2238 2239
# -- Only suggest a gc run if we are going to stay running.
#
2240
if {[is_enabled multicommit]} {
2241 2242
	set object_limit 2000
	if {[is_Windows]} {set object_limit 200}
2243
	regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2244 2245 2246 2247
	if {$objects_current >= $object_limit} {
		if {[ask_popup \
			"This repository currently has $objects_current loose objects.

2248
To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2249 2250 2251 2252 2253 2254 2255 2256

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

2257
lock_index begin-read
2258
after 1 do_rescan