git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 set appvers {@@GIT_VERSION@@}
   6 set copyright {
   7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23 ######################################################################
  24 ##
  25 ## read only globals
  26
  27 set _appname [lindex [file split $argv0] end]
  28 set _gitdir {}
  29 set _gitexec {}
  30 set _reponame {}
  31 set _iscygwin {}
  32
  33 proc appname {} {
  34         global _appname
  35         return $_appname
  36 }
  37
  38 proc gitdir {args} {
  39         global _gitdir
  40         if {$args eq {}} {
  41                 return $_gitdir
  42         }
  43         return [eval [concat [list file join $_gitdir] $args]]
  44 }
  45
  46 proc gitexec {args} {
  47         global _gitexec
  48         if {$_gitexec eq {}} {
  49                 if {[catch {set _gitexec [exec git --exec-path]} err]} {
  50                         error "Git not installed?\n\n$err"
  51                 }
  52         }
  53         if {$args eq {}} {
  54                 return $_gitexec
  55         }
  56         return [eval [concat [list file join $_gitexec] $args]]
  57 }
  58
  59 proc reponame {} {
  60         global _reponame
  61         return $_reponame
  62 }
  63
  64 proc is_MacOSX {} {
  65         global tcl_platform tk_library
  66         if {[tk windowingsystem] eq {aqua}} {
  67                 return 1
  68         }
  69         return 0
  70 }
  71
  72 proc is_Windows {} {
  73         global tcl_platform
  74         if {$tcl_platform(platform) eq {windows}} {
  75                 return 1
  76         }
  77         return 0
  78 }
  79
  80 proc is_Cygwin {} {
  81         global tcl_platform _iscygwin
  82         if {$_iscygwin eq {}} {
  83                 if {$tcl_platform(platform) eq {windows}} {
  84                         if {[catch {set p [exec cygpath --windir]} err]} {
  85                                 set _iscygwin 0
  86                         } else {
  87                                 set _iscygwin 1
  88                         }
  89                 } else {
  90                         set _iscygwin 0
  91                 }
  92         }
  93         return $_iscygwin
  94 }
  95
  96 ######################################################################
  97 ##
  98 ## config
  99
 100 proc is_many_config {name} {
 101         switch -glob -- $name {
 102         remote.*.fetch -
 103         remote.*.push
 104                 {return 1}
 105         *
 106                 {return 0}
 107         }
 108 }
 109
 110 proc is_config_true {name} {
 111         global repo_config
 112         if {[catch {set v $repo_config($name)}]} {
 113                 return 0
 114         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 115                 return 1
 116         } else {
 117                 return 0
 118         }
 119 }
 120
 121 proc load_config {include_global} {
 122         global repo_config global_config default_config
 123
 124         array unset global_config
 125         if {$include_global} {
 126                 catch {
 127                         set fd_rc [open "| git repo-config --global --list" r]
 128                         while {[gets $fd_rc line] >= 0} {
 129                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 130                                         if {[is_many_config $name]} {
 131                                                 lappend global_config($name) $value
 132                                         } else {
 133                                                 set global_config($name) $value
 134                                         }
 135                                 }
 136                         }
 137                         close $fd_rc
 138                 }
 139         }
 140
 141         array unset repo_config
 142         catch {
 143                 set fd_rc [open "| git repo-config --list" r]
 144                 while {[gets $fd_rc line] >= 0} {
 145                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 146                                 if {[is_many_config $name]} {
 147                                         lappend repo_config($name) $value
 148                                 } else {
 149                                         set repo_config($name) $value
 150                                 }
 151                         }
 152                 }
 153                 close $fd_rc
 154         }
 155
 156         foreach name [array names default_config] {
 157                 if {[catch {set v $global_config($name)}]} {
 158                         set global_config($name) $default_config($name)
 159                 }
 160                 if {[catch {set v $repo_config($name)}]} {
 161                         set repo_config($name) $default_config($name)
 162                 }
 163         }
 164 }
 165
 166 proc save_config {} {
 167         global default_config font_descs
 168         global repo_config global_config
 169         global repo_config_new global_config_new
 170
 171         foreach option $font_descs {
 172                 set name [lindex $option 0]
 173                 set font [lindex $option 1]
 174                 font configure $font \
 175                         -family $global_config_new(gui.$font^^family) \
 176                         -size $global_config_new(gui.$font^^size)
 177                 font configure ${font}bold \
 178                         -family $global_config_new(gui.$font^^family) \
 179                         -size $global_config_new(gui.$font^^size)
 180                 set global_config_new(gui.$name) [font configure $font]
 181                 unset global_config_new(gui.$font^^family)
 182                 unset global_config_new(gui.$font^^size)
 183         }
 184
 185         foreach name [array names default_config] {
 186                 set value $global_config_new($name)
 187                 if {$value ne $global_config($name)} {
 188                         if {$value eq $default_config($name)} {
 189                                 catch {exec git repo-config --global --unset $name}
 190                         } else {
 191                                 regsub -all "\[{}\]" $value {"} value
 192                                 exec git repo-config --global $name $value
 193                         }
 194                         set global_config($name) $value
 195                         if {$value eq $repo_config($name)} {
 196                                 catch {exec git repo-config --unset $name}
 197                                 set repo_config($name) $value
 198                         }
 199                 }
 200         }
 201
 202         foreach name [array names default_config] {
 203                 set value $repo_config_new($name)
 204                 if {$value ne $repo_config($name)} {
 205                         if {$value eq $global_config($name)} {
 206                                 catch {exec git repo-config --unset $name}
 207                         } else {
 208                                 regsub -all "\[{}\]" $value {"} value
 209                                 exec git repo-config $name $value
 210                         }
 211                         set repo_config($name) $value
 212                 }
 213         }
 214 }
 215
 216 proc error_popup {msg} {
 217         set title [appname]
 218         if {[reponame] ne {}} {
 219                 append title " ([reponame])"
 220         }
 221         set cmd [list tk_messageBox \
 222                 -icon error \
 223                 -type ok \
 224                 -title "$title: error" \
 225                 -message $msg]
 226         if {[winfo ismapped .]} {
 227                 lappend cmd -parent .
 228         }
 229         eval $cmd
 230 }
 231
 232 proc warn_popup {msg} {
 233         set title [appname]
 234         if {[reponame] ne {}} {
 235                 append title " ([reponame])"
 236         }
 237         set cmd [list tk_messageBox \
 238                 -icon warning \
 239                 -type ok \
 240                 -title "$title: warning" \
 241                 -message $msg]
 242         if {[winfo ismapped .]} {
 243                 lappend cmd -parent .
 244         }
 245         eval $cmd
 246 }
 247
 248 proc info_popup {msg {parent .}} {
 249         set title [appname]
 250         if {[reponame] ne {}} {
 251                 append title " ([reponame])"
 252         }
 253         tk_messageBox \
 254                 -parent $parent \
 255                 -icon info \
 256                 -type ok \
 257                 -title $title \
 258                 -message $msg
 259 }
 260
 261 proc ask_popup {msg} {
 262         set title [appname]
 263         if {[reponame] ne {}} {
 264                 append title " ([reponame])"
 265         }
 266         return [tk_messageBox \
 267                 -parent . \
 268                 -icon question \
 269                 -type yesno \
 270                 -title $title \
 271                 -message $msg]
 272 }
 273
 274 ######################################################################
 275 ##
 276 ## repository setup
 277
 278 if {   [catch {set _gitdir $env(GIT_DIR)}]
 279         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 280         catch {wm withdraw .}
 281         error_popup "Cannot find the git directory:\n\n$err"
 282         exit 1
 283 }
 284 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 285         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 286 }
 287 if {![file isdirectory $_gitdir]} {
 288         catch {wm withdraw .}
 289         error_popup "Git directory not found:\n\n$_gitdir"
 290         exit 1
 291 }
 292 if {[lindex [file split $_gitdir] end] ne {.git}} {
 293         catch {wm withdraw .}
 294         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 295         exit 1
 296 }
 297 if {[catch {cd [file dirname $_gitdir]} err]} {
 298         catch {wm withdraw .}
 299         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 300         exit 1
 301 }
 302 set _reponame [lindex [file split \
 303         [file normalize [file dirname $_gitdir]]] \
 304         end]
 305
 306 set single_commit 0
 307 if {[appname] eq {git-citool}} {
 308         set single_commit 1
 309 }
 310
 311 ######################################################################
 312 ##
 313 ## task management
 314
 315 set rescan_active 0
 316 set diff_active 0
 317 set last_clicked {}
 318
 319 set disable_on_lock [list]
 320 set index_lock_type none
 321
 322 proc lock_index {type} {
 323         global index_lock_type disable_on_lock
 324
 325         if {$index_lock_type eq {none}} {
 326                 set index_lock_type $type
 327                 foreach w $disable_on_lock {
 328                         uplevel #0 $w disabled
 329                 }
 330                 return 1
 331         } elseif {$index_lock_type eq "begin-$type"} {
 332                 set index_lock_type $type
 333                 return 1
 334         }
 335         return 0
 336 }
 337
 338 proc unlock_index {} {
 339         global index_lock_type disable_on_lock
 340
 341         set index_lock_type none
 342         foreach w $disable_on_lock {
 343                 uplevel #0 $w normal
 344         }
 345 }
 346
 347 ######################################################################
 348 ##
 349 ## status
 350
 351 proc repository_state {ctvar hdvar mhvar} {
 352         global current_branch
 353         upvar $ctvar ct $hdvar hd $mhvar mh
 354
 355         set mh [list]
 356
 357         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 358                 set current_branch {}
 359         } else {
 360                 regsub ^refs/((heads|tags|remotes)/)? \
 361                         $current_branch \
 362                         {} \
 363                         current_branch
 364         }
 365
 366         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 367                 set hd {}
 368                 set ct initial
 369                 return
 370         }
 371
 372         set merge_head [gitdir MERGE_HEAD]
 373         if {[file exists $merge_head]} {
 374                 set ct merge
 375                 set fd_mh [open $merge_head r]
 376                 while {[gets $fd_mh line] >= 0} {
 377                         lappend mh $line
 378                 }
 379                 close $fd_mh
 380                 return
 381         }
 382
 383         set ct normal
 384 }
 385
 386 proc PARENT {} {
 387         global PARENT empty_tree
 388
 389         set p [lindex $PARENT 0]
 390         if {$p ne {}} {
 391                 return $p
 392         }
 393         if {$empty_tree eq {}} {
 394                 set empty_tree [exec git mktree << {}]
 395         }
 396         return $empty_tree
 397 }
 398
 399 proc rescan {after {honor_trustmtime 1}} {
 400         global HEAD PARENT MERGE_HEAD commit_type
 401         global ui_index ui_workdir ui_status_value ui_comm
 402         global rescan_active file_states
 403         global repo_config
 404
 405         if {$rescan_active > 0 || ![lock_index read]} return
 406
 407         repository_state newType newHEAD newMERGE_HEAD
 408         if {[string match amend* $commit_type]
 409                 && $newType eq {normal}
 410                 && $newHEAD eq $HEAD} {
 411         } else {
 412                 set HEAD $newHEAD
 413                 set PARENT $newHEAD
 414                 set MERGE_HEAD $newMERGE_HEAD
 415                 set commit_type $newType
 416         }
 417
 418         array unset file_states
 419
 420         if {![$ui_comm edit modified]
 421                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 422                 if {[load_message GITGUI_MSG]} {
 423                 } elseif {[load_message MERGE_MSG]} {
 424                 } elseif {[load_message SQUASH_MSG]} {
 425                 }
 426                 $ui_comm edit reset
 427                 $ui_comm edit modified false
 428         }
 429
 430         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 431                 rescan_stage2 {} $after
 432         } else {
 433                 set rescan_active 1
 434                 set ui_status_value {Refreshing file status...}
 435                 set cmd [list git update-index]
 436                 lappend cmd -q
 437                 lappend cmd --unmerged
 438                 lappend cmd --ignore-missing
 439                 lappend cmd --refresh
 440                 set fd_rf [open "| $cmd" r]
 441                 fconfigure $fd_rf -blocking 0 -translation binary
 442                 fileevent $fd_rf readable \
 443                         [list rescan_stage2 $fd_rf $after]
 444         }
 445 }
 446
 447 proc rescan_stage2 {fd after} {
 448         global ui_status_value
 449         global rescan_active buf_rdi buf_rdf buf_rlo
 450
 451         if {$fd ne {}} {
 452                 read $fd
 453                 if {![eof $fd]} return
 454                 close $fd
 455         }
 456
 457         set ls_others [list | git ls-files --others -z \
 458                 --exclude-per-directory=.gitignore]
 459         set info_exclude [gitdir info exclude]
 460         if {[file readable $info_exclude]} {
 461                 lappend ls_others "--exclude-from=$info_exclude"
 462         }
 463
 464         set buf_rdi {}
 465         set buf_rdf {}
 466         set buf_rlo {}
 467
 468         set rescan_active 3
 469         set ui_status_value {Scanning for modified files ...}
 470         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 471         set fd_df [open "| git diff-files -z" r]
 472         set fd_lo [open $ls_others r]
 473
 474         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 475         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 476         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 477         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 478         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 479         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 480 }
 481
 482 proc load_message {file} {
 483         global ui_comm
 484
 485         set f [gitdir $file]
 486         if {[file isfile $f]} {
 487                 if {[catch {set fd [open $f r]}]} {
 488                         return 0
 489                 }
 490                 set content [string trim [read $fd]]
 491                 close $fd
 492                 regsub -all -line {[ \r\t]+$} $content {} content
 493                 $ui_comm delete 0.0 end
 494                 $ui_comm insert end $content
 495                 return 1
 496         }
 497         return 0
 498 }
 499
 500 proc read_diff_index {fd after} {
 501         global buf_rdi
 502
 503         append buf_rdi [read $fd]
 504         set c 0
 505         set n [string length $buf_rdi]
 506         while {$c < $n} {
 507                 set z1 [string first "\0" $buf_rdi $c]
 508                 if {$z1 == -1} break
 509                 incr z1
 510                 set z2 [string first "\0" $buf_rdi $z1]
 511                 if {$z2 == -1} break
 512
 513                 incr c
 514                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 515                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 516                 merge_state \
 517                         [encoding convertfrom $p] \
 518                         [lindex $i 4]? \
 519                         [list [lindex $i 0] [lindex $i 2]] \
 520                         [list]
 521                 set c $z2
 522                 incr c
 523         }
 524         if {$c < $n} {
 525                 set buf_rdi [string range $buf_rdi $c end]
 526         } else {
 527                 set buf_rdi {}
 528         }
 529
 530         rescan_done $fd buf_rdi $after
 531 }
 532
 533 proc read_diff_files {fd after} {
 534         global buf_rdf
 535
 536         append buf_rdf [read $fd]
 537         set c 0
 538         set n [string length $buf_rdf]
 539         while {$c < $n} {
 540                 set z1 [string first "\0" $buf_rdf $c]
 541                 if {$z1 == -1} break
 542                 incr z1
 543                 set z2 [string first "\0" $buf_rdf $z1]
 544                 if {$z2 == -1} break
 545
 546                 incr c
 547                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 548                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 549                 merge_state \
 550                         [encoding convertfrom $p] \
 551                         ?[lindex $i 4] \
 552                         [list] \
 553                         [list [lindex $i 0] [lindex $i 2]]
 554                 set c $z2
 555                 incr c
 556         }
 557         if {$c < $n} {
 558                 set buf_rdf [string range $buf_rdf $c end]
 559         } else {
 560                 set buf_rdf {}
 561         }
 562
 563         rescan_done $fd buf_rdf $after
 564 }
 565
 566 proc read_ls_others {fd after} {
 567         global buf_rlo
 568
 569         append buf_rlo [read $fd]
 570         set pck [split $buf_rlo "\0"]
 571         set buf_rlo [lindex $pck end]
 572         foreach p [lrange $pck 0 end-1] {
 573                 merge_state [encoding convertfrom $p] ?O
 574         }
 575         rescan_done $fd buf_rlo $after
 576 }
 577
 578 proc rescan_done {fd buf after} {
 579         global rescan_active
 580         global file_states repo_config
 581         upvar $buf to_clear
 582
 583         if {![eof $fd]} return
 584         set to_clear {}
 585         close $fd
 586         if {[incr rescan_active -1] > 0} return
 587
 588         prune_selection
 589         unlock_index
 590         display_all_files
 591         reshow_diff
 592         uplevel #0 $after
 593 }
 594
 595 proc prune_selection {} {
 596         global file_states selected_paths
 597
 598         foreach path [array names selected_paths] {
 599                 if {[catch {set still_here $file_states($path)}]} {
 600                         unset selected_paths($path)
 601                 }
 602         }
 603 }
 604
 605 ######################################################################
 606 ##
 607 ## diff
 608
 609 proc clear_diff {} {
 610         global ui_diff current_diff_path current_diff_header
 611         global ui_index ui_workdir
 612
 613         $ui_diff conf -state normal
 614         $ui_diff delete 0.0 end
 615         $ui_diff conf -state disabled
 616
 617         set current_diff_path {}
 618         set current_diff_header {}
 619
 620         $ui_index tag remove in_diff 0.0 end
 621         $ui_workdir tag remove in_diff 0.0 end
 622 }
 623
 624 proc reshow_diff {} {
 625         global ui_status_value file_states file_lists
 626         global current_diff_path current_diff_side
 627
 628         set p $current_diff_path
 629         if {$p eq {}
 630                 || $current_diff_side eq {}
 631                 || [catch {set s $file_states($p)}]
 632                 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 633                 clear_diff
 634         } else {
 635                 show_diff $p $current_diff_side
 636         }
 637 }
 638
 639 proc handle_empty_diff {} {
 640         global current_diff_path file_states file_lists
 641
 642         set path $current_diff_path
 643         set s $file_states($path)
 644         if {[lindex $s 0] ne {_M}} return
 645
 646         info_popup "No differences detected.
 647
 648 [short_path $path] has no changes.
 649
 650 The modification date of this file was updated
 651 by another application, but the content within
 652 the file was not changed.
 653
 654 A rescan will be automatically started to find
 655 other files which may have the same state."
 656
 657         clear_diff
 658         display_file $path __
 659         rescan {set ui_status_value {Ready.}} 0
 660 }
 661
 662 proc show_diff {path w {lno {}}} {
 663         global file_states file_lists
 664         global is_3way_diff diff_active repo_config
 665         global ui_diff ui_status_value ui_index ui_workdir
 666         global current_diff_path current_diff_side current_diff_header
 667
 668         if {$diff_active || ![lock_index read]} return
 669
 670         clear_diff
 671         if {$lno == {}} {
 672                 set lno [lsearch -sorted -exact $file_lists($w) $path]
 673                 if {$lno >= 0} {
 674                         incr lno
 675                 }
 676         }
 677         if {$lno >= 1} {
 678                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 679         }
 680
 681         set s $file_states($path)
 682         set m [lindex $s 0]
 683         set is_3way_diff 0
 684         set diff_active 1
 685         set current_diff_path $path
 686         set current_diff_side $w
 687         set current_diff_header {}
 688         set ui_status_value "Loading diff of [escape_path $path]..."
 689
 690         # - Git won't give us the diff, there's nothing to compare to!
 691         #
 692         if {$m eq {_O}} {
 693                 set max_sz [expr {128 * 1024}]
 694                 if {[catch {
 695                                 set fd [open $path r]
 696                                 set content [read $fd $max_sz]
 697                                 close $fd
 698                                 set sz [file size $path]
 699                         } err ]} {
 700                         set diff_active 0
 701                         unlock_index
 702                         set ui_status_value "Unable to display [escape_path $path]"
 703                         error_popup "Error loading file:\n\n$err"
 704                         return
 705                 }
 706                 $ui_diff conf -state normal
 707                 if {![catch {set type [exec file $path]}]} {
 708                         set n [string length $path]
 709                         if {[string equal -length $n $path $type]} {
 710                                 set type [string range $type $n end]
 711                                 regsub {^:?\s*} $type {} type
 712                         }
 713                         $ui_diff insert end "* $type\n" d_@
 714                 }
 715                 if {[string first "\0" $content] != -1} {
 716                         $ui_diff insert end \
 717                                 "* Binary file (not showing content)." \
 718                                 d_@
 719                 } else {
 720                         if {$sz > $max_sz} {
 721                                 $ui_diff insert end \
 722 "* Untracked file is $sz bytes.
 723 * Showing only first $max_sz bytes.
 724 " d_@
 725                         }
 726                         $ui_diff insert end $content
 727                         if {$sz > $max_sz} {
 728                                 $ui_diff insert end "
 729 * Untracked file clipped here by [appname].
 730 * To see the entire file, use an external editor.
 731 " d_@
 732                         }
 733                 }
 734                 $ui_diff conf -state disabled
 735                 set diff_active 0
 736                 unlock_index
 737                 set ui_status_value {Ready.}
 738                 return
 739         }
 740
 741         set cmd [list | git]
 742         if {$w eq $ui_index} {
 743                 lappend cmd diff-index
 744                 lappend cmd --cached
 745         } elseif {$w eq $ui_workdir} {
 746                 if {[string index $m 0] eq {U}} {
 747                         lappend cmd diff
 748                 } else {
 749                         lappend cmd diff-files
 750                 }
 751         }
 752
 753         lappend cmd -p
 754         lappend cmd --no-color
 755         if {$repo_config(gui.diffcontext) > 0} {
 756                 lappend cmd "-U$repo_config(gui.diffcontext)"
 757         }
 758         if {$w eq $ui_index} {
 759                 lappend cmd [PARENT]
 760         }
 761         lappend cmd --
 762         lappend cmd $path
 763
 764         if {[catch {set fd [open $cmd r]} err]} {
 765                 set diff_active 0
 766                 unlock_index
 767                 set ui_status_value "Unable to display [escape_path $path]"
 768                 error_popup "Error loading diff:\n\n$err"
 769                 return
 770         }
 771
 772         fconfigure $fd \
 773                 -blocking 0 \
 774                 -encoding binary \
 775                 -translation binary
 776         fileevent $fd readable [list read_diff $fd]
 777 }
 778
 779 proc read_diff {fd} {
 780         global ui_diff ui_status_value diff_active
 781         global is_3way_diff current_diff_header
 782
 783         $ui_diff conf -state normal
 784         while {[gets $fd line] >= 0} {
 785                 # -- Cleanup uninteresting diff header lines.
 786                 #
 787                 if {   [string match {diff --git *}      $line]
 788                         || [string match {diff --cc *}       $line]
 789                         || [string match {diff --combined *} $line]
 790                         || [string match {--- *}             $line]
 791                         || [string match {+++ *}             $line]} {
 792                         append current_diff_header $line "\n"
 793                         continue
 794                 }
 795                 if {[string match {index *} $line]} continue
 796                 if {$line eq {deleted file mode 120000}} {
 797                         set line "deleted symlink"
 798                 }
 799
 800                 # -- Automatically detect if this is a 3 way diff.
 801                 #
 802                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 803
 804                 if {[string match {mode *} $line]
 805                         || [string match {new file *} $line]
 806                         || [string match {deleted file *} $line]
 807                         || [string match {Binary files * and * differ} $line]
 808                         || $line eq {\ No newline at end of file}
 809                         || [regexp {^\* Unmerged path } $line]} {
 810                         set tags {}
 811                 } elseif {$is_3way_diff} {
 812                         set op [string range $line 0 1]
 813                         switch -- $op {
 814                         {  } {set tags {}}
 815                         {@@} {set tags d_@}
 816                         { +} {set tags d_s+}
 817                         { -} {set tags d_s-}
 818                         {+ } {set tags d_+s}
 819                         {- } {set tags d_-s}
 820                         {--} {set tags d_--}
 821                         {++} {
 822                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 823                                         set line [string replace $line 0 1 {  }]
 824                                         set tags d$op
 825                                 } else {
 826                                         set tags d_++
 827                                 }
 828                         }
 829                         default {
 830                                 puts "error: Unhandled 3 way diff marker: {$op}"
 831                                 set tags {}
 832                         }
 833                         }
 834                 } else {
 835                         set op [string index $line 0]
 836                         switch -- $op {
 837                         { } {set tags {}}
 838                         {@} {set tags d_@}
 839                         {-} {set tags d_-}
 840                         {+} {
 841                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 842                                         set line [string replace $line 0 0 { }]
 843                                         set tags d$op
 844                                 } else {
 845                                         set tags d_+
 846                                 }
 847                         }
 848                         default {
 849                                 puts "error: Unhandled 2 way diff marker: {$op}"
 850                                 set tags {}
 851                         }
 852                         }
 853                 }
 854                 $ui_diff insert end $line $tags
 855                 if {[string index $line end] eq "\r"} {
 856                         $ui_diff tag add d_cr {end - 2c}
 857                 }
 858                 $ui_diff insert end "\n" $tags
 859         }
 860         $ui_diff conf -state disabled
 861
 862         if {[eof $fd]} {
 863                 close $fd
 864                 set diff_active 0
 865                 unlock_index
 866                 set ui_status_value {Ready.}
 867
 868                 if {[$ui_diff index end] eq {2.0}} {
 869                         handle_empty_diff
 870                 }
 871         }
 872 }
 873
 874 proc apply_hunk {x y} {
 875         global current_diff_path current_diff_header current_diff_side
 876         global ui_diff ui_index file_states
 877
 878         if {$current_diff_path eq {} || $current_diff_header eq {}} return
 879         if {![lock_index apply_hunk]} return
 880
 881         set apply_cmd {git apply --cached --whitespace=nowarn}
 882         set mi [lindex $file_states($current_diff_path) 0]
 883         if {$current_diff_side eq $ui_index} {
 884                 set mode unstage
 885                 lappend apply_cmd --reverse
 886                 if {[string index $mi 0] ne {M}} {
 887                         unlock_index
 888                         return
 889                 }
 890         } else {
 891                 set mode stage
 892                 if {[string index $mi 1] ne {M}} {
 893                         unlock_index
 894                         return
 895                 }
 896         }
 897
 898         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 899         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 900         if {$s_lno eq {}} {
 901                 unlock_index
 902                 return
 903         }
 904
 905         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 906         if {$e_lno eq {}} {
 907                 set e_lno end
 908         }
 909
 910         if {[catch {
 911                 set p [open "| $apply_cmd" w]
 912                 fconfigure $p -translation binary -encoding binary
 913                 puts -nonewline $p $current_diff_header
 914                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 915                 close $p} err]} {
 916                 error_popup "Failed to $mode selected hunk.\n\n$err"
 917                 unlock_index
 918                 return
 919         }
 920
 921         $ui_diff conf -state normal
 922         $ui_diff delete $s_lno $e_lno
 923         $ui_diff conf -state disabled
 924
 925         if {[$ui_diff get 1.0 end] eq "\n"} {
 926                 set o _
 927         } else {
 928                 set o ?
 929         }
 930
 931         if {$current_diff_side eq $ui_index} {
 932                 set mi ${o}M
 933         } elseif {[string index $mi 0] eq {_}} {
 934                 set mi M$o
 935         } else {
 936                 set mi ?$o
 937         }
 938         unlock_index
 939         display_file $current_diff_path $mi
 940         if {$o eq {_}} {
 941                 clear_diff
 942         }
 943 }
 944
 945 ######################################################################
 946 ##
 947 ## commit
 948
 949 proc load_last_commit {} {
 950         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 951         global repo_config
 952
 953         if {[llength $PARENT] == 0} {
 954                 error_popup {There is nothing to amend.
 955
 956 You are about to create the initial commit.
 957 There is no commit before this to amend.
 958 }
 959                 return
 960         }
 961
 962         repository_state curType curHEAD curMERGE_HEAD
 963         if {$curType eq {merge}} {
 964                 error_popup {Cannot amend while merging.
 965
 966 You are currently in the middle of a merge that
 967 has not been fully completed.  You cannot amend
 968 the prior commit unless you first abort the
 969 current merge activity.
 970 }
 971                 return
 972         }
 973
 974         set msg {}
 975         set parents [list]
 976         if {[catch {
 977                         set fd [open "| git cat-file commit $curHEAD" r]
 978                         fconfigure $fd -encoding binary -translation lf
 979                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 980                                 set enc utf-8
 981                         }
 982                         while {[gets $fd line] > 0} {
 983                                 if {[string match {parent *} $line]} {
 984                                         lappend parents [string range $line 7 end]
 985                                 } elseif {[string match {encoding *} $line]} {
 986                                         set enc [string tolower [string range $line 9 end]]
 987                                 }
 988                         }
 989                         fconfigure $fd -encoding $enc
 990                         set msg [string trim [read $fd]]
 991                         close $fd
 992                 } err]} {
 993                 error_popup "Error loading commit data for amend:\n\n$err"
 994                 return
 995         }
 996
 997         set HEAD $curHEAD
 998         set PARENT $parents
 999         set MERGE_HEAD [list]
1000         switch -- [llength $parents] {
1001         0       {set commit_type amend-initial}
1002         1       {set commit_type amend}
1003         default {set commit_type amend-merge}
1004         }
1005
1006         $ui_comm delete 0.0 end
1007         $ui_comm insert end $msg
1008         $ui_comm edit reset
1009         $ui_comm edit modified false
1010         rescan {set ui_status_value {Ready.}}
1011 }
1012
1013 proc create_new_commit {} {
1014         global commit_type ui_comm
1015
1016         set commit_type normal
1017         $ui_comm delete 0.0 end
1018         $ui_comm edit reset
1019         $ui_comm edit modified false
1020         rescan {set ui_status_value {Ready.}}
1021 }
1022
1023 set GIT_COMMITTER_IDENT {}
1024
1025 proc committer_ident {} {
1026         global GIT_COMMITTER_IDENT
1027
1028         if {$GIT_COMMITTER_IDENT eq {}} {
1029                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1030                         error_popup "Unable to obtain your identity:\n\n$err"
1031                         return {}
1032                 }
1033                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1034                         $me me GIT_COMMITTER_IDENT]} {
1035                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1036                         return {}
1037                 }
1038         }
1039
1040         return $GIT_COMMITTER_IDENT
1041 }
1042
1043 proc commit_tree {} {
1044         global HEAD commit_type file_states ui_comm repo_config
1045         global ui_status_value pch_error
1046
1047         if {[committer_ident] eq {}} return
1048         if {![lock_index update]} return
1049
1050         # -- Our in memory state should match the repository.
1051         #
1052         repository_state curType curHEAD curMERGE_HEAD
1053         if {[string match amend* $commit_type]
1054                 && $curType eq {normal}
1055                 && $curHEAD eq $HEAD} {
1056         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1057                 info_popup {Last scanned state does not match repository state.
1058
1059 Another Git program has modified this repository
1060 since the last scan.  A rescan must be performed
1061 before another commit can be created.
1062
1063 The rescan will be automatically started now.
1064 }
1065                 unlock_index
1066                 rescan {set ui_status_value {Ready.}}
1067                 return
1068         }
1069
1070         # -- At least one file should differ in the index.
1071         #
1072         set files_ready 0
1073         foreach path [array names file_states] {
1074                 switch -glob -- [lindex $file_states($path) 0] {
1075                 _? {continue}
1076                 A? -
1077                 D? -
1078                 M? {set files_ready 1}
1079                 U? {
1080                         error_popup "Unmerged files cannot be committed.
1081
1082 File [short_path $path] has merge conflicts.
1083 You must resolve them and add the file before committing.
1084 "
1085                         unlock_index
1086                         return
1087                 }
1088                 default {
1089                         error_popup "Unknown file state [lindex $s 0] detected.
1090
1091 File [short_path $path] cannot be committed by this program.
1092 "
1093                 }
1094                 }
1095         }
1096         if {!$files_ready} {
1097                 info_popup {No changes to commit.
1098
1099 You must add at least 1 file before you can commit.
1100 }
1101                 unlock_index
1102                 return
1103         }
1104
1105         # -- A message is required.
1106         #
1107         set msg [string trim [$ui_comm get 1.0 end]]
1108         regsub -all -line {[ \t\r]+$} $msg {} msg
1109         if {$msg eq {}} {
1110                 error_popup {Please supply a commit message.
1111
1112 A good commit message has the following format:
1113
1114 - First line: Describe in one sentance what you did.
1115 - Second line: Blank
1116 - Remaining lines: Describe why this change is good.
1117 }
1118                 unlock_index
1119                 return
1120         }
1121
1122         # -- Run the pre-commit hook.
1123         #
1124         set pchook [gitdir hooks pre-commit]
1125
1126         # On Cygwin [file executable] might lie so we need to ask
1127         # the shell if the hook is executable.  Yes that's annoying.
1128         #
1129         if {[is_Cygwin] && [file isfile $pchook]} {
1130                 set pchook [list sh -c [concat \
1131                         "if test -x \"$pchook\";" \
1132                         "then exec \"$pchook\" 2>&1;" \
1133                         "fi"]]
1134         } elseif {[file executable $pchook]} {
1135                 set pchook [list $pchook |& cat]
1136         } else {
1137                 commit_writetree $curHEAD $msg
1138                 return
1139         }
1140
1141         set ui_status_value {Calling pre-commit hook...}
1142         set pch_error {}
1143         set fd_ph [open "| $pchook" r]
1144         fconfigure $fd_ph -blocking 0 -translation binary
1145         fileevent $fd_ph readable \
1146                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1147 }
1148
1149 proc commit_prehook_wait {fd_ph curHEAD msg} {
1150         global pch_error ui_status_value
1151
1152         append pch_error [read $fd_ph]
1153         fconfigure $fd_ph -blocking 1
1154         if {[eof $fd_ph]} {
1155                 if {[catch {close $fd_ph}]} {
1156                         set ui_status_value {Commit declined by pre-commit hook.}
1157                         hook_failed_popup pre-commit $pch_error
1158                         unlock_index
1159                 } else {
1160                         commit_writetree $curHEAD $msg
1161                 }
1162                 set pch_error {}
1163                 return
1164         }
1165         fconfigure $fd_ph -blocking 0
1166 }
1167
1168 proc commit_writetree {curHEAD msg} {
1169         global ui_status_value
1170
1171         set ui_status_value {Committing changes...}
1172         set fd_wt [open "| git write-tree" r]
1173         fileevent $fd_wt readable \
1174                 [list commit_committree $fd_wt $curHEAD $msg]
1175 }
1176
1177 proc commit_committree {fd_wt curHEAD msg} {
1178         global HEAD PARENT MERGE_HEAD commit_type
1179         global single_commit all_heads current_branch
1180         global ui_status_value ui_comm selected_commit_type
1181         global file_states selected_paths rescan_active
1182         global repo_config
1183
1184         gets $fd_wt tree_id
1185         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1186                 error_popup "write-tree failed:\n\n$err"
1187                 set ui_status_value {Commit failed.}
1188                 unlock_index
1189                 return
1190         }
1191
1192         # -- Build the message.
1193         #
1194         set msg_p [gitdir COMMIT_EDITMSG]
1195         set msg_wt [open $msg_p w]
1196         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1197                 set enc utf-8
1198         }
1199         fconfigure $msg_wt -encoding $enc -translation binary
1200         puts -nonewline $msg_wt $msg
1201         close $msg_wt
1202
1203         # -- Create the commit.
1204         #
1205         set cmd [list git commit-tree $tree_id]
1206         set parents [concat $PARENT $MERGE_HEAD]
1207         if {[llength $parents] > 0} {
1208                 foreach p $parents {
1209                         lappend cmd -p $p
1210                 }
1211         } else {
1212                 # git commit-tree writes to stderr during initial commit.
1213                 lappend cmd 2>/dev/null
1214         }
1215         lappend cmd <$msg_p
1216         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1217                 error_popup "commit-tree failed:\n\n$err"
1218                 set ui_status_value {Commit failed.}
1219                 unlock_index
1220                 return
1221         }
1222
1223         # -- Update the HEAD ref.
1224         #
1225         set reflogm commit
1226         if {$commit_type ne {normal}} {
1227                 append reflogm " ($commit_type)"
1228         }
1229         set i [string first "\n" $msg]
1230         if {$i >= 0} {
1231                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1232         } else {
1233                 append reflogm {: } $msg
1234         }
1235         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1236         if {[catch {eval exec $cmd} err]} {
1237                 error_popup "update-ref failed:\n\n$err"
1238                 set ui_status_value {Commit failed.}
1239                 unlock_index
1240                 return
1241         }
1242
1243         # -- Make sure our current branch exists.
1244         #
1245         if {$commit_type eq {initial}} {
1246                 lappend all_heads $current_branch
1247                 set all_heads [lsort -unique $all_heads]
1248                 populate_branch_menu
1249         }
1250
1251         # -- Cleanup after ourselves.
1252         #
1253         catch {file delete $msg_p}
1254         catch {file delete [gitdir MERGE_HEAD]}
1255         catch {file delete [gitdir MERGE_MSG]}
1256         catch {file delete [gitdir SQUASH_MSG]}
1257         catch {file delete [gitdir GITGUI_MSG]}
1258
1259         # -- Let rerere do its thing.
1260         #
1261         if {[file isdirectory [gitdir rr-cache]]} {
1262                 catch {exec git rerere}
1263         }
1264
1265         # -- Run the post-commit hook.
1266         #
1267         set pchook [gitdir hooks post-commit]
1268         if {[is_Cygwin] && [file isfile $pchook]} {
1269                 set pchook [list sh -c [concat \
1270                         "if test -x \"$pchook\";" \
1271                         "then exec \"$pchook\";" \
1272                         "fi"]]
1273         } elseif {![file executable $pchook]} {
1274                 set pchook {}
1275         }
1276         if {$pchook ne {}} {
1277                 catch {exec $pchook &}
1278         }
1279
1280         $ui_comm delete 0.0 end
1281         $ui_comm edit reset
1282         $ui_comm edit modified false
1283
1284         if {$single_commit} do_quit
1285
1286         # -- Update in memory status
1287         #
1288         set selected_commit_type new
1289         set commit_type normal
1290         set HEAD $cmt_id
1291         set PARENT $cmt_id
1292         set MERGE_HEAD [list]
1293
1294         foreach path [array names file_states] {
1295                 set s $file_states($path)
1296                 set m [lindex $s 0]
1297                 switch -glob -- $m {
1298                 _O -
1299                 _M -
1300                 _D {continue}
1301                 __ -
1302                 A_ -
1303                 M_ -
1304                 D_ {
1305                         unset file_states($path)
1306                         catch {unset selected_paths($path)}
1307                 }
1308                 DO {
1309                         set file_states($path) [list _O [lindex $s 1] {} {}]
1310                 }
1311                 AM -
1312                 AD -
1313                 MM -
1314                 MD {
1315                         set file_states($path) [list \
1316                                 _[string index $m 1] \
1317                                 [lindex $s 1] \
1318                                 [lindex $s 3] \
1319                                 {}]
1320                 }
1321                 }
1322         }
1323
1324         display_all_files
1325         unlock_index
1326         reshow_diff
1327         set ui_status_value \
1328                 "Changes committed as [string range $cmt_id 0 7]."
1329 }
1330
1331 ######################################################################
1332 ##
1333 ## fetch push
1334
1335 proc fetch_from {remote} {
1336         set w [new_console \
1337                 "fetch $remote" \
1338                 "Fetching new changes from $remote"]
1339         set cmd [list git fetch]
1340         lappend cmd $remote
1341         console_exec $w $cmd console_done
1342 }
1343
1344 proc push_to {remote} {
1345         set w [new_console \
1346                 "push $remote" \
1347                 "Pushing changes to $remote"]
1348         set cmd [list git push]
1349         lappend cmd -v
1350         lappend cmd $remote
1351         console_exec $w $cmd console_done
1352 }
1353
1354 ######################################################################
1355 ##
1356 ## ui helpers
1357
1358 proc mapicon {w state path} {
1359         global all_icons
1360
1361         if {[catch {set r $all_icons($state$w)}]} {
1362                 puts "error: no icon for $w state={$state} $path"
1363                 return file_plain
1364         }
1365         return $r
1366 }
1367
1368 proc mapdesc {state path} {
1369         global all_descs
1370
1371         if {[catch {set r $all_descs($state)}]} {
1372                 puts "error: no desc for state={$state} $path"
1373                 return $state
1374         }
1375         return $r
1376 }
1377
1378 proc escape_path {path} {
1379         regsub -all "\n" $path "\\n" path
1380         return $path
1381 }
1382
1383 proc short_path {path} {
1384         return [escape_path [lindex [file split $path] end]]
1385 }
1386
1387 set next_icon_id 0
1388 set null_sha1 [string repeat 0 40]
1389
1390 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1391         global file_states next_icon_id null_sha1
1392
1393         set s0 [string index $new_state 0]
1394         set s1 [string index $new_state 1]
1395
1396         if {[catch {set info $file_states($path)}]} {
1397                 set state __
1398                 set icon n[incr next_icon_id]
1399         } else {
1400                 set state [lindex $info 0]
1401                 set icon [lindex $info 1]
1402                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1403                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1404         }
1405
1406         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1407         elseif {$s0 eq {_}} {set s0 _}
1408
1409         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1410         elseif {$s1 eq {_}} {set s1 _}
1411
1412         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1413                 set head_info [list 0 $null_sha1]
1414         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1415                 && $head_info eq {}} {
1416                 set head_info $index_info
1417         }
1418
1419         set file_states($path) [list $s0$s1 $icon \
1420                 $head_info $index_info \
1421                 ]
1422         return $state
1423 }
1424
1425 proc display_file_helper {w path icon_name old_m new_m} {
1426         global file_lists
1427
1428         if {$new_m eq {_}} {
1429                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1430                 if {$lno >= 0} {
1431                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1432                         incr lno
1433                         $w conf -state normal
1434                         $w delete $lno.0 [expr {$lno + 1}].0
1435                         $w conf -state disabled
1436                 }
1437         } elseif {$old_m eq {_} && $new_m ne {_}} {
1438                 lappend file_lists($w) $path
1439                 set file_lists($w) [lsort -unique $file_lists($w)]
1440                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1441                 incr lno
1442                 $w conf -state normal
1443                 $w image create $lno.0 \
1444                         -align center -padx 5 -pady 1 \
1445                         -name $icon_name \
1446                         -image [mapicon $w $new_m $path]
1447                 $w insert $lno.1 "[escape_path $path]\n"
1448                 $w conf -state disabled
1449         } elseif {$old_m ne $new_m} {
1450                 $w conf -state normal
1451                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1452                 $w conf -state disabled
1453         }
1454 }
1455
1456 proc display_file {path state} {
1457         global file_states selected_paths
1458         global ui_index ui_workdir
1459
1460         set old_m [merge_state $path $state]
1461         set s $file_states($path)
1462         set new_m [lindex $s 0]
1463         set icon_name [lindex $s 1]
1464
1465         set o [string index $old_m 0]
1466         set n [string index $new_m 0]
1467         if {$o eq {U}} {
1468                 set o _
1469         }
1470         if {$n eq {U}} {
1471                 set n _
1472         }
1473         display_file_helper     $ui_index $path $icon_name $o $n
1474
1475         if {[string index $old_m 0] eq {U}} {
1476                 set o U
1477         } else {
1478                 set o [string index $old_m 1]
1479         }
1480         if {[string index $new_m 0] eq {U}} {
1481                 set n U
1482         } else {
1483                 set n [string index $new_m 1]
1484         }
1485         display_file_helper     $ui_workdir $path $icon_name $o $n
1486
1487         if {$new_m eq {__}} {
1488                 unset file_states($path)
1489                 catch {unset selected_paths($path)}
1490         }
1491 }
1492
1493 proc display_all_files_helper {w path icon_name m} {
1494         global file_lists
1495
1496         lappend file_lists($w) $path
1497         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1498         $w image create end \
1499                 -align center -padx 5 -pady 1 \
1500                 -name $icon_name \
1501                 -image [mapicon $w $m $path]
1502         $w insert end "[escape_path $path]\n"
1503 }
1504
1505 proc display_all_files {} {
1506         global ui_index ui_workdir
1507         global file_states file_lists
1508         global last_clicked
1509
1510         $ui_index conf -state normal
1511         $ui_workdir conf -state normal
1512
1513         $ui_index delete 0.0 end
1514         $ui_workdir delete 0.0 end
1515         set last_clicked {}
1516
1517         set file_lists($ui_index) [list]
1518         set file_lists($ui_workdir) [list]
1519
1520         foreach path [lsort [array names file_states]] {
1521                 set s $file_states($path)
1522                 set m [lindex $s 0]
1523                 set icon_name [lindex $s 1]
1524
1525                 set s [string index $m 0]
1526                 if {$s ne {U} && $s ne {_}} {
1527                         display_all_files_helper $ui_index $path \
1528                                 $icon_name $s
1529                 }
1530
1531                 if {[string index $m 0] eq {U}} {
1532                         set s U
1533                 } else {
1534                         set s [string index $m 1]
1535                 }
1536                 if {$s ne {_}} {
1537                         display_all_files_helper $ui_workdir $path \
1538                                 $icon_name $s
1539                 }
1540         }
1541
1542         $ui_index conf -state disabled
1543         $ui_workdir conf -state disabled
1544 }
1545
1546 proc update_indexinfo {msg pathList after} {
1547         global update_index_cp ui_status_value
1548
1549         if {![lock_index update]} return
1550
1551         set update_index_cp 0
1552         set pathList [lsort $pathList]
1553         set totalCnt [llength $pathList]
1554         set batch [expr {int($totalCnt * .01) + 1}]
1555         if {$batch > 25} {set batch 25}
1556
1557         set ui_status_value [format \
1558                 "$msg... %i/%i files (%.2f%%)" \
1559                 $update_index_cp \
1560                 $totalCnt \
1561                 0.0]
1562         set fd [open "| git update-index -z --index-info" w]
1563         fconfigure $fd \
1564                 -blocking 0 \
1565                 -buffering full \
1566                 -buffersize 512 \
1567                 -encoding binary \
1568                 -translation binary
1569         fileevent $fd writable [list \
1570                 write_update_indexinfo \
1571                 $fd \
1572                 $pathList \
1573                 $totalCnt \
1574                 $batch \
1575                 $msg \
1576                 $after \
1577                 ]
1578 }
1579
1580 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1581         global update_index_cp ui_status_value
1582         global file_states current_diff_path
1583
1584         if {$update_index_cp >= $totalCnt} {
1585                 close $fd
1586                 unlock_index
1587                 uplevel #0 $after
1588                 return
1589         }
1590
1591         for {set i $batch} \
1592                 {$update_index_cp < $totalCnt && $i > 0} \
1593                 {incr i -1} {
1594                 set path [lindex $pathList $update_index_cp]
1595                 incr update_index_cp
1596
1597                 set s $file_states($path)
1598                 switch -glob -- [lindex $s 0] {
1599                 A? {set new _O}
1600                 M? {set new _M}
1601                 D_ {set new _D}
1602                 D? {set new _?}
1603                 ?? {continue}
1604                 }
1605                 set info [lindex $s 2]
1606                 if {$info eq {}} continue
1607
1608                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1609                 display_file $path $new
1610         }
1611
1612         set ui_status_value [format \
1613                 "$msg... %i/%i files (%.2f%%)" \
1614                 $update_index_cp \
1615                 $totalCnt \
1616                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1617 }
1618
1619 proc update_index {msg pathList after} {
1620         global update_index_cp ui_status_value
1621
1622         if {![lock_index update]} return
1623
1624         set update_index_cp 0
1625         set pathList [lsort $pathList]
1626         set totalCnt [llength $pathList]
1627         set batch [expr {int($totalCnt * .01) + 1}]
1628         if {$batch > 25} {set batch 25}
1629
1630         set ui_status_value [format \
1631                 "$msg... %i/%i files (%.2f%%)" \
1632                 $update_index_cp \
1633                 $totalCnt \
1634                 0.0]
1635         set fd [open "| git update-index --add --remove -z --stdin" w]
1636         fconfigure $fd \
1637                 -blocking 0 \
1638                 -buffering full \
1639                 -buffersize 512 \
1640                 -encoding binary \
1641                 -translation binary
1642         fileevent $fd writable [list \
1643                 write_update_index \
1644                 $fd \
1645                 $pathList \
1646                 $totalCnt \
1647                 $batch \
1648                 $msg \
1649                 $after \
1650                 ]
1651 }
1652
1653 proc write_update_index {fd pathList totalCnt batch msg after} {
1654         global update_index_cp ui_status_value
1655         global file_states current_diff_path
1656
1657         if {$update_index_cp >= $totalCnt} {
1658                 close $fd
1659                 unlock_index
1660                 uplevel #0 $after
1661                 return
1662         }
1663
1664         for {set i $batch} \
1665                 {$update_index_cp < $totalCnt && $i > 0} \
1666                 {incr i -1} {
1667                 set path [lindex $pathList $update_index_cp]
1668                 incr update_index_cp
1669
1670                 switch -glob -- [lindex $file_states($path) 0] {
1671                 AD {set new __}
1672                 ?D {set new D_}
1673                 _O -
1674                 AM {set new A_}
1675                 U? {
1676                         if {[file exists $path]} {
1677                                 set new M_
1678                         } else {
1679                                 set new D_
1680                         }
1681                 }
1682                 ?M {set new M_}
1683                 ?? {continue}
1684                 }
1685                 puts -nonewline $fd "[encoding convertto $path]\0"
1686                 display_file $path $new
1687         }
1688
1689         set ui_status_value [format \
1690                 "$msg... %i/%i files (%.2f%%)" \
1691                 $update_index_cp \
1692                 $totalCnt \
1693                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1694 }
1695
1696 proc checkout_index {msg pathList after} {
1697         global update_index_cp ui_status_value
1698
1699         if {![lock_index update]} return
1700
1701         set update_index_cp 0
1702         set pathList [lsort $pathList]
1703         set totalCnt [llength $pathList]
1704         set batch [expr {int($totalCnt * .01) + 1}]
1705         if {$batch > 25} {set batch 25}
1706
1707         set ui_status_value [format \
1708                 "$msg... %i/%i files (%.2f%%)" \
1709                 $update_index_cp \
1710                 $totalCnt \
1711                 0.0]
1712         set cmd [list git checkout-index]
1713         lappend cmd --index
1714         lappend cmd --quiet
1715         lappend cmd --force
1716         lappend cmd -z
1717         lappend cmd --stdin
1718         set fd [open "| $cmd " w]
1719         fconfigure $fd \
1720                 -blocking 0 \
1721                 -buffering full \
1722                 -buffersize 512 \
1723                 -encoding binary \
1724                 -translation binary
1725         fileevent $fd writable [list \
1726                 write_checkout_index \
1727                 $fd \
1728                 $pathList \
1729                 $totalCnt \
1730                 $batch \
1731                 $msg \
1732                 $after \
1733                 ]
1734 }
1735
1736 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1737         global update_index_cp ui_status_value
1738         global file_states current_diff_path
1739
1740         if {$update_index_cp >= $totalCnt} {
1741                 close $fd
1742                 unlock_index
1743                 uplevel #0 $after
1744                 return
1745         }
1746
1747         for {set i $batch} \
1748                 {$update_index_cp < $totalCnt && $i > 0} \
1749                 {incr i -1} {
1750                 set path [lindex $pathList $update_index_cp]
1751                 incr update_index_cp
1752                 switch -glob -- [lindex $file_states($path) 0] {
1753                 U? {continue}
1754                 ?M -
1755                 ?D {
1756                         puts -nonewline $fd "[encoding convertto $path]\0"
1757                         display_file $path ?_
1758                 }
1759                 }
1760         }
1761
1762         set ui_status_value [format \
1763                 "$msg... %i/%i files (%.2f%%)" \
1764                 $update_index_cp \
1765                 $totalCnt \
1766                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1767 }
1768
1769 ######################################################################
1770 ##
1771 ## branch management
1772
1773 proc is_tracking_branch {name} {
1774         global tracking_branches
1775
1776         if {![catch {set info $tracking_branches($name)}]} {
1777                 return 1
1778         }
1779         foreach t [array names tracking_branches] {
1780                 if {[string match {*/\*} $t] && [string match $t $name]} {
1781                         return 1
1782                 }
1783         }
1784         return 0
1785 }
1786
1787 proc load_all_heads {} {
1788         global all_heads
1789
1790         set all_heads [list]
1791         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1792         while {[gets $fd line] > 0} {
1793                 if {[is_tracking_branch $line]} continue
1794                 if {![regsub ^refs/heads/ $line {} name]} continue
1795                 lappend all_heads $name
1796         }
1797         close $fd
1798
1799         set all_heads [lsort $all_heads]
1800 }
1801
1802 proc populate_branch_menu {} {
1803         global all_heads disable_on_lock
1804
1805         set m .mbar.branch
1806         set last [$m index last]
1807         for {set i 0} {$i <= $last} {incr i} {
1808                 if {[$m type $i] eq {separator}} {
1809                         $m delete $i last
1810                         set new_dol [list]
1811                         foreach a $disable_on_lock {
1812                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1813                                         lappend new_dol $a
1814                                 }
1815                         }
1816                         set disable_on_lock $new_dol
1817                         break
1818                 }
1819         }
1820
1821         if {$all_heads ne {}} {
1822                 $m add separator
1823         }
1824         foreach b $all_heads {
1825                 $m add radiobutton \
1826                         -label $b \
1827                         -command [list switch_branch $b] \
1828                         -variable current_branch \
1829                         -value $b \
1830                         -font font_ui
1831                 lappend disable_on_lock \
1832                         [list $m entryconf [$m index last] -state]
1833         }
1834 }
1835
1836 proc all_tracking_branches {} {
1837         global tracking_branches
1838
1839         set all_trackings {}
1840         set cmd {}
1841         foreach name [array names tracking_branches] {
1842                 if {[regsub {/\*$} $name {} name]} {
1843                         lappend cmd $name
1844                 } else {
1845                         regsub ^refs/(heads|remotes)/ $name {} name
1846                         lappend all_trackings $name
1847                 }
1848         }
1849
1850         if {$cmd ne {}} {
1851                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1852                 while {[gets $fd name] > 0} {
1853                         regsub ^refs/(heads|remotes)/ $name {} name
1854                         lappend all_trackings $name
1855                 }
1856                 close $fd
1857         }
1858
1859         return [lsort -unique $all_trackings]
1860 }
1861
1862 proc do_create_branch_action {w} {
1863         global all_heads null_sha1 repo_config
1864         global create_branch_checkout create_branch_revtype
1865         global create_branch_head create_branch_trackinghead
1866         global create_branch_name create_branch_revexp
1867
1868         set newbranch $create_branch_name
1869         if {$newbranch eq {}
1870                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1871                 tk_messageBox \
1872                         -icon error \
1873                         -type ok \
1874                         -title [wm title $w] \
1875                         -parent $w \
1876                         -message "Please supply a branch name."
1877                 focus $w.desc.name_t
1878                 return
1879         }
1880         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1881                 tk_messageBox \
1882                         -icon error \
1883                         -type ok \
1884                         -title [wm title $w] \
1885                         -parent $w \
1886                         -message "Branch '$newbranch' already exists."
1887                 focus $w.desc.name_t
1888                 return
1889         }
1890         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1891                 tk_messageBox \
1892                         -icon error \
1893                         -type ok \
1894                         -title [wm title $w] \
1895                         -parent $w \
1896                         -message "We do not like '$newbranch' as a branch name."
1897                 focus $w.desc.name_t
1898                 return
1899         }
1900
1901         set rev {}
1902         switch -- $create_branch_revtype {
1903         head {set rev $create_branch_head}
1904         tracking {set rev $create_branch_trackinghead}
1905         expression {set rev $create_branch_revexp}
1906         }
1907         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1908                 tk_messageBox \
1909                         -icon error \
1910                         -type ok \
1911                         -title [wm title $w] \
1912                         -parent $w \
1913                         -message "Invalid starting revision: $rev"
1914                 return
1915         }
1916         set cmd [list git update-ref]
1917         lappend cmd -m
1918         lappend cmd "branch: Created from $rev"
1919         lappend cmd "refs/heads/$newbranch"
1920         lappend cmd $cmt
1921         lappend cmd $null_sha1
1922         if {[catch {eval exec $cmd} err]} {
1923                 tk_messageBox \
1924                         -icon error \
1925                         -type ok \
1926                         -title [wm title $w] \
1927                         -parent $w \
1928                         -message "Failed to create '$newbranch'.\n\n$err"
1929                 return
1930         }
1931
1932         lappend all_heads $newbranch
1933         set all_heads [lsort $all_heads]
1934         populate_branch_menu
1935         destroy $w
1936         if {$create_branch_checkout} {
1937                 switch_branch $newbranch
1938         }
1939 }
1940
1941 proc radio_selector {varname value args} {
1942         upvar #0 $varname var
1943         set var $value
1944 }
1945
1946 trace add variable create_branch_head write \
1947         [list radio_selector create_branch_revtype head]
1948 trace add variable create_branch_trackinghead write \
1949         [list radio_selector create_branch_revtype tracking]
1950
1951 trace add variable delete_branch_head write \
1952         [list radio_selector delete_branch_checktype head]
1953 trace add variable delete_branch_trackinghead write \
1954         [list radio_selector delete_branch_checktype tracking]
1955
1956 proc do_create_branch {} {
1957         global all_heads current_branch repo_config
1958         global create_branch_checkout create_branch_revtype
1959         global create_branch_head create_branch_trackinghead
1960         global create_branch_name create_branch_revexp
1961
1962         set w .branch_editor
1963         toplevel $w
1964         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965
1966         label $w.header -text {Create New Branch} \
1967                 -font font_uibold
1968         pack $w.header -side top -fill x
1969
1970         frame $w.buttons
1971         button $w.buttons.create -text Create \
1972                 -font font_ui \
1973                 -default active \
1974                 -command [list do_create_branch_action $w]
1975         pack $w.buttons.create -side right
1976         button $w.buttons.cancel -text {Cancel} \
1977                 -font font_ui \
1978                 -command [list destroy $w]
1979         pack $w.buttons.cancel -side right -padx 5
1980         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981
1982         labelframe $w.desc \
1983                 -text {Branch Description} \
1984                 -font font_ui
1985         label $w.desc.name_l -text {Name:} -font font_ui
1986         entry $w.desc.name_t \
1987                 -borderwidth 1 \
1988                 -relief sunken \
1989                 -width 40 \
1990                 -textvariable create_branch_name \
1991                 -font font_ui \
1992                 -validate key \
1993                 -validatecommand {
1994                         if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1995                         return 1
1996                 }
1997         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1998         grid columnconfigure $w.desc 1 -weight 1
1999         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2000
2001         labelframe $w.from \
2002                 -text {Starting Revision} \
2003                 -font font_ui
2004         radiobutton $w.from.head_r \
2005                 -text {Local Branch:} \
2006                 -value head \
2007                 -variable create_branch_revtype \
2008                 -font font_ui
2009         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2010         grid $w.from.head_r $w.from.head_m -sticky w
2011         set all_trackings [all_tracking_branches]
2012         if {$all_trackings ne {}} {
2013                 set create_branch_trackinghead [lindex $all_trackings 0]
2014                 radiobutton $w.from.tracking_r \
2015                         -text {Tracking Branch:} \
2016                         -value tracking \
2017                         -variable create_branch_revtype \
2018                         -font font_ui
2019                 eval tk_optionMenu $w.from.tracking_m \
2020                         create_branch_trackinghead \
2021                         $all_trackings
2022                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2023         }
2024         radiobutton $w.from.exp_r \
2025                 -text {Revision Expression:} \
2026                 -value expression \
2027                 -variable create_branch_revtype \
2028                 -font font_ui
2029         entry $w.from.exp_t \
2030                 -borderwidth 1 \
2031                 -relief sunken \
2032                 -width 50 \
2033                 -textvariable create_branch_revexp \
2034                 -font font_ui \
2035                 -validate key \
2036                 -validatecommand {
2037                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2038                         if {%d == 1 && [string length %S] > 0} {
2039                                 set create_branch_revtype expression
2040                         }
2041                         return 1
2042                 }
2043         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044         grid columnconfigure $w.from 1 -weight 1
2045         pack $w.from -anchor nw -fill x -pady 5 -padx 5
2046
2047         labelframe $w.postActions \
2048                 -text {Post Creation Actions} \
2049                 -font font_ui
2050         checkbutton $w.postActions.checkout \
2051                 -text {Checkout after creation} \
2052                 -variable create_branch_checkout \
2053                 -font font_ui
2054         pack $w.postActions.checkout -anchor nw
2055         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2056
2057         set create_branch_checkout 1
2058         set create_branch_head $current_branch
2059         set create_branch_revtype head
2060         set create_branch_name $repo_config(gui.newbranchtemplate)
2061         set create_branch_revexp {}
2062
2063         bind $w <Visibility> "
2064                 grab $w
2065                 $w.desc.name_t icursor end
2066                 focus $w.desc.name_t
2067         "
2068         bind $w <Key-Escape> "destroy $w"
2069         bind $w <Key-Return> "do_create_branch_action $w;break"
2070         wm title $w "[appname] ([reponame]): Create Branch"
2071         tkwait window $w
2072 }
2073
2074 proc do_delete_branch_action {w} {
2075         global all_heads
2076         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2077
2078         set check_rev {}
2079         switch -- $delete_branch_checktype {
2080         head {set check_rev $delete_branch_head}
2081         tracking {set check_rev $delete_branch_trackinghead}
2082         always {set check_rev {:none}}
2083         }
2084         if {$check_rev eq {:none}} {
2085                 set check_cmt {}
2086         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2087                 tk_messageBox \
2088                         -icon error \
2089                         -type ok \
2090                         -title [wm title $w] \
2091                         -parent $w \
2092                         -message "Invalid check revision: $check_rev"
2093                 return
2094         }
2095
2096         set to_delete [list]
2097         set not_merged [list]
2098         foreach i [$w.list.l curselection] {
2099                 set b [$w.list.l get $i]
2100                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2101                 if {$check_cmt ne {}} {
2102                         if {$b eq $check_rev} continue
2103                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2104                         if {$o ne $m} {
2105                                 lappend not_merged $b
2106                                 continue
2107                         }
2108                 }
2109                 lappend to_delete [list $b $o]
2110         }
2111         if {$not_merged ne {}} {
2112                 set msg "The following branches are not completely merged into $check_rev:
2113
2114  - [join $not_merged "\n - "]"
2115                 tk_messageBox \
2116                         -icon info \
2117                         -type ok \
2118                         -title [wm title $w] \
2119                         -parent $w \
2120                         -message $msg
2121         }
2122         if {$to_delete eq {}} return
2123         if {$delete_branch_checktype eq {always}} {
2124                 set msg {Recovering deleted branches is difficult.
2125
2126 Delete the selected branches?}
2127                 if {[tk_messageBox \
2128                         -icon warning \
2129                         -type yesno \
2130                         -title [wm title $w] \
2131                         -parent $w \
2132                         -message $msg] ne yes} {
2133                         return
2134                 }
2135         }
2136
2137         set failed {}
2138         foreach i $to_delete {
2139                 set b [lindex $i 0]
2140                 set o [lindex $i 1]
2141                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2142                         append failed " - $b: $err\n"
2143                 } else {
2144                         set x [lsearch -sorted -exact $all_heads $b]
2145                         if {$x >= 0} {
2146                                 set all_heads [lreplace $all_heads $x $x]
2147                         }
2148                 }
2149         }
2150
2151         if {$failed ne {}} {
2152                 tk_messageBox \
2153                         -icon error \
2154                         -type ok \
2155                         -title [wm title $w] \
2156                         -parent $w \
2157                         -message "Failed to delete branches:\n$failed"
2158         }
2159
2160         set all_heads [lsort $all_heads]
2161         populate_branch_menu
2162         destroy $w
2163 }
2164
2165 proc do_delete_branch {} {
2166         global all_heads tracking_branches current_branch
2167         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2168
2169         set w .branch_editor
2170         toplevel $w
2171         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2172
2173         label $w.header -text {Delete Local Branch} \
2174                 -font font_uibold
2175         pack $w.header -side top -fill x
2176
2177         frame $w.buttons
2178         button $w.buttons.create -text Delete \
2179                 -font font_ui \
2180                 -command [list do_delete_branch_action $w]
2181         pack $w.buttons.create -side right
2182         button $w.buttons.cancel -text {Cancel} \
2183                 -font font_ui \
2184                 -command [list destroy $w]
2185         pack $w.buttons.cancel -side right -padx 5
2186         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2187
2188         labelframe $w.list \
2189                 -text {Local Branches} \
2190                 -font font_ui
2191         listbox $w.list.l \
2192                 -height 10 \
2193                 -width 70 \
2194                 -selectmode extended \
2195                 -yscrollcommand [list $w.list.sby set] \
2196                 -font font_ui
2197         foreach h $all_heads {
2198                 if {$h ne $current_branch} {
2199                         $w.list.l insert end $h
2200                 }
2201         }
2202         scrollbar $w.list.sby -command [list $w.list.l yview]
2203         pack $w.list.sby -side right -fill y
2204         pack $w.list.l -side left -fill both -expand 1
2205         pack $w.list -fill both -expand 1 -pady 5 -padx 5
2206
2207         labelframe $w.validate \
2208                 -text {Delete Only If} \
2209                 -font font_ui
2210         radiobutton $w.validate.head_r \
2211                 -text {Merged Into Local Branch:} \
2212                 -value head \
2213                 -variable delete_branch_checktype \
2214                 -font font_ui
2215         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2216         grid $w.validate.head_r $w.validate.head_m -sticky w
2217         set all_trackings [all_tracking_branches]
2218         if {$all_trackings ne {}} {
2219                 set delete_branch_trackinghead [lindex $all_trackings 0]
2220                 radiobutton $w.validate.tracking_r \
2221                         -text {Merged Into Tracking Branch:} \
2222                         -value tracking \
2223                         -variable delete_branch_checktype \
2224                         -font font_ui
2225                 eval tk_optionMenu $w.validate.tracking_m \
2226                         delete_branch_trackinghead \
2227                         $all_trackings
2228                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2229         }
2230         radiobutton $w.validate.always_r \
2231                 -text {Always (Do not perform merge checks)} \
2232                 -value always \
2233                 -variable delete_branch_checktype \
2234                 -font font_ui
2235         grid $w.validate.always_r -columnspan 2 -sticky w
2236         grid columnconfigure $w.validate 1 -weight 1
2237         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2238
2239         set delete_branch_head $current_branch
2240         set delete_branch_checktype head
2241
2242         bind $w <Visibility> "grab $w; focus $w"
2243         bind $w <Key-Escape> "destroy $w"
2244         wm title $w "[appname] ([reponame]): Delete Branch"
2245         tkwait window $w
2246 }
2247
2248 proc switch_branch {new_branch} {
2249         global HEAD commit_type current_branch repo_config
2250
2251         if {![lock_index switch]} return
2252
2253         # -- Our in memory state should match the repository.
2254         #
2255         repository_state curType curHEAD curMERGE_HEAD
2256         if {[string match amend* $commit_type]
2257                 && $curType eq {normal}
2258                 && $curHEAD eq $HEAD} {
2259         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2260                 info_popup {Last scanned state does not match repository state.
2261
2262 Another Git program has modified this repository
2263 since the last scan.  A rescan must be performed
2264 before the current branch can be changed.
2265
2266 The rescan will be automatically started now.
2267 }
2268                 unlock_index
2269                 rescan {set ui_status_value {Ready.}}
2270                 return
2271         }
2272
2273         # -- Don't do a pointless switch.
2274         #
2275         if {$current_branch eq $new_branch} {
2276                 unlock_index
2277                 return
2278         }
2279
2280         if {$repo_config(gui.trustmtime) eq {true}} {
2281                 switch_branch_stage2 {} $new_branch
2282         } else {
2283                 set ui_status_value {Refreshing file status...}
2284                 set cmd [list git update-index]
2285                 lappend cmd -q
2286                 lappend cmd --unmerged
2287                 lappend cmd --ignore-missing
2288                 lappend cmd --refresh
2289                 set fd_rf [open "| $cmd" r]
2290                 fconfigure $fd_rf -blocking 0 -translation binary
2291                 fileevent $fd_rf readable \
2292                         [list switch_branch_stage2 $fd_rf $new_branch]
2293         }
2294 }
2295
2296 proc switch_branch_stage2 {fd_rf new_branch} {
2297         global ui_status_value HEAD
2298
2299         if {$fd_rf ne {}} {
2300                 read $fd_rf
2301                 if {![eof $fd_rf]} return
2302                 close $fd_rf
2303         }
2304
2305         set ui_status_value "Updating working directory to '$new_branch'..."
2306         set cmd [list git read-tree]
2307         lappend cmd -m
2308         lappend cmd -u
2309         lappend cmd --exclude-per-directory=.gitignore
2310         lappend cmd $HEAD
2311         lappend cmd $new_branch
2312         set fd_rt [open "| $cmd" r]
2313         fconfigure $fd_rt -blocking 0 -translation binary
2314         fileevent $fd_rt readable \
2315                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2316 }
2317
2318 proc switch_branch_readtree_wait {fd_rt new_branch} {
2319         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2320         global current_branch
2321         global ui_comm ui_status_value
2322
2323         # -- We never get interesting output on stdout; only stderr.
2324         #
2325         read $fd_rt
2326         fconfigure $fd_rt -blocking 1
2327         if {![eof $fd_rt]} {
2328                 fconfigure $fd_rt -blocking 0
2329                 return
2330         }
2331
2332         # -- The working directory wasn't in sync with the index and
2333         #    we'd have to overwrite something to make the switch. A
2334         #    merge is required.
2335         #
2336         if {[catch {close $fd_rt} err]} {
2337                 regsub {^fatal: } $err {} err
2338                 warn_popup "File level merge required.
2339
2340 $err
2341
2342 Staying on branch '$current_branch'."
2343                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2344                 unlock_index
2345                 return
2346         }
2347
2348         # -- Update the symbolic ref.  Core git doesn't even check for failure
2349         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2350         #    state that is difficult to recover from within git-gui.
2351         #
2352         if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2353                 error_popup "Failed to set current branch.
2354
2355 This working directory is only partially switched.
2356 We successfully updated your files, but failed to
2357 update an internal Git file.
2358
2359 This should not have occurred.  [appname] will now
2360 close and give up.
2361
2362 $err"
2363                 do_quit
2364                 return
2365         }
2366
2367         # -- Update our repository state.  If we were previously in amend mode
2368         #    we need to toss the current buffer and do a full rescan to update
2369         #    our file lists.  If we weren't in amend mode our file lists are
2370         #    accurate and we can avoid the rescan.
2371         #
2372         unlock_index
2373         set selected_commit_type new
2374         if {[string match amend* $commit_type]} {
2375                 $ui_comm delete 0.0 end
2376                 $ui_comm edit reset
2377                 $ui_comm edit modified false
2378                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2379         } else {
2380                 repository_state commit_type HEAD MERGE_HEAD
2381                 set PARENT $HEAD
2382                 set ui_status_value "Checked out branch '$current_branch'."
2383         }
2384 }
2385
2386 ######################################################################
2387 ##
2388 ## remote management
2389
2390 proc load_all_remotes {} {
2391         global repo_config
2392         global all_remotes tracking_branches
2393
2394         set all_remotes [list]
2395         array unset tracking_branches
2396
2397         set rm_dir [gitdir remotes]
2398         if {[file isdirectory $rm_dir]} {
2399                 set all_remotes [glob \
2400                         -types f \
2401                         -tails \
2402                         -nocomplain \
2403                         -directory $rm_dir *]
2404
2405                 foreach name $all_remotes {
2406                         catch {
2407                                 set fd [open [file join $rm_dir $name] r]
2408                                 while {[gets $fd line] >= 0} {
2409                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2410                                                 $line line src dst]} continue
2411                                         if {![regexp ^refs/ $dst]} {
2412                                                 set dst "refs/heads/$dst"
2413                                         }
2414                                         set tracking_branches($dst) [list $name $src]
2415                                 }
2416                                 close $fd
2417                         }
2418                 }
2419         }
2420
2421         foreach line [array names repo_config remote.*.url] {
2422                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2423                 lappend all_remotes $name
2424
2425                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2426                         set fl {}
2427                 }
2428                 foreach line $fl {
2429                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2430                         if {![regexp ^refs/ $dst]} {
2431                                 set dst "refs/heads/$dst"
2432                         }
2433                         set tracking_branches($dst) [list $name $src]
2434                 }
2435         }
2436
2437         set all_remotes [lsort -unique $all_remotes]
2438 }
2439
2440 proc populate_fetch_menu {} {
2441         global all_remotes repo_config
2442
2443         set m .mbar.fetch
2444         foreach r $all_remotes {
2445                 set enable 0
2446                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2447                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2448                                 set enable 1
2449                         }
2450                 } else {
2451                         catch {
2452                                 set fd [open [gitdir remotes $r] r]
2453                                 while {[gets $fd n] >= 0} {
2454                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2455                                                 set enable 1
2456                                                 break
2457                                         }
2458                                 }
2459                                 close $fd
2460                         }
2461                 }
2462
2463                 if {$enable} {
2464                         $m add command \
2465                                 -label "Fetch from $r..." \
2466                                 -command [list fetch_from $r] \
2467                                 -font font_ui
2468                 }
2469         }
2470 }
2471
2472 proc populate_push_menu {} {
2473         global all_remotes repo_config
2474
2475         set m .mbar.push
2476         set fast_count 0
2477         foreach r $all_remotes {
2478                 set enable 0
2479                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2480                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2481                                 set enable 1
2482                         }
2483                 } else {
2484                         catch {
2485                                 set fd [open [gitdir remotes $r] r]
2486                                 while {[gets $fd n] >= 0} {
2487                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2488                                                 set enable 1
2489                                                 break
2490                                         }
2491                                 }
2492                                 close $fd
2493                         }
2494                 }
2495
2496                 if {$enable} {
2497                         if {!$fast_count} {
2498                                 $m add separator
2499                         }
2500                         $m add command \
2501                                 -label "Push to $r..." \
2502                                 -command [list push_to $r] \
2503                                 -font font_ui
2504                         incr fast_count
2505                 }
2506         }
2507 }
2508
2509 proc start_push_anywhere_action {w} {
2510         global push_urltype push_remote push_url push_thin push_tags
2511
2512         set r_url {}
2513         switch -- $push_urltype {
2514         remote {set r_url $push_remote}
2515         url {set r_url $push_url}
2516         }
2517         if {$r_url eq {}} return
2518
2519         set cmd [list git push]
2520         lappend cmd -v
2521         if {$push_thin} {
2522                 lappend cmd --thin
2523         }
2524         if {$push_tags} {
2525                 lappend cmd --tags
2526         }
2527         lappend cmd $r_url
2528         set cnt 0
2529         foreach i [$w.source.l curselection] {
2530                 set b [$w.source.l get $i]
2531                 lappend cmd "refs/heads/$b:refs/heads/$b"
2532                 incr cnt
2533         }
2534         if {$cnt == 0} {
2535                 return
2536         } elseif {$cnt == 1} {
2537                 set unit branch
2538         } else {
2539                 set unit branches
2540         }
2541
2542         set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2543         console_exec $cons $cmd console_done
2544         destroy $w
2545 }
2546
2547 trace add variable push_remote write \
2548         [list radio_selector push_urltype remote]
2549
2550 proc do_push_anywhere {} {
2551         global all_heads all_remotes current_branch
2552         global push_urltype push_remote push_url push_thin push_tags
2553
2554         set w .push_setup
2555         toplevel $w
2556         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2557
2558         label $w.header -text {Push Branches} -font font_uibold
2559         pack $w.header -side top -fill x
2560
2561         frame $w.buttons
2562         button $w.buttons.create -text Push \
2563                 -font font_ui \
2564                 -command [list start_push_anywhere_action $w]
2565         pack $w.buttons.create -side right
2566         button $w.buttons.cancel -text {Cancel} \
2567                 -font font_ui \
2568                 -command [list destroy $w]
2569         pack $w.buttons.cancel -side right -padx 5
2570         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2571
2572         labelframe $w.source \
2573                 -text {Source Branches} \
2574                 -font font_ui
2575         listbox $w.source.l \
2576                 -height 10 \
2577                 -width 70 \
2578                 -selectmode extended \
2579                 -yscrollcommand [list $w.source.sby set] \
2580                 -font font_ui
2581         foreach h $all_heads {
2582                 $w.source.l insert end $h
2583                 if {$h eq $current_branch} {
2584                         $w.source.l select set end
2585                 }
2586         }
2587         scrollbar $w.source.sby -command [list $w.source.l yview]
2588         pack $w.source.sby -side right -fill y
2589         pack $w.source.l -side left -fill both -expand 1
2590         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2591
2592         labelframe $w.dest \
2593                 -text {Destination Repository} \
2594                 -font font_ui
2595         if {$all_remotes ne {}} {
2596                 radiobutton $w.dest.remote_r \
2597                         -text {Remote:} \
2598                         -value remote \
2599                         -variable push_urltype \
2600                         -font font_ui
2601                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2602                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2603                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2604                         set push_remote origin
2605                 } else {
2606                         set push_remote [lindex $all_remotes 0]
2607                 }
2608                 set push_urltype remote
2609         } else {
2610                 set push_urltype url
2611         }
2612         radiobutton $w.dest.url_r \
2613                 -text {Arbitrary URL:} \
2614                 -value url \
2615                 -variable push_urltype \
2616                 -font font_ui
2617         entry $w.dest.url_t \
2618                 -borderwidth 1 \
2619                 -relief sunken \
2620                 -width 50 \
2621                 -textvariable push_url \
2622                 -font font_ui \
2623                 -validate key \
2624                 -validatecommand {
2625                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2626                         if {%d == 1 && [string length %S] > 0} {
2627                                 set push_urltype url
2628                         }
2629                         return 1
2630                 }
2631         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2632         grid columnconfigure $w.dest 1 -weight 1
2633         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2634
2635         labelframe $w.options \
2636                 -text {Transfer Options} \
2637                 -font font_ui
2638         checkbutton $w.options.thin \
2639                 -text {Use thin pack (for slow network connections)} \
2640                 -variable push_thin \
2641                 -font font_ui
2642         grid $w.options.thin -columnspan 2 -sticky w
2643         checkbutton $w.options.tags \
2644                 -text {Include tags} \
2645                 -variable push_tags \
2646                 -font font_ui
2647         grid $w.options.tags -columnspan 2 -sticky w
2648         grid columnconfigure $w.options 1 -weight 1
2649         pack $w.options -anchor nw -fill x -pady 5 -padx 5
2650
2651         set push_url {}
2652         set push_thin 0
2653         set push_tags 0
2654
2655         bind $w <Visibility> "grab $w"
2656         bind $w <Key-Escape> "destroy $w"
2657         wm title $w "[appname] ([reponame]): Push"
2658         tkwait window $w
2659 }
2660
2661 ######################################################################
2662 ##
2663 ## merge
2664
2665 proc can_merge {} {
2666         global HEAD commit_type file_states
2667
2668         if {[string match amend* $commit_type]} {
2669                 info_popup {Cannot merge while amending.
2670
2671 You must finish amending this commit before
2672 starting any type of merge.
2673 }
2674                 return 0
2675         }
2676
2677         if {[committer_ident] eq {}} {return 0}
2678         if {![lock_index merge]} {return 0}
2679
2680         # -- Our in memory state should match the repository.
2681         #
2682         repository_state curType curHEAD curMERGE_HEAD
2683         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2684                 info_popup {Last scanned state does not match repository state.
2685
2686 Another Git program has modified this repository
2687 since the last scan.  A rescan must be performed
2688 before a merge can be performed.
2689
2690 The rescan will be automatically started now.
2691 }
2692                 unlock_index
2693                 rescan {set ui_status_value {Ready.}}
2694                 return 0
2695         }
2696
2697         foreach path [array names file_states] {
2698                 switch -glob -- [lindex $file_states($path) 0] {
2699                 _O {
2700                         continue; # and pray it works!
2701                 }
2702                 U? {
2703                         error_popup "You are in the middle of a conflicted merge.
2704
2705 File [short_path $path] has merge conflicts.
2706
2707 You must resolve them, add the file, and commit to
2708 complete the current merge.  Only then can you
2709 begin another merge.
2710 "
2711                         unlock_index
2712                         return 0
2713                 }
2714                 ?? {
2715                         error_popup "You are in the middle of a change.
2716
2717 File [short_path $path] is modified.
2718
2719 You should complete the current commit before
2720 starting a merge.  Doing so will help you abort
2721 a failed merge, should the need arise.
2722 "
2723                         unlock_index
2724                         return 0
2725                 }
2726                 }
2727         }
2728
2729         return 1
2730 }
2731
2732 proc visualize_local_merge {w} {
2733         set revs {}
2734         foreach i [$w.source.l curselection] {
2735                 lappend revs [$w.source.l get $i]
2736         }
2737         if {$revs eq {}} return
2738         lappend revs --not HEAD
2739         do_gitk $revs
2740 }
2741
2742 proc start_local_merge_action {w} {
2743         global HEAD ui_status_value current_branch
2744
2745         set cmd [list git merge]
2746         set names {}
2747         set revcnt 0
2748         foreach i [$w.source.l curselection] {
2749                 set b [$w.source.l get $i]
2750                 lappend cmd $b
2751                 lappend names $b
2752                 incr revcnt
2753         }
2754
2755         if {$revcnt == 0} {
2756                 return
2757         } elseif {$revcnt == 1} {
2758                 set unit branch
2759         } elseif {$revcnt <= 15} {
2760                 set unit branches
2761         } else {
2762                 tk_messageBox \
2763                         -icon error \
2764                         -type ok \
2765                         -title [wm title $w] \
2766                         -parent $w \
2767                         -message "Too many branches selected.
2768
2769 You have requested to merge $revcnt branches
2770 in an octopus merge.  This exceeds Git's
2771 internal limit of 15 branches per merge.
2772
2773 Please select fewer branches.  To merge more
2774 than 15 branches, merge the branches in batches.
2775 "
2776                 return
2777         }
2778
2779         set msg "Merging $current_branch, [join $names {, }]"
2780         set ui_status_value "$msg..."
2781         set cons [new_console "Merge" $msg]
2782         console_exec $cons $cmd [list finish_merge $revcnt]
2783         bind $w <Destroy> {}
2784         destroy $w
2785 }
2786
2787 proc finish_merge {revcnt w ok} {
2788         console_done $w $ok
2789         if {$ok} {
2790                 set msg {Merge completed successfully.}
2791         } else {
2792                 if {$revcnt != 1} {
2793                         info_popup "Octopus merge failed.
2794
2795 Your merge of $revcnt branches has failed.
2796
2797 There are file-level conflicts between the
2798 branches which must be resolved manually.
2799
2800 The working directory will now be reset.
2801
2802 You can attempt this merge again
2803 by merging only one branch at a time." $w
2804
2805                         set fd [open "| git read-tree --reset -u HEAD" r]
2806                         fconfigure $fd -blocking 0 -translation binary
2807                         fileevent $fd readable [list reset_hard_wait $fd]
2808                         set ui_status_value {Aborting... please wait...}
2809                         return
2810                 }
2811
2812                 set msg {Merge failed.  Conflict resolution is required.}
2813         }
2814         unlock_index
2815         rescan [list set ui_status_value $msg]
2816 }
2817
2818 proc do_local_merge {} {
2819         global current_branch
2820
2821         if {![can_merge]} return
2822
2823         set w .merge_setup
2824         toplevel $w
2825         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2826
2827         label $w.header \
2828                 -text "Merge Into $current_branch" \
2829                 -font font_uibold
2830         pack $w.header -side top -fill x
2831
2832         frame $w.buttons
2833         button $w.buttons.visualize -text Visualize \
2834                 -font font_ui \
2835                 -command [list visualize_local_merge $w]
2836         pack $w.buttons.visualize -side left
2837         button $w.buttons.create -text Merge \
2838                 -font font_ui \
2839                 -command [list start_local_merge_action $w]
2840         pack $w.buttons.create -side right
2841         button $w.buttons.cancel -text {Cancel} \
2842                 -font font_ui \
2843                 -command [list destroy $w]
2844         pack $w.buttons.cancel -side right -padx 5
2845         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2846
2847         labelframe $w.source \
2848                 -text {Source Branches} \
2849                 -font font_ui
2850         listbox $w.source.l \
2851                 -height 10 \
2852                 -width 70 \
2853                 -selectmode extended \
2854                 -yscrollcommand [list $w.source.sby set] \
2855                 -font font_ui
2856         scrollbar $w.source.sby -command [list $w.source.l yview]
2857         pack $w.source.sby -side right -fill y
2858         pack $w.source.l -side left -fill both -expand 1
2859         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2860
2861         set cmd [list git for-each-ref]
2862         lappend cmd {--format=%(objectname) %(refname)}
2863         lappend cmd refs/heads
2864         lappend cmd refs/remotes
2865         set fr_fd [open "| $cmd" r]
2866         fconfigure $fr_fd -translation binary
2867         while {[gets $fr_fd line] > 0} {
2868                 set line [split $line { }]
2869                 set sha1([lindex $line 0]) [lindex $line 1]
2870         }
2871         close $fr_fd
2872
2873         set to_show {}
2874         set fr_fd [open "| git rev-list --all --not HEAD"]
2875         while {[gets $fr_fd line] > 0} {
2876                 if {[catch {set ref $sha1($line)}]} continue
2877                 regsub ^refs/(heads|remotes)/ $ref {} ref
2878                 lappend to_show $ref
2879         }
2880         close $fr_fd
2881
2882         foreach ref [lsort -unique $to_show] {
2883                 $w.source.l insert end $ref
2884         }
2885
2886         bind $w <Visibility> "grab $w"
2887         bind $w <Key-Escape> "unlock_index;destroy $w"
2888         bind $w <Destroy> unlock_index
2889         wm title $w "[appname] ([reponame]): Merge"
2890         tkwait window $w
2891 }
2892
2893 proc do_reset_hard {} {
2894         global HEAD commit_type file_states
2895
2896         if {[string match amend* $commit_type]} {
2897                 info_popup {Cannot abort while amending.
2898
2899 You must finish amending this commit.
2900 }
2901                 return
2902         }
2903
2904         if {![lock_index abort]} return
2905
2906         if {[string match *merge* $commit_type]} {
2907                 set op merge
2908         } else {
2909                 set op commit
2910         }
2911
2912         if {[ask_popup "Abort $op?
2913
2914 Aborting the current $op will cause
2915 *ALL* uncommitted changes to be lost.
2916
2917 Continue with aborting the current $op?"] eq {yes}} {
2918                 set fd [open "| git read-tree --reset -u HEAD" r]
2919                 fconfigure $fd -blocking 0 -translation binary
2920                 fileevent $fd readable [list reset_hard_wait $fd]
2921                 set ui_status_value {Aborting... please wait...}
2922         } else {
2923                 unlock_index
2924         }
2925 }
2926
2927 proc reset_hard_wait {fd} {
2928         global ui_comm
2929
2930         read $fd
2931         if {[eof $fd]} {
2932                 close $fd
2933                 unlock_index
2934
2935                 $ui_comm delete 0.0 end
2936                 $ui_comm edit modified false
2937
2938                 catch {file delete [gitdir MERGE_HEAD]}
2939                 catch {file delete [gitdir rr-cache MERGE_RR]}
2940                 catch {file delete [gitdir SQUASH_MSG]}
2941                 catch {file delete [gitdir MERGE_MSG]}
2942                 catch {file delete [gitdir GITGUI_MSG]}
2943
2944                 rescan {set ui_status_value {Abort completed.  Ready.}}
2945         }
2946 }
2947
2948 ######################################################################
2949 ##
2950 ## browser
2951
2952 set next_browser_id 0
2953
2954 proc new_browser {commit} {
2955         global next_browser_id cursor_ptr
2956         global browser_commit browser_status browser_stack browser_path browser_busy
2957
2958         set w .browser[incr next_browser_id]
2959         set w_list $w.list.l
2960         set browser_commit($w_list) $commit
2961         set browser_status($w_list) {Starting...}
2962         set browser_stack($w_list) {}
2963         set browser_path($w_list) $browser_commit($w_list):
2964         set browser_busy($w_list) 1
2965
2966         toplevel $w
2967         label $w.path -textvariable browser_path($w_list) \
2968                 -anchor w \
2969                 -justify left \
2970                 -borderwidth 1 \
2971                 -relief sunken \
2972                 -font font_uibold
2973         pack $w.path -anchor w -side top -fill x
2974
2975         frame $w.list
2976         text $w_list -background white -borderwidth 0 \
2977                 -cursor $cursor_ptr \
2978                 -state disabled \
2979                 -wrap none \
2980                 -height 20 \
2981                 -width 70 \
2982                 -xscrollcommand [list $w.list.sbx set] \
2983                 -yscrollcommand [list $w.list.sby set] \
2984                 -font font_ui
2985         $w_list tag conf in_sel \
2986                 -background [$w_list cget -foreground] \
2987                 -foreground [$w_list cget -background]
2988         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2989         scrollbar $w.list.sby -orient v -command [list $w_list yview]
2990         pack $w.list.sbx -side bottom -fill x
2991         pack $w.list.sby -side right -fill y
2992         pack $w_list -side left -fill both -expand 1
2993         pack $w.list -side top -fill both -expand 1
2994
2995         label $w.status -textvariable browser_status($w_list) \
2996                 -anchor w \
2997                 -justify left \
2998                 -borderwidth 1 \
2999                 -relief sunken \
3000                 -font font_ui
3001         pack $w.status -anchor w -side bottom -fill x
3002
3003         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3004         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3005
3006         bind $w <Visibility> "focus $w"
3007         bind $w <Destroy> "
3008                 array unset browser_buffer $w_list
3009                 array unset browser_files $w_list
3010                 array unset browser_status $w_list
3011                 array unset browser_stack $w_list
3012                 array unset browser_path $w_list
3013                 array unset browser_commit $w_list
3014                 array unset browser_busy $w_list
3015         "
3016         wm title $w "[appname] ([reponame]): File Browser"
3017         ls_tree $w_list $browser_commit($w_list) {}
3018 }
3019
3020 proc browser_click {was_double_click w pos} {
3021         global browser_files browser_status browser_path
3022         global browser_commit browser_stack browser_busy
3023
3024         if {$browser_busy($w)} return
3025         set lno [lindex [split [$w index $pos] .] 0]
3026         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3027
3028         $w conf -state normal
3029         $w tag remove sel 0.0 end
3030         $w tag remove in_sel 0.0 end
3031         if {$info ne {}} {
3032                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3033                 if {$was_double_click} {
3034                         switch -- [lindex $info 0] {
3035                         parent {
3036                                 set parent [lindex $browser_stack($w) end-1]
3037                                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3038                                 if {$browser_stack($w) eq {}} {
3039                                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3040                                 } else {
3041                                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3042                                 }
3043                                 set browser_status($w) "Loading $browser_path($w)..."
3044                                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3045                         }
3046                         tree {
3047                                 set name [lindex $info 2]
3048                                 set escn [escape_path $name]
3049                                 set browser_status($w) "Loading $escn..."
3050                                 append browser_path($w) $escn
3051                                 ls_tree $w [lindex $info 1] $name
3052                         }
3053                         blob {
3054                                 set name [lindex $info 2]
3055                                 set p {}
3056                                 foreach n $browser_stack($w) {
3057                                         append p [lindex $n 1]
3058                                 }
3059                                 append p $name
3060                                 show_blame $browser_commit($w) $p
3061                         }
3062                         }
3063                 }
3064         }
3065         $w conf -state disabled
3066 }
3067
3068 proc ls_tree {w tree_id name} {
3069         global browser_buffer browser_files browser_stack browser_busy
3070
3071         set browser_buffer($w) {}
3072         set browser_files($w) {}
3073         set browser_busy($w) 1
3074
3075         $w conf -state normal
3076         $w tag remove in_sel 0.0 end
3077         $w tag remove sel 0.0 end
3078         $w delete 0.0 end
3079         if {$browser_stack($w) ne {}} {
3080                 $w image create end \
3081                         -align center -padx 5 -pady 1 \
3082                         -name icon0 \
3083                         -image file_uplevel
3084                 $w insert end {[Up To Parent]}
3085                 lappend browser_files($w) parent
3086         }
3087         lappend browser_stack($w) [list $tree_id $name]
3088         $w conf -state disabled
3089
3090         set cmd [list git ls-tree -z $tree_id]
3091         set fd [open "| $cmd" r]
3092         fconfigure $fd -blocking 0 -translation binary -encoding binary
3093         fileevent $fd readable [list read_ls_tree $fd $w]
3094 }
3095
3096 proc read_ls_tree {fd w} {
3097         global browser_buffer browser_files browser_status browser_busy
3098
3099         if {![winfo exists $w]} {
3100                 catch {close $fd}
3101                 return
3102         }
3103
3104         append browser_buffer($w) [read $fd]
3105         set pck [split $browser_buffer($w) "\0"]
3106         set browser_buffer($w) [lindex $pck end]
3107
3108         set n [llength $browser_files($w)]
3109         $w conf -state normal
3110         foreach p [lrange $pck 0 end-1] {
3111                 set info [split $p "\t"]
3112                 set path [lindex $info 1]
3113                 set info [split [lindex $info 0] { }]
3114                 set type [lindex $info 1]
3115                 set object [lindex $info 2]
3116
3117                 switch -- $type {
3118                 blob {
3119                         set image file_mod
3120                 }
3121                 tree {
3122                         set image file_dir
3123                         append path /
3124                 }
3125                 default {
3126                         set image file_question
3127                 }
3128                 }
3129
3130                 if {$n > 0} {$w insert end "\n"}
3131                 $w image create end \
3132                         -align center -padx 5 -pady 1 \
3133                         -name icon[incr n] \
3134                         -image $image
3135                 $w insert end [escape_path $path]
3136                 lappend browser_files($w) [list $type $object $path]
3137         }
3138         $w conf -state disabled
3139
3140         if {[eof $fd]} {
3141                 close $fd
3142                 set browser_status($w) Ready.
3143                 set browser_busy($w) 0
3144                 array unset browser_buffer $w
3145         }
3146 }
3147
3148 proc show_blame {commit path} {
3149         global next_browser_id blame_status blame_data
3150
3151         set w .browser[incr next_browser_id]
3152         set blame_status($w) {Loading current file content...}
3153         set texts [list]
3154
3155         toplevel $w
3156         panedwindow $w.out -orient horizontal
3157
3158         label $w.path -text "$commit:$path" \
3159                 -anchor w \
3160                 -justify left \
3161                 -borderwidth 1 \
3162                 -relief sunken \
3163                 -font font_uibold
3164         pack $w.path -anchor w -side top -fill x
3165
3166         set hbg #e2effa
3167         frame $w.out.commit -width 10 -height 10
3168         label $w.out.commit.l -text Commit \
3169                 -background $hbg \
3170                 -font font_uibold
3171         text $w.out.commit.t \
3172                 -background white -borderwidth 0 \
3173                 -state disabled \
3174                 -wrap none \
3175                 -height 40 \
3176                 -width 9 \
3177                 -font font_diff
3178         pack $w.out.commit.l -side top -fill x
3179         pack $w.out.commit.t -fill both
3180         $w.out add $w.out.commit
3181         lappend texts $w.out.commit.t
3182
3183         frame $w.out.author -width 10 -height 10
3184         label $w.out.author.l -text Author \
3185                 -background $hbg \
3186                 -font font_uibold
3187         text $w.out.author.t \
3188                 -background white -borderwidth 0 \
3189                 -state disabled \
3190                 -wrap none \
3191                 -height 40 \
3192                 -width 20 \
3193                 -font font_diff
3194         pack $w.out.author.l -side top -fill x
3195         pack $w.out.author.t -fill both
3196         $w.out add $w.out.author
3197         lappend texts $w.out.author.t
3198
3199         frame $w.out.date -width 10 -height 10
3200         label $w.out.date.l -text Date \
3201                 -background $hbg \
3202                 -font font_uibold
3203         text $w.out.date.t \
3204                 -background white -borderwidth 0 \
3205                 -state disabled \
3206                 -wrap none \
3207                 -height 40 \
3208                 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3209                 -font font_diff
3210         pack $w.out.date.l -side top -fill x
3211         pack $w.out.date.t -fill both
3212         $w.out add $w.out.date
3213         lappend texts $w.out.date.t
3214
3215         frame $w.out.filename -width 10 -height 10
3216         label $w.out.filename.l -text Filename \
3217                 -background $hbg \
3218                 -font font_uibold
3219         text $w.out.filename.t \
3220                 -background white -borderwidth 0 \
3221                 -state disabled \
3222                 -wrap none \
3223                 -height 40 \
3224                 -width 20 \
3225                 -font font_diff
3226         pack $w.out.filename.l -side top -fill x
3227         pack $w.out.filename.t -fill both
3228         $w.out add $w.out.filename
3229         lappend texts $w.out.filename.t
3230
3231         frame $w.out.origlinenumber -width 10 -height 10
3232         label $w.out.origlinenumber.l -text {Orig Line} \
3233                 -background $hbg \
3234                 -font font_uibold
3235         text $w.out.origlinenumber.t \
3236                 -background white -borderwidth 0 \
3237                 -state disabled \
3238                 -wrap none \
3239                 -height 40 \
3240                 -width 5 \
3241                 -font font_diff
3242         $w.out.origlinenumber.t tag conf linenumber -justify right
3243         pack $w.out.origlinenumber.l -side top -fill x
3244         pack $w.out.origlinenumber.t -fill both
3245         $w.out add $w.out.origlinenumber
3246         lappend texts $w.out.origlinenumber.t
3247
3248         frame $w.out.linenumber -width 10 -height 10
3249         label $w.out.linenumber.l -text {Curr Line} \
3250                 -background $hbg \
3251                 -font font_uibold
3252         text $w.out.linenumber.t \
3253                 -background white -borderwidth 0 \
3254                 -state disabled \
3255                 -wrap none \
3256                 -height 40 \
3257                 -width 5 \
3258                 -font font_diff
3259         $w.out.linenumber.t tag conf linenumber -justify right
3260         pack $w.out.linenumber.l -side top -fill x
3261         pack $w.out.linenumber.t -fill both
3262         $w.out add $w.out.linenumber
3263         lappend texts $w.out.linenumber.t
3264
3265         frame $w.out.file -width 10 -height 10
3266         label $w.out.file.l -text {File Content} \
3267                 -background $hbg \
3268                 -font font_uibold
3269         text $w.out.file.t \
3270                 -background white -borderwidth 0 \
3271                 -state disabled \
3272                 -wrap none \
3273                 -height 40 \
3274                 -width 80 \
3275                 -font font_diff
3276         pack $w.out.file.l -side top -fill x
3277         pack $w.out.file.t -fill both
3278         $w.out add $w.out.file
3279         lappend texts $w.out.file.t
3280
3281         label $w.status -textvariable blame_status($w) \
3282                 -anchor w \
3283                 -justify left \
3284                 -borderwidth 1 \
3285                 -relief sunken \
3286                 -font font_ui
3287         pack $w.status -anchor w -side bottom -fill x
3288
3289         scrollbar $w.sby -orient v \
3290                 -command [list scrollbar2many $texts yview]
3291         pack $w.sby -side right -fill y
3292         pack $w.out -side left -fill both -expand 1
3293
3294         menu $w.ctxm -tearoff 0
3295         $w.ctxm add command -label "Copy Commit" \
3296                 -font font_ui \
3297                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3298
3299         foreach i $texts {
3300                 $i tag conf in_sel \
3301                         -background [$i cget -foreground] \
3302                         -foreground [$i cget -background]
3303                 $i conf -yscrollcommand \
3304                         [list many2scrollbar $texts yview $w.sby]
3305                 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3306                 bind_button3 $i "
3307                         set cursorX %x
3308                         set cursorY %y
3309                         set cursorW %W
3310                         tk_popup $w.ctxm %X %Y
3311                 "
3312         }
3313
3314         bind $w <Visibility> "focus $w"
3315         bind $w <Destroy> "
3316                 array unset blame_status $w
3317                 array unset blame_data $w,*
3318         "
3319         wm title $w "[appname] ([reponame]): File Viewer"
3320
3321         set blame_data($w,total_lines) 0
3322         set cmd [list git cat-file blob "$commit:$path"]
3323         set fd [open "| $cmd" r]
3324         fconfigure $fd -blocking 0 -translation lf -encoding binary
3325         fileevent $fd readable [list read_blame_catfile \
3326                 $fd $w $commit $path \
3327                 $texts $w.out.linenumber.t $w.out.file.t]
3328 }
3329
3330 proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3331         global blame_status blame_data
3332
3333         if {![winfo exists $w_file]} {
3334                 catch {close $fd}
3335                 return
3336         }
3337
3338         set n $blame_data($w,total_lines)
3339         foreach i $texts {$i conf -state normal}
3340         while {[gets $fd line] >= 0} {
3341                 regsub "\r\$" $line {} line
3342                 incr n
3343                 $w_lno insert end $n linenumber
3344                 $w_file insert end $line
3345                 foreach i $texts {$i insert end "\n"}
3346         }
3347         foreach i $texts {$i conf -state disabled}
3348         set blame_data($w,total_lines) $n
3349
3350         if {[eof $fd]} {
3351                 close $fd
3352                 set blame_status($w) {Loading annotations...}
3353                 set cmd [list git blame -M -C --incremental]
3354                 lappend cmd $commit -- $path
3355                 set fd [open "| $cmd" r]
3356                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3357                 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3358         }
3359 }
3360
3361 proc read_blame_incremental {fd w
3362         w_commit w_author w_date w_filename w_olno
3363         w_lno w_file} {
3364         global blame_status blame_data
3365
3366         if {![winfo exists $w_commit]} {
3367                 catch {close $fd}
3368                 return
3369         }
3370
3371         $w_commit conf -state normal
3372         $w_author conf -state normal
3373         $w_date conf -state normal
3374         $w_filename conf -state normal
3375         $w_olno conf -state normal
3376
3377         while {[gets $fd line] >= 0} {
3378                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3379                         commit original_line final_line line_count]} {
3380                         set blame_data($w,commit) $commit
3381                         set blame_data($w,original_line) $original_line
3382                         set blame_data($w,final_line) $final_line
3383                         set blame_data($w,line_count) $line_count
3384                 } elseif {[string match {filename *} $line]} {
3385                         set n $blame_data($w,line_count)
3386                         set lno $blame_data($w,final_line)
3387                         set ol $blame_data($w,original_line)
3388                         set file [string range $line 9 end]
3389                         set commit $blame_data($w,commit)
3390                         set abbrev [string range $commit 0 8]
3391
3392                         if {[catch {set author $blame_data($w,$commit,author)} err]} {
3393                         puts $err
3394                                 set author {}
3395                         }
3396
3397                         if {[catch {set atime $blame_data($w,$commit,author-time)}]} {
3398                                 set atime {}
3399                         } else {
3400                                 set atime [clock format $atime -format {%Y-%m-%d %T}]
3401                         }
3402
3403                         while {$n > 0} {
3404                                 $w_commit delete $lno.0 "$lno.0 lineend"
3405                                 $w_author delete $lno.0 "$lno.0 lineend"
3406                                 $w_date delete $lno.0 "$lno.0 lineend"
3407                                 $w_filename delete $lno.0 "$lno.0 lineend"
3408                                 $w_olno delete $lno.0 "$lno.0 lineend"
3409
3410                                 $w_commit insert $lno.0 $abbrev
3411                                 $w_author insert $lno.0 $author
3412                                 $w_date insert $lno.0 $atime
3413                                 $w_filename insert $lno.0 $file
3414                                 $w_olno insert $lno.0 $ol linenumber
3415
3416                                 set blame_data($w,line$lno,commit) $commit
3417
3418                                 incr n -1
3419                                 incr lno
3420                                 incr ol
3421                         }
3422                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3423                         set blame_data($w,$blame_data($w,commit),$header) $data
3424                 }
3425         }
3426
3427         $w_commit conf -state disabled
3428         $w_author conf -state disabled
3429         $w_date conf -state disabled
3430         $w_filename conf -state disabled
3431         $w_olno conf -state disabled
3432
3433         if {[eof $fd]} {
3434                 close $fd
3435                 set blame_status($w) {Annotation complete.}
3436         }
3437 }
3438
3439 proc blame_highlight {w pos args} {
3440         set lno [lindex [split [$w index $pos] .] 0]
3441         foreach i $args {
3442                 $i tag remove in_sel 0.0 end
3443         }
3444         if {$lno eq {}} return
3445         foreach i $args {
3446                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3447         }
3448 }
3449
3450 proc blame_copycommit {w i pos} {
3451         global blame_data
3452         set lno [lindex [split [$i index $pos] .] 0]
3453         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3454                 clipboard clear
3455                 clipboard append \
3456                         -format STRING \
3457                         -type STRING \
3458                         -- $commit
3459         }
3460 }
3461
3462 ######################################################################
3463 ##
3464 ## icons
3465
3466 set filemask {
3467 #define mask_width 14
3468 #define mask_height 15
3469 static unsigned char mask_bits[] = {
3470    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3471    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3472    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3473 }
3474
3475 image create bitmap file_plain -background white -foreground black -data {
3476 #define plain_width 14
3477 #define plain_height 15
3478 static unsigned char plain_bits[] = {
3479    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3480    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3481    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3482 } -maskdata $filemask
3483
3484 image create bitmap file_mod -background white -foreground blue -data {
3485 #define mod_width 14
3486 #define mod_height 15
3487 static unsigned char mod_bits[] = {
3488    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3489    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3490    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3491 } -maskdata $filemask
3492
3493 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3494 #define file_fulltick_width 14
3495 #define file_fulltick_height 15
3496 static unsigned char file_fulltick_bits[] = {
3497    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3498    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3499    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3500 } -maskdata $filemask
3501
3502 image create bitmap file_parttick -background white -foreground "#005050" -data {
3503 #define parttick_width 14
3504 #define parttick_height 15
3505 static unsigned char parttick_bits[] = {
3506    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3507    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3508    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3509 } -maskdata $filemask
3510
3511 image create bitmap file_question -background white -foreground black -data {
3512 #define file_question_width 14
3513 #define file_question_height 15
3514 static unsigned char file_question_bits[] = {
3515    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3516    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3517    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3518 } -maskdata $filemask
3519
3520 image create bitmap file_removed -background white -foreground red -data {
3521 #define file_removed_width 14
3522 #define file_removed_height 15
3523 static unsigned char file_removed_bits[] = {
3524    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3525    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3526    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3527 } -maskdata $filemask
3528
3529 image create bitmap file_merge -background white -foreground blue -data {
3530 #define file_merge_width 14
3531 #define file_merge_height 15
3532 static unsigned char file_merge_bits[] = {
3533    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3534    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3535    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3536 } -maskdata $filemask
3537
3538 set file_dir_data {
3539 #define file_width 18
3540 #define file_height 18
3541 static unsigned char file_bits[] = {
3542   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3543   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3544   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3545   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3546   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3547 }
3548 image create bitmap file_dir -background white -foreground blue \
3549         -data $file_dir_data -maskdata $file_dir_data
3550 unset file_dir_data
3551
3552 set file_uplevel_data {
3553 #define up_width 15
3554 #define up_height 15
3555 static unsigned char up_bits[] = {
3556   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3557   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3558   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3559 }
3560 image create bitmap file_uplevel -background white -foreground red \
3561         -data $file_uplevel_data -maskdata $file_uplevel_data
3562 unset file_uplevel_data
3563
3564 set ui_index .vpane.files.index.list
3565 set ui_workdir .vpane.files.workdir.list
3566
3567 set all_icons(_$ui_index)   file_plain
3568 set all_icons(A$ui_index)   file_fulltick
3569 set all_icons(M$ui_index)   file_fulltick
3570 set all_icons(D$ui_index)   file_removed
3571 set all_icons(U$ui_index)   file_merge
3572
3573 set all_icons(_$ui_workdir) file_plain
3574 set all_icons(M$ui_workdir) file_mod
3575 set all_icons(D$ui_workdir) file_question
3576 set all_icons(U$ui_workdir) file_merge
3577 set all_icons(O$ui_workdir) file_plain
3578
3579 set max_status_desc 0
3580 foreach i {
3581                 {__ "Unmodified"}
3582
3583                 {_M "Modified, not staged"}
3584                 {M_ "Staged for commit"}
3585                 {MM "Portions staged for commit"}
3586                 {MD "Staged for commit, missing"}
3587
3588                 {_O "Untracked, not staged"}
3589                 {A_ "Staged for commit"}
3590                 {AM "Portions staged for commit"}
3591                 {AD "Staged for commit, missing"}
3592
3593                 {_D "Missing"}
3594                 {D_ "Staged for removal"}
3595                 {DO "Staged for removal, still present"}
3596
3597                 {U_ "Requires merge resolution"}
3598                 {UU "Requires merge resolution"}
3599                 {UM "Requires merge resolution"}
3600                 {UD "Requires merge resolution"}
3601         } {
3602         if {$max_status_desc < [string length [lindex $i 1]]} {
3603                 set max_status_desc [string length [lindex $i 1]]
3604         }
3605         set all_descs([lindex $i 0]) [lindex $i 1]
3606 }
3607 unset i
3608
3609 ######################################################################
3610 ##
3611 ## util
3612
3613 proc bind_button3 {w cmd} {
3614         bind $w <Any-Button-3> $cmd
3615         if {[is_MacOSX]} {
3616                 bind $w <Control-Button-1> $cmd
3617         }
3618 }
3619
3620 proc scrollbar2many {list mode args} {
3621         foreach w $list {eval $w $mode $args}
3622 }
3623
3624 proc many2scrollbar {list mode sb top bottom} {
3625         $sb set $top $bottom
3626         foreach w $list {$w $mode moveto $top}
3627 }
3628
3629 proc incr_font_size {font {amt 1}} {
3630         set sz [font configure $font -size]
3631         incr sz $amt
3632         font configure $font -size $sz
3633         font configure ${font}bold -size $sz
3634 }
3635
3636 proc hook_failed_popup {hook msg} {
3637         set w .hookfail
3638         toplevel $w
3639
3640         frame $w.m
3641         label $w.m.l1 -text "$hook hook failed:" \
3642                 -anchor w \
3643                 -justify left \
3644                 -font font_uibold
3645         text $w.m.t \
3646                 -background white -borderwidth 1 \
3647                 -relief sunken \
3648                 -width 80 -height 10 \
3649                 -font font_diff \
3650                 -yscrollcommand [list $w.m.sby set]
3651         label $w.m.l2 \
3652                 -text {You must correct the above errors before committing.} \
3653                 -anchor w \
3654                 -justify left \
3655                 -font font_uibold
3656         scrollbar $w.m.sby -command [list $w.m.t yview]
3657         pack $w.m.l1 -side top -fill x
3658         pack $w.m.l2 -side bottom -fill x
3659         pack $w.m.sby -side right -fill y
3660         pack $w.m.t -side left -fill both -expand 1
3661         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3662
3663         $w.m.t insert 1.0 $msg
3664         $w.m.t conf -state disabled
3665
3666         button $w.ok -text OK \
3667                 -width 15 \
3668                 -font font_ui \
3669                 -command "destroy $w"
3670         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3671
3672         bind $w <Visibility> "grab $w; focus $w"
3673         bind $w <Key-Return> "destroy $w"
3674         wm title $w "[appname] ([reponame]): error"
3675         tkwait window $w
3676 }
3677
3678 set next_console_id 0
3679
3680 proc new_console {short_title long_title} {
3681         global next_console_id console_data
3682         set w .console[incr next_console_id]
3683         set console_data($w) [list $short_title $long_title]
3684         return [console_init $w]
3685 }
3686
3687 proc console_init {w} {
3688         global console_cr console_data M1B
3689
3690         set console_cr($w) 1.0
3691         toplevel $w
3692         frame $w.m
3693         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3694                 -anchor w \
3695                 -justify left \
3696                 -font font_uibold
3697         text $w.m.t \
3698                 -background white -borderwidth 1 \
3699                 -relief sunken \
3700                 -width 80 -height 10 \
3701                 -font font_diff \
3702                 -state disabled \
3703                 -yscrollcommand [list $w.m.sby set]
3704         label $w.m.s -text {Working... please wait...} \
3705                 -anchor w \
3706                 -justify left \
3707                 -font font_uibold
3708         scrollbar $w.m.sby -command [list $w.m.t yview]
3709         pack $w.m.l1 -side top -fill x
3710         pack $w.m.s -side bottom -fill x
3711         pack $w.m.sby -side right -fill y
3712         pack $w.m.t -side left -fill both -expand 1
3713         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3714
3715         menu $w.ctxm -tearoff 0
3716         $w.ctxm add command -label "Copy" \
3717                 -font font_ui \
3718                 -command "tk_textCopy $w.m.t"
3719         $w.ctxm add command -label "Select All" \
3720                 -font font_ui \
3721                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3722         $w.ctxm add command -label "Copy All" \
3723                 -font font_ui \
3724                 -command "
3725                         $w.m.t tag add sel 0.0 end
3726                         tk_textCopy $w.m.t
3727                         $w.m.t tag remove sel 0.0 end
3728                 "
3729
3730         button $w.ok -text {Close} \
3731                 -font font_ui \
3732                 -state disabled \
3733                 -command "destroy $w"
3734         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3735
3736         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3737         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3738         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3739         bind $w <Visibility> "focus $w"
3740         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3741         return $w
3742 }
3743
3744 proc console_exec {w cmd after} {
3745         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3746         #    But most users need that so we have to relogin. :-(
3747         #
3748         if {[is_Cygwin]} {
3749                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3750         }
3751
3752         # -- Tcl won't let us redirect both stdout and stderr to
3753         #    the same pipe.  So pass it through cat...
3754         #
3755         set cmd [concat | $cmd |& cat]
3756
3757         set fd_f [open $cmd r]
3758         fconfigure $fd_f -blocking 0 -translation binary
3759         fileevent $fd_f readable [list console_read $w $fd_f $after]
3760 }
3761
3762 proc console_read {w fd after} {
3763         global console_cr
3764
3765         set buf [read $fd]
3766         if {$buf ne {}} {
3767                 if {![winfo exists $w]} {console_init $w}
3768                 $w.m.t conf -state normal
3769                 set c 0
3770                 set n [string length $buf]
3771                 while {$c < $n} {
3772                         set cr [string first "\r" $buf $c]
3773                         set lf [string first "\n" $buf $c]
3774                         if {$cr < 0} {set cr [expr {$n + 1}]}
3775                         if {$lf < 0} {set lf [expr {$n + 1}]}
3776
3777                         if {$lf < $cr} {
3778                                 $w.m.t insert end [string range $buf $c $lf]
3779                                 set console_cr($w) [$w.m.t index {end -1c}]
3780                                 set c $lf
3781                                 incr c
3782                         } else {
3783                                 $w.m.t delete $console_cr($w) end
3784                                 $w.m.t insert end "\n"
3785                                 $w.m.t insert end [string range $buf $c $cr]
3786                                 set c $cr
3787                                 incr c
3788                         }
3789                 }
3790                 $w.m.t conf -state disabled
3791                 $w.m.t see end
3792         }
3793
3794         fconfigure $fd -blocking 1
3795         if {[eof $fd]} {
3796                 if {[catch {close $fd}]} {
3797                         set ok 0
3798                 } else {
3799                         set ok 1
3800                 }
3801                 uplevel #0 $after $w $ok
3802                 return
3803         }
3804         fconfigure $fd -blocking 0
3805 }
3806
3807 proc console_chain {cmdlist w {ok 1}} {
3808         if {$ok} {
3809                 if {[llength $cmdlist] == 0} {
3810                         console_done $w $ok
3811                         return
3812                 }
3813
3814                 set cmd [lindex $cmdlist 0]
3815                 set cmdlist [lrange $cmdlist 1 end]
3816
3817                 if {[lindex $cmd 0] eq {console_exec}} {
3818                         console_exec $w \
3819                                 [lindex $cmd 1] \
3820                                 [list console_chain $cmdlist]
3821                 } else {
3822                         uplevel #0 $cmd $cmdlist $w $ok
3823                 }
3824         } else {
3825                 console_done $w $ok
3826         }
3827 }
3828
3829 proc console_done {args} {
3830         global console_cr console_data
3831
3832         switch -- [llength $args] {
3833         2 {
3834                 set w [lindex $args 0]
3835                 set ok [lindex $args 1]
3836         }
3837         3 {
3838                 set w [lindex $args 1]
3839                 set ok [lindex $args 2]
3840         }
3841         default {
3842                 error "wrong number of args: console_done ?ignored? w ok"
3843         }
3844         }
3845
3846         if {$ok} {
3847                 if {[winfo exists $w]} {
3848                         $w.m.s conf -background green -text {Success}
3849                         $w.ok conf -state normal
3850                 }
3851         } else {
3852                 if {![winfo exists $w]} {
3853                         console_init $w
3854                 }
3855                 $w.m.s conf -background red -text {Error: Command Failed}
3856                 $w.ok conf -state normal
3857         }
3858
3859         array unset console_cr $w
3860         array unset console_data $w
3861 }
3862
3863 ######################################################################
3864 ##
3865 ## ui commands
3866
3867 set starting_gitk_msg {Starting gitk... please wait...}
3868
3869 proc do_gitk {revs} {
3870         global env ui_status_value starting_gitk_msg
3871
3872         # -- On Windows gitk is severly broken, and right now it seems like
3873         #    nobody cares about fixing it.  The only known workaround is to
3874         #    always delete ~/.gitk before starting the program.
3875         #
3876         if {[is_Windows]} {
3877                 catch {file delete [file join $env(HOME) .gitk]}
3878         }
3879
3880         # -- Always start gitk through whatever we were loaded with.  This
3881         #    lets us bypass using shell process on Windows systems.
3882         #
3883         set cmd [info nameofexecutable]
3884         lappend cmd [gitexec gitk]
3885         if {$revs ne {}} {
3886                 append cmd { }
3887                 append cmd $revs
3888         }
3889
3890         if {[catch {eval exec $cmd &} err]} {
3891                 error_popup "Failed to start gitk:\n\n$err"
3892         } else {
3893                 set ui_status_value $starting_gitk_msg
3894                 after 10000 {
3895                         if {$ui_status_value eq $starting_gitk_msg} {
3896                                 set ui_status_value {Ready.}
3897                         }
3898                 }
3899         }
3900 }
3901
3902 proc do_stats {} {
3903         set fd [open "| git count-objects -v" r]
3904         while {[gets $fd line] > 0} {
3905                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3906                         set stats($name) $value
3907                 }
3908         }
3909         close $fd
3910
3911         set packed_sz 0
3912         foreach p [glob -directory [gitdir objects pack] \
3913                 -type f \
3914                 -nocomplain -- *] {
3915                 incr packed_sz [file size $p]
3916         }
3917         if {$packed_sz > 0} {
3918                 set stats(size-pack) [expr {$packed_sz / 1024}]
3919         }
3920
3921         set w .stats_view
3922         toplevel $w
3923         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3924
3925         label $w.header -text {Database Statistics} \
3926                 -font font_uibold
3927         pack $w.header -side top -fill x
3928
3929         frame $w.buttons -border 1
3930         button $w.buttons.close -text Close \
3931                 -font font_ui \
3932                 -command [list destroy $w]
3933         button $w.buttons.gc -text {Compress Database} \
3934                 -font font_ui \
3935                 -command "destroy $w;do_gc"
3936         pack $w.buttons.close -side right
3937         pack $w.buttons.gc -side left
3938         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3939
3940         frame $w.stat -borderwidth 1 -relief solid
3941         foreach s {
3942                 {count           {Number of loose objects}}
3943                 {size            {Disk space used by loose objects} { KiB}}
3944                 {in-pack         {Number of packed objects}}
3945                 {packs           {Number of packs}}
3946                 {size-pack       {Disk space used by packed objects} { KiB}}
3947                 {prune-packable  {Packed objects waiting for pruning}}
3948                 {garbage         {Garbage files}}
3949                 } {
3950                 set name [lindex $s 0]
3951                 set label [lindex $s 1]
3952                 if {[catch {set value $stats($name)}]} continue
3953                 if {[llength $s] > 2} {
3954                         set value "$value[lindex $s 2]"
3955                 }
3956
3957                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3958                 label $w.stat.v_$name -text $value -anchor w -font font_ui
3959                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3960         }
3961         pack $w.stat -pady 10 -padx 10
3962
3963         bind $w <Visibility> "grab $w; focus $w"
3964         bind $w <Key-Escape> [list destroy $w]
3965         bind $w <Key-Return> [list destroy $w]
3966         wm title $w "[appname] ([reponame]): Database Statistics"
3967         tkwait window $w
3968 }
3969
3970 proc do_gc {} {
3971         set w [new_console {gc} {Compressing the object database}]
3972         console_chain {
3973                 {console_exec {git pack-refs --prune}}
3974                 {console_exec {git reflog expire --all}}
3975                 {console_exec {git repack -a -d -l}}
3976                 {console_exec {git rerere gc}}
3977         } $w
3978 }
3979
3980 proc do_fsck_objects {} {
3981         set w [new_console {fsck-objects} \
3982                 {Verifying the object database with fsck-objects}]
3983         set cmd [list git fsck-objects]
3984         lappend cmd --full
3985         lappend cmd --cache
3986         lappend cmd --strict
3987         console_exec $w $cmd console_done
3988 }
3989
3990 set is_quitting 0
3991
3992 proc do_quit {} {
3993         global ui_comm is_quitting repo_config commit_type
3994
3995         if {$is_quitting} return
3996         set is_quitting 1
3997
3998         # -- Stash our current commit buffer.
3999         #
4000         set save [gitdir GITGUI_MSG]
4001         set msg [string trim [$ui_comm get 0.0 end]]
4002         regsub -all -line {[ \r\t]+$} $msg {} msg
4003         if {(![string match amend* $commit_type]
4004                 || [$ui_comm edit modified])
4005                 && $msg ne {}} {
4006                 catch {
4007                         set fd [open $save w]
4008                         puts -nonewline $fd $msg
4009                         close $fd
4010                 }
4011         } else {
4012                 catch {file delete $save}
4013         }
4014
4015         # -- Stash our current window geometry into this repository.
4016         #
4017         set cfg_geometry [list]
4018         lappend cfg_geometry [wm geometry .]
4019         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4020         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4021         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4022                 set rc_geometry {}
4023         }
4024         if {$cfg_geometry ne $rc_geometry} {
4025                 catch {exec git repo-config gui.geometry $cfg_geometry}
4026         }
4027
4028         destroy .
4029 }
4030
4031 proc do_rescan {} {
4032         rescan {set ui_status_value {Ready.}}
4033 }
4034
4035 proc unstage_helper {txt paths} {
4036         global file_states current_diff_path
4037
4038         if {![lock_index begin-update]} return
4039
4040         set pathList [list]
4041         set after {}
4042         foreach path $paths {
4043                 switch -glob -- [lindex $file_states($path) 0] {
4044                 A? -
4045                 M? -
4046                 D? {
4047                         lappend pathList $path
4048                         if {$path eq $current_diff_path} {
4049                                 set after {reshow_diff;}
4050                         }
4051                 }
4052                 }
4053         }
4054         if {$pathList eq {}} {
4055                 unlock_index
4056         } else {
4057                 update_indexinfo \
4058                         $txt \
4059                         $pathList \
4060                         [concat $after {set ui_status_value {Ready.}}]
4061         }
4062 }
4063
4064 proc do_unstage_selection {} {
4065         global current_diff_path selected_paths
4066
4067         if {[array size selected_paths] > 0} {
4068                 unstage_helper \
4069                         {Unstaging selected files from commit} \
4070                         [array names selected_paths]
4071         } elseif {$current_diff_path ne {}} {
4072                 unstage_helper \
4073                         "Unstaging [short_path $current_diff_path] from commit" \
4074                         [list $current_diff_path]
4075         }
4076 }
4077
4078 proc add_helper {txt paths} {
4079         global file_states current_diff_path
4080
4081         if {![lock_index begin-update]} return
4082
4083         set pathList [list]
4084         set after {}
4085         foreach path $paths {
4086                 switch -glob -- [lindex $file_states($path) 0] {
4087                 _O -
4088                 ?M -
4089                 ?D -
4090                 U? {
4091                         lappend pathList $path
4092                         if {$path eq $current_diff_path} {
4093                                 set after {reshow_diff;}
4094                         }
4095                 }
4096                 }
4097         }
4098         if {$pathList eq {}} {
4099                 unlock_index
4100         } else {
4101                 update_index \
4102                         $txt \
4103                         $pathList \
4104                         [concat $after {set ui_status_value {Ready to commit.}}]
4105         }
4106 }
4107
4108 proc do_add_selection {} {
4109         global current_diff_path selected_paths
4110
4111         if {[array size selected_paths] > 0} {
4112                 add_helper \
4113                         {Adding selected files} \
4114                         [array names selected_paths]
4115         } elseif {$current_diff_path ne {}} {
4116                 add_helper \
4117                         "Adding [short_path $current_diff_path]" \
4118                         [list $current_diff_path]
4119         }
4120 }
4121
4122 proc do_add_all {} {
4123         global file_states
4124
4125         set paths [list]
4126         foreach path [array names file_states] {
4127                 switch -glob -- [lindex $file_states($path) 0] {
4128                 U? {continue}
4129                 ?M -
4130                 ?D {lappend paths $path}
4131                 }
4132         }
4133         add_helper {Adding all changed files} $paths
4134 }
4135
4136 proc revert_helper {txt paths} {
4137         global file_states current_diff_path
4138
4139         if {![lock_index begin-update]} return
4140
4141         set pathList [list]
4142         set after {}
4143         foreach path $paths {
4144                 switch -glob -- [lindex $file_states($path) 0] {
4145                 U? {continue}
4146                 ?M -
4147                 ?D {
4148                         lappend pathList $path
4149                         if {$path eq $current_diff_path} {
4150                                 set after {reshow_diff;}
4151                         }
4152                 }
4153                 }
4154         }
4155
4156         set n [llength $pathList]
4157         if {$n == 0} {
4158                 unlock_index
4159                 return
4160         } elseif {$n == 1} {
4161                 set s "[short_path [lindex $pathList]]"
4162         } else {
4163                 set s "these $n files"
4164         }
4165
4166         set reply [tk_dialog \
4167                 .confirm_revert \
4168                 "[appname] ([reponame])" \
4169                 "Revert changes in $s?
4170
4171 Any unadded changes will be permanently lost by the revert." \
4172                 question \
4173                 1 \
4174                 {Do Nothing} \
4175                 {Revert Changes} \
4176                 ]
4177         if {$reply == 1} {
4178                 checkout_index \
4179                         $txt \
4180                         $pathList \
4181                         [concat $after {set ui_status_value {Ready.}}]
4182         } else {
4183                 unlock_index
4184         }
4185 }
4186
4187 proc do_revert_selection {} {
4188         global current_diff_path selected_paths
4189
4190         if {[array size selected_paths] > 0} {
4191                 revert_helper \
4192                         {Reverting selected files} \
4193                         [array names selected_paths]
4194         } elseif {$current_diff_path ne {}} {
4195                 revert_helper \
4196                         "Reverting [short_path $current_diff_path]" \
4197                         [list $current_diff_path]
4198         }
4199 }
4200
4201 proc do_signoff {} {
4202         global ui_comm
4203
4204         set me [committer_ident]
4205         if {$me eq {}} return
4206
4207         set sob "Signed-off-by: $me"
4208         set last [$ui_comm get {end -1c linestart} {end -1c}]
4209         if {$last ne $sob} {
4210                 $ui_comm edit separator
4211                 if {$last ne {}
4212                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4213                         $ui_comm insert end "\n"
4214                 }
4215                 $ui_comm insert end "\n$sob"
4216                 $ui_comm edit separator
4217                 $ui_comm see end
4218         }
4219 }
4220
4221 proc do_select_commit_type {} {
4222         global commit_type selected_commit_type
4223
4224         if {$selected_commit_type eq {new}
4225                 && [string match amend* $commit_type]} {
4226                 create_new_commit
4227         } elseif {$selected_commit_type eq {amend}
4228                 && ![string match amend* $commit_type]} {
4229                 load_last_commit
4230
4231                 # The amend request was rejected...
4232                 #
4233                 if {![string match amend* $commit_type]} {
4234                         set selected_commit_type new
4235                 }
4236         }
4237 }
4238
4239 proc do_commit {} {
4240         commit_tree
4241 }
4242
4243 proc do_about {} {
4244         global appvers copyright
4245         global tcl_patchLevel tk_patchLevel
4246
4247         set w .about_dialog
4248         toplevel $w
4249         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4250
4251         label $w.header -text "About [appname]" \
4252                 -font font_uibold
4253         pack $w.header -side top -fill x
4254
4255         frame $w.buttons
4256         button $w.buttons.close -text {Close} \
4257                 -font font_ui \
4258                 -command [list destroy $w]
4259         pack $w.buttons.close -side right
4260         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4261
4262         label $w.desc \
4263                 -text "[appname] - a commit creation tool for Git.
4264 $copyright" \
4265                 -padx 5 -pady 5 \
4266                 -justify left \
4267                 -anchor w \
4268                 -borderwidth 1 \
4269                 -relief solid \
4270                 -font font_ui
4271         pack $w.desc -side top -fill x -padx 5 -pady 5
4272
4273         set v {}
4274         append v "[appname] version $appvers\n"
4275         append v "[exec git version]\n"
4276         append v "\n"
4277         if {$tcl_patchLevel eq $tk_patchLevel} {
4278                 append v "Tcl/Tk version $tcl_patchLevel"
4279         } else {
4280                 append v "Tcl version $tcl_patchLevel"
4281                 append v ", Tk version $tk_patchLevel"
4282         }
4283
4284         label $w.vers \
4285                 -text $v \
4286                 -padx 5 -pady 5 \
4287                 -justify left \
4288                 -anchor w \
4289                 -borderwidth 1 \
4290                 -relief solid \
4291                 -font font_ui
4292         pack $w.vers -side top -fill x -padx 5 -pady 5
4293
4294         menu $w.ctxm -tearoff 0
4295         $w.ctxm add command \
4296                 -label {Copy} \
4297                 -font font_ui \
4298                 -command "
4299                 clipboard clear
4300                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4301         "
4302
4303         bind $w <Visibility> "grab $w; focus $w"
4304         bind $w <Key-Escape> "destroy $w"
4305         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4306         wm title $w "About [appname]"
4307         tkwait window $w
4308 }
4309
4310 proc do_options {} {
4311         global repo_config global_config font_descs
4312         global repo_config_new global_config_new
4313
4314         array unset repo_config_new
4315         array unset global_config_new
4316         foreach name [array names repo_config] {
4317                 set repo_config_new($name) $repo_config($name)
4318         }
4319         load_config 1
4320         foreach name [array names repo_config] {
4321                 switch -- $name {
4322                 gui.diffcontext {continue}
4323                 }
4324                 set repo_config_new($name) $repo_config($name)
4325         }
4326         foreach name [array names global_config] {
4327                 set global_config_new($name) $global_config($name)
4328         }
4329
4330         set w .options_editor
4331         toplevel $w
4332         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4333
4334         label $w.header -text "[appname] Options" \
4335                 -font font_uibold
4336         pack $w.header -side top -fill x
4337
4338         frame $w.buttons
4339         button $w.buttons.restore -text {Restore Defaults} \
4340                 -font font_ui \
4341                 -command do_restore_defaults
4342         pack $w.buttons.restore -side left
4343         button $w.buttons.save -text Save \
4344                 -font font_ui \
4345                 -command [list do_save_config $w]
4346         pack $w.buttons.save -side right
4347         button $w.buttons.cancel -text {Cancel} \
4348                 -font font_ui \
4349                 -command [list destroy $w]
4350         pack $w.buttons.cancel -side right -padx 5
4351         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4352
4353         labelframe $w.repo -text "[reponame] Repository" \
4354                 -font font_ui
4355         labelframe $w.global -text {Global (All Repositories)} \
4356                 -font font_ui
4357         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4358         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4359
4360         set optid 0
4361         foreach option {
4362                 {t user.name {User Name}}
4363                 {t user.email {Email Address}}
4364
4365                 {b merge.summary {Summarize Merge Commits}}
4366                 {i-1..5 merge.verbosity {Merge Verbosity}}
4367
4368                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4369                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4370                 {t gui.newbranchtemplate {New Branch Name Template}}
4371                 } {
4372                 set type [lindex $option 0]
4373                 set name [lindex $option 1]
4374                 set text [lindex $option 2]
4375                 incr optid
4376                 foreach f {repo global} {
4377                         switch -glob -- $type {
4378                         b {
4379                                 checkbutton $w.$f.$optid -text $text \
4380                                         -variable ${f}_config_new($name) \
4381                                         -onvalue true \
4382                                         -offvalue false \
4383                                         -font font_ui
4384                                 pack $w.$f.$optid -side top -anchor w
4385                         }
4386                         i-* {
4387                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4388                                 frame $w.$f.$optid
4389                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4390                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4391                                 spinbox $w.$f.$optid.v \
4392                                         -textvariable ${f}_config_new($name) \
4393                                         -from $min \
4394                                         -to $max \
4395                                         -increment 1 \
4396                                         -width [expr {1 + [string length $max]}] \
4397                                         -font font_ui
4398                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4399                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4400                                 pack $w.$f.$optid -side top -anchor w -fill x
4401                         }
4402                         t {
4403                                 frame $w.$f.$optid
4404                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4405                                 entry $w.$f.$optid.v \
4406                                         -borderwidth 1 \
4407                                         -relief sunken \
4408                                         -width 20 \
4409                                         -textvariable ${f}_config_new($name) \
4410                                         -font font_ui
4411                                 pack $w.$f.$optid.l -side left -anchor w
4412                                 pack $w.$f.$optid.v -side left -anchor w \
4413                                         -fill x -expand 1 \
4414                                         -padx 5
4415                                 pack $w.$f.$optid -side top -anchor w -fill x
4416                         }
4417                         }
4418                 }
4419         }
4420
4421         set all_fonts [lsort [font families]]
4422         foreach option $font_descs {
4423                 set name [lindex $option 0]
4424                 set font [lindex $option 1]
4425                 set text [lindex $option 2]
4426
4427                 set global_config_new(gui.$font^^family) \
4428                         [font configure $font -family]
4429                 set global_config_new(gui.$font^^size) \
4430                         [font configure $font -size]
4431
4432                 frame $w.global.$name
4433                 label $w.global.$name.l -text "$text:" -font font_ui
4434                 pack $w.global.$name.l -side left -anchor w -fill x
4435                 eval tk_optionMenu $w.global.$name.family \
4436                         global_config_new(gui.$font^^family) \
4437                         $all_fonts
4438                 spinbox $w.global.$name.size \
4439                         -textvariable global_config_new(gui.$font^^size) \
4440                         -from 2 -to 80 -increment 1 \
4441                         -width 3 \
4442                         -font font_ui
4443                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4444                 pack $w.global.$name.size -side right -anchor e
4445                 pack $w.global.$name.family -side right -anchor e
4446                 pack $w.global.$name -side top -anchor w -fill x
4447         }
4448
4449         bind $w <Visibility> "grab $w; focus $w"
4450         bind $w <Key-Escape> "destroy $w"
4451         wm title $w "[appname] ([reponame]): Options"
4452         tkwait window $w
4453 }
4454
4455 proc do_restore_defaults {} {
4456         global font_descs default_config repo_config
4457         global repo_config_new global_config_new
4458
4459         foreach name [array names default_config] {
4460                 set repo_config_new($name) $default_config($name)
4461                 set global_config_new($name) $default_config($name)
4462         }
4463
4464         foreach option $font_descs {
4465                 set name [lindex $option 0]
4466                 set repo_config(gui.$name) $default_config(gui.$name)
4467         }
4468         apply_config
4469
4470         foreach option $font_descs {
4471                 set name [lindex $option 0]
4472                 set font [lindex $option 1]
4473                 set global_config_new(gui.$font^^family) \
4474                         [font configure $font -family]
4475                 set global_config_new(gui.$font^^size) \
4476                         [font configure $font -size]
4477         }
4478 }
4479
4480 proc do_save_config {w} {
4481         if {[catch {save_config} err]} {
4482                 error_popup "Failed to completely save options:\n\n$err"
4483         }
4484         reshow_diff
4485         destroy $w
4486 }
4487
4488 proc do_windows_shortcut {} {
4489         global argv0
4490
4491         set fn [tk_getSaveFile \
4492                 -parent . \
4493                 -title "[appname] ([reponame]): Create Desktop Icon" \
4494                 -initialfile "Git [reponame].bat"]
4495         if {$fn != {}} {
4496                 if {[catch {
4497                                 set fd [open $fn w]
4498                                 puts $fd "@ECHO Entering [reponame]"
4499                                 puts $fd "@ECHO Starting git-gui... please wait..."
4500                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4501                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4502                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4503                                 puts $fd " \"[file normalize $argv0]\""
4504                                 close $fd
4505                         } err]} {
4506                         error_popup "Cannot write script:\n\n$err"
4507                 }
4508         }
4509 }
4510
4511 proc do_cygwin_shortcut {} {
4512         global argv0
4513
4514         if {[catch {
4515                 set desktop [exec cygpath \
4516                         --windows \
4517                         --absolute \
4518                         --long-name \
4519                         --desktop]
4520                 }]} {
4521                         set desktop .
4522         }
4523         set fn [tk_getSaveFile \
4524                 -parent . \
4525                 -title "[appname] ([reponame]): Create Desktop Icon" \
4526                 -initialdir $desktop \
4527                 -initialfile "Git [reponame].bat"]
4528         if {$fn != {}} {
4529                 if {[catch {
4530                                 set fd [open $fn w]
4531                                 set sh [exec cygpath \
4532                                         --windows \
4533                                         --absolute \
4534                                         /bin/sh]
4535                                 set me [exec cygpath \
4536                                         --unix \
4537                                         --absolute \
4538                                         $argv0]
4539                                 set gd [exec cygpath \
4540                                         --unix \
4541                                         --absolute \
4542                                         [gitdir]]
4543                                 set gw [exec cygpath \
4544                                         --windows \
4545                                         --absolute \
4546                                         [file dirname [gitdir]]]
4547                                 regsub -all ' $me "'\\''" me
4548                                 regsub -all ' $gd "'\\''" gd
4549                                 puts $fd "@ECHO Entering $gw"
4550                                 puts $fd "@ECHO Starting git-gui... please wait..."
4551                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4552                                 puts -nonewline $fd "GIT_DIR='$gd'"
4553                                 puts -nonewline $fd " '$me'"
4554                                 puts $fd "&\""
4555                                 close $fd
4556                         } err]} {
4557                         error_popup "Cannot write script:\n\n$err"
4558                 }
4559         }
4560 }
4561
4562 proc do_macosx_app {} {
4563         global argv0 env
4564
4565         set fn [tk_getSaveFile \
4566                 -parent . \
4567                 -title "[appname] ([reponame]): Create Desktop Icon" \
4568                 -initialdir [file join $env(HOME) Desktop] \
4569                 -initialfile "Git [reponame].app"]
4570         if {$fn != {}} {
4571                 if {[catch {
4572                                 set Contents [file join $fn Contents]
4573                                 set MacOS [file join $Contents MacOS]
4574                                 set exe [file join $MacOS git-gui]
4575
4576                                 file mkdir $MacOS
4577
4578                                 set fd [open [file join $Contents Info.plist] w]
4579                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4580 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4581 <plist version="1.0">
4582 <dict>
4583         <key>CFBundleDevelopmentRegion</key>
4584         <string>English</string>
4585         <key>CFBundleExecutable</key>
4586         <string>git-gui</string>
4587         <key>CFBundleIdentifier</key>
4588         <string>org.spearce.git-gui</string>
4589         <key>CFBundleInfoDictionaryVersion</key>
4590         <string>6.0</string>
4591         <key>CFBundlePackageType</key>
4592         <string>APPL</string>
4593         <key>CFBundleSignature</key>
4594         <string>????</string>
4595         <key>CFBundleVersion</key>
4596         <string>1.0</string>
4597         <key>NSPrincipalClass</key>
4598         <string>NSApplication</string>
4599 </dict>
4600 </plist>}
4601                                 close $fd
4602
4603                                 set fd [open $exe w]
4604                                 set gd [file normalize [gitdir]]
4605                                 set ep [file normalize [gitexec]]
4606                                 regsub -all ' $gd "'\\''" gd
4607                                 regsub -all ' $ep "'\\''" ep
4608                                 puts $fd "#!/bin/sh"
4609                                 foreach name [array names env] {
4610                                         if {[string match GIT_* $name]} {
4611                                                 regsub -all ' $env($name) "'\\''" v
4612                                                 puts $fd "export $name='$v'"
4613                                         }
4614                                 }
4615                                 puts $fd "export PATH='$ep':\$PATH"
4616                                 puts $fd "export GIT_DIR='$gd'"
4617                                 puts $fd "exec [file normalize $argv0]"
4618                                 close $fd
4619
4620                                 file attributes $exe -permissions u+x,g+x,o+x
4621                         } err]} {
4622                         error_popup "Cannot write icon:\n\n$err"
4623                 }
4624         }
4625 }
4626
4627 proc toggle_or_diff {w x y} {
4628         global file_states file_lists current_diff_path ui_index ui_workdir
4629         global last_clicked selected_paths
4630
4631         set pos [split [$w index @$x,$y] .]
4632         set lno [lindex $pos 0]
4633         set col [lindex $pos 1]
4634         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4635         if {$path eq {}} {
4636                 set last_clicked {}
4637                 return
4638         }
4639
4640         set last_clicked [list $w $lno]
4641         array unset selected_paths
4642         $ui_index tag remove in_sel 0.0 end
4643         $ui_workdir tag remove in_sel 0.0 end
4644
4645         if {$col == 0} {
4646                 if {$current_diff_path eq $path} {
4647                         set after {reshow_diff;}
4648                 } else {
4649                         set after {}
4650                 }
4651                 if {$w eq $ui_index} {
4652                         update_indexinfo \
4653                                 "Unstaging [short_path $path] from commit" \
4654                                 [list $path] \
4655                                 [concat $after {set ui_status_value {Ready.}}]
4656                 } elseif {$w eq $ui_workdir} {
4657                         update_index \
4658                                 "Adding [short_path $path]" \
4659                                 [list $path] \
4660                                 [concat $after {set ui_status_value {Ready.}}]
4661                 }
4662         } else {
4663                 show_diff $path $w $lno
4664         }
4665 }
4666
4667 proc add_one_to_selection {w x y} {
4668         global file_lists last_clicked selected_paths
4669
4670         set lno [lindex [split [$w index @$x,$y] .] 0]
4671         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4672         if {$path eq {}} {
4673                 set last_clicked {}
4674                 return
4675         }
4676
4677         if {$last_clicked ne {}
4678                 && [lindex $last_clicked 0] ne $w} {
4679                 array unset selected_paths
4680                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4681         }
4682
4683         set last_clicked [list $w $lno]
4684         if {[catch {set in_sel $selected_paths($path)}]} {
4685                 set in_sel 0
4686         }
4687         if {$in_sel} {
4688                 unset selected_paths($path)
4689                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4690         } else {
4691                 set selected_paths($path) 1
4692                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4693         }
4694 }
4695
4696 proc add_range_to_selection {w x y} {
4697         global file_lists last_clicked selected_paths
4698
4699         if {[lindex $last_clicked 0] ne $w} {
4700                 toggle_or_diff $w $x $y
4701                 return
4702         }
4703
4704         set lno [lindex [split [$w index @$x,$y] .] 0]
4705         set lc [lindex $last_clicked 1]
4706         if {$lc < $lno} {
4707                 set begin $lc
4708                 set end $lno
4709         } else {
4710                 set begin $lno
4711                 set end $lc
4712         }
4713
4714         foreach path [lrange $file_lists($w) \
4715                 [expr {$begin - 1}] \
4716                 [expr {$end - 1}]] {
4717                 set selected_paths($path) 1
4718         }
4719         $w tag add in_sel $begin.0 [expr {$end + 1}].0
4720 }
4721
4722 ######################################################################
4723 ##
4724 ## config defaults
4725
4726 set cursor_ptr arrow
4727 font create font_diff -family Courier -size 10
4728 font create font_ui
4729 catch {
4730         label .dummy
4731         eval font configure font_ui [font actual [.dummy cget -font]]
4732         destroy .dummy
4733 }
4734
4735 font create font_uibold
4736 font create font_diffbold
4737
4738 if {[is_Windows]} {
4739         set M1B Control
4740         set M1T Ctrl
4741 } elseif {[is_MacOSX]} {
4742         set M1B M1
4743         set M1T Cmd
4744 } else {
4745         set M1B M1
4746         set M1T M1
4747 }
4748
4749 proc apply_config {} {
4750         global repo_config font_descs
4751
4752         foreach option $font_descs {
4753                 set name [lindex $option 0]
4754                 set font [lindex $option 1]
4755                 if {[catch {
4756                         foreach {cn cv} $repo_config(gui.$name) {
4757                                 font configure $font $cn $cv
4758                         }
4759                         } err]} {
4760                         error_popup "Invalid font specified in gui.$name:\n\n$err"
4761                 }
4762                 foreach {cn cv} [font configure $font] {
4763                         font configure ${font}bold $cn $cv
4764                 }
4765                 font configure ${font}bold -weight bold
4766         }
4767 }
4768
4769 set default_config(merge.summary) false
4770 set default_config(merge.verbosity) 2
4771 set default_config(user.name) {}
4772 set default_config(user.email) {}
4773
4774 set default_config(gui.trustmtime) false
4775 set default_config(gui.diffcontext) 5
4776 set default_config(gui.newbranchtemplate) {}
4777 set default_config(gui.fontui) [font configure font_ui]
4778 set default_config(gui.fontdiff) [font configure font_diff]
4779 set font_descs {
4780         {fontui   font_ui   {Main Font}}
4781         {fontdiff font_diff {Diff/Console Font}}
4782 }
4783 load_config 0
4784 apply_config
4785
4786 ######################################################################
4787 ##
4788 ## ui construction
4789
4790 # -- Menu Bar
4791 #
4792 menu .mbar -tearoff 0
4793 .mbar add cascade -label Repository -menu .mbar.repository
4794 .mbar add cascade -label Edit -menu .mbar.edit
4795 if {!$single_commit} {
4796         .mbar add cascade -label Branch -menu .mbar.branch
4797 }
4798 .mbar add cascade -label Commit -menu .mbar.commit
4799 if {!$single_commit} {
4800         .mbar add cascade -label Merge -menu .mbar.merge
4801         .mbar add cascade -label Fetch -menu .mbar.fetch
4802         .mbar add cascade -label Push -menu .mbar.push
4803 }
4804 . configure -menu .mbar
4805
4806 # -- Repository Menu
4807 #
4808 menu .mbar.repository
4809
4810 .mbar.repository add command \
4811         -label {Browse Current Branch} \
4812         -command {new_browser $current_branch} \
4813         -font font_ui
4814 .mbar.repository add separator
4815
4816 .mbar.repository add command \
4817         -label {Visualize Current Branch} \
4818         -command {do_gitk {}} \
4819         -font font_ui
4820 .mbar.repository add command \
4821         -label {Visualize All Branches} \
4822         -command {do_gitk {--all}} \
4823         -font font_ui
4824 .mbar.repository add separator
4825
4826 if {!$single_commit} {
4827         .mbar.repository add command -label {Database Statistics} \
4828                 -command do_stats \
4829                 -font font_ui
4830
4831         .mbar.repository add command -label {Compress Database} \
4832                 -command do_gc \
4833                 -font font_ui
4834
4835         .mbar.repository add command -label {Verify Database} \
4836                 -command do_fsck_objects \
4837                 -font font_ui
4838
4839         .mbar.repository add separator
4840
4841         if {[is_Cygwin]} {
4842                 .mbar.repository add command \
4843                         -label {Create Desktop Icon} \
4844                         -command do_cygwin_shortcut \
4845                         -font font_ui
4846         } elseif {[is_Windows]} {
4847                 .mbar.repository add command \
4848                         -label {Create Desktop Icon} \
4849                         -command do_windows_shortcut \
4850                         -font font_ui
4851         } elseif {[is_MacOSX]} {
4852                 .mbar.repository add command \
4853                         -label {Create Desktop Icon} \
4854                         -command do_macosx_app \
4855                         -font font_ui
4856         }
4857 }
4858
4859 .mbar.repository add command -label Quit \
4860         -command do_quit \
4861         -accelerator $M1T-Q \
4862         -font font_ui
4863
4864 # -- Edit Menu
4865 #
4866 menu .mbar.edit
4867 .mbar.edit add command -label Undo \
4868         -command {catch {[focus] edit undo}} \
4869         -accelerator $M1T-Z \
4870         -font font_ui
4871 .mbar.edit add command -label Redo \
4872         -command {catch {[focus] edit redo}} \
4873         -accelerator $M1T-Y \
4874         -font font_ui
4875 .mbar.edit add separator
4876 .mbar.edit add command -label Cut \
4877         -command {catch {tk_textCut [focus]}} \
4878         -accelerator $M1T-X \
4879         -font font_ui
4880 .mbar.edit add command -label Copy \
4881         -command {catch {tk_textCopy [focus]}} \
4882         -accelerator $M1T-C \
4883         -font font_ui
4884 .mbar.edit add command -label Paste \
4885         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4886         -accelerator $M1T-V \
4887         -font font_ui
4888 .mbar.edit add command -label Delete \
4889         -command {catch {[focus] delete sel.first sel.last}} \
4890         -accelerator Del \
4891         -font font_ui
4892 .mbar.edit add separator
4893 .mbar.edit add command -label {Select All} \
4894         -command {catch {[focus] tag add sel 0.0 end}} \
4895         -accelerator $M1T-A \
4896         -font font_ui
4897
4898 # -- Branch Menu
4899 #
4900 if {!$single_commit} {
4901         menu .mbar.branch
4902
4903         .mbar.branch add command -label {Create...} \
4904                 -command do_create_branch \
4905                 -accelerator $M1T-N \
4906                 -font font_ui
4907         lappend disable_on_lock [list .mbar.branch entryconf \
4908                 [.mbar.branch index last] -state]
4909
4910         .mbar.branch add command -label {Delete...} \
4911                 -command do_delete_branch \
4912                 -font font_ui
4913         lappend disable_on_lock [list .mbar.branch entryconf \
4914                 [.mbar.branch index last] -state]
4915 }
4916
4917 # -- Commit Menu
4918 #
4919 menu .mbar.commit
4920
4921 .mbar.commit add radiobutton \
4922         -label {New Commit} \
4923         -command do_select_commit_type \
4924         -variable selected_commit_type \
4925         -value new \
4926         -font font_ui
4927 lappend disable_on_lock \
4928         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4929
4930 .mbar.commit add radiobutton \
4931         -label {Amend Last Commit} \
4932         -command do_select_commit_type \
4933         -variable selected_commit_type \
4934         -value amend \
4935         -font font_ui
4936 lappend disable_on_lock \
4937         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4938
4939 .mbar.commit add separator
4940
4941 .mbar.commit add command -label Rescan \
4942         -command do_rescan \
4943         -accelerator F5 \
4944         -font font_ui
4945 lappend disable_on_lock \
4946         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4947
4948 .mbar.commit add command -label {Add To Commit} \
4949         -command do_add_selection \
4950         -font font_ui
4951 lappend disable_on_lock \
4952         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4953
4954 .mbar.commit add command -label {Add All To Commit} \
4955         -command do_add_all \
4956         -accelerator $M1T-I \
4957         -font font_ui
4958 lappend disable_on_lock \
4959         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4960
4961 .mbar.commit add command -label {Unstage From Commit} \
4962         -command do_unstage_selection \
4963         -font font_ui
4964 lappend disable_on_lock \
4965         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4966
4967 .mbar.commit add command -label {Revert Changes} \
4968         -command do_revert_selection \
4969         -font font_ui
4970 lappend disable_on_lock \
4971         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4972
4973 .mbar.commit add separator
4974
4975 .mbar.commit add command -label {Sign Off} \
4976         -command do_signoff \
4977         -accelerator $M1T-S \
4978         -font font_ui
4979
4980 .mbar.commit add command -label Commit \
4981         -command do_commit \
4982         -accelerator $M1T-Return \
4983         -font font_ui
4984 lappend disable_on_lock \
4985         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4986
4987 if {[is_MacOSX]} {
4988         # -- Apple Menu (Mac OS X only)
4989         #
4990         .mbar add cascade -label Apple -menu .mbar.apple
4991         menu .mbar.apple
4992
4993         .mbar.apple add command -label "About [appname]" \
4994                 -command do_about \
4995                 -font font_ui
4996         .mbar.apple add command -label "[appname] Options..." \
4997                 -command do_options \
4998                 -font font_ui
4999 } else {
5000         # -- Edit Menu
5001         #
5002         .mbar.edit add separator
5003         .mbar.edit add command -label {Options...} \
5004                 -command do_options \
5005                 -font font_ui
5006
5007         # -- Tools Menu
5008         #
5009         if {[file exists /usr/local/miga/lib/gui-miga]
5010                 && [file exists .pvcsrc]} {
5011         proc do_miga {} {
5012                 global ui_status_value
5013                 if {![lock_index update]} return
5014                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5015                 set miga_fd [open "|$cmd" r]
5016                 fconfigure $miga_fd -blocking 0
5017                 fileevent $miga_fd readable [list miga_done $miga_fd]
5018                 set ui_status_value {Running miga...}
5019         }
5020         proc miga_done {fd} {
5021                 read $fd 512
5022                 if {[eof $fd]} {
5023                         close $fd
5024                         unlock_index
5025                         rescan [list set ui_status_value {Ready.}]
5026                 }
5027         }
5028         .mbar add cascade -label Tools -menu .mbar.tools
5029         menu .mbar.tools
5030         .mbar.tools add command -label "Migrate" \
5031                 -command do_miga \
5032                 -font font_ui
5033         lappend disable_on_lock \
5034                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5035         }
5036 }
5037
5038 # -- Help Menu
5039 #
5040 .mbar add cascade -label Help -menu .mbar.help
5041 menu .mbar.help
5042
5043 if {![is_MacOSX]} {
5044         .mbar.help add command -label "About [appname]" \
5045                 -command do_about \
5046                 -font font_ui
5047 }
5048
5049 set browser {}
5050 catch {set browser $repo_config(instaweb.browser)}
5051 set doc_path [file dirname [gitexec]]
5052 set doc_path [file join $doc_path Documentation index.html]
5053
5054 if {[is_Cygwin]} {
5055         set doc_path [exec cygpath --windows $doc_path]
5056 }
5057
5058 if {$browser eq {}} {
5059         if {[is_MacOSX]} {
5060                 set browser open
5061         } elseif {[is_Cygwin]} {
5062                 set program_files [file dirname [exec cygpath --windir]]
5063                 set program_files [file join $program_files {Program Files}]
5064                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5065                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5066                 if {[file exists $firefox]} {
5067                         set browser $firefox
5068                 } elseif {[file exists $ie]} {
5069                         set browser $ie
5070                 }
5071                 unset program_files firefox ie
5072         }
5073 }
5074
5075 if {[file isfile $doc_path]} {
5076         set doc_url "file:$doc_path"
5077 } else {
5078         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5079 }
5080
5081 if {$browser ne {}} {
5082         .mbar.help add command -label {Online Documentation} \
5083                 -command [list exec $browser $doc_url &] \
5084                 -font font_ui
5085 }
5086 unset browser doc_path doc_url
5087
5088 # -- Branch Control
5089 #
5090 frame .branch \
5091         -borderwidth 1 \
5092         -relief sunken
5093 label .branch.l1 \
5094         -text {Current Branch:} \
5095         -anchor w \
5096         -justify left \
5097         -font font_ui
5098 label .branch.cb \
5099         -textvariable current_branch \
5100         -anchor w \
5101         -justify left \
5102         -font font_ui
5103 pack .branch.l1 -side left
5104 pack .branch.cb -side left -fill x
5105 pack .branch -side top -fill x
5106
5107 if {!$single_commit} {
5108         menu .mbar.merge
5109         .mbar.merge add command -label {Local Merge...} \
5110                 -command do_local_merge \
5111                 -font font_ui
5112         lappend disable_on_lock \
5113                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5114         .mbar.merge add command -label {Abort Merge...} \
5115                 -command do_reset_hard \
5116                 -font font_ui
5117         lappend disable_on_lock \
5118                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5119
5120
5121         menu .mbar.fetch
5122
5123         menu .mbar.push
5124         .mbar.push add command -label {Push...} \
5125                 -command do_push_anywhere \
5126                 -font font_ui
5127 }
5128
5129 # -- Main Window Layout
5130 #
5131 panedwindow .vpane -orient vertical
5132 panedwindow .vpane.files -orient horizontal
5133 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5134 pack .vpane -anchor n -side top -fill both -expand 1
5135
5136 # -- Index File List
5137 #
5138 frame .vpane.files.index -height 100 -width 200
5139 label .vpane.files.index.title -text {Changes To Be Committed} \
5140         -background green \
5141         -font font_ui
5142 text $ui_index -background white -borderwidth 0 \
5143         -width 20 -height 10 \
5144         -wrap none \
5145         -font font_ui \
5146         -cursor $cursor_ptr \
5147         -xscrollcommand {.vpane.files.index.sx set} \
5148         -yscrollcommand {.vpane.files.index.sy set} \
5149         -state disabled
5150 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5151 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5152 pack .vpane.files.index.title -side top -fill x
5153 pack .vpane.files.index.sx -side bottom -fill x
5154 pack .vpane.files.index.sy -side right -fill y
5155 pack $ui_index -side left -fill both -expand 1
5156 .vpane.files add .vpane.files.index -sticky nsew
5157
5158 # -- Working Directory File List
5159 #
5160 frame .vpane.files.workdir -height 100 -width 200
5161 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5162         -background red \
5163         -font font_ui
5164 text $ui_workdir -background white -borderwidth 0 \
5165         -width 20 -height 10 \
5166         -wrap none \
5167         -font font_ui \
5168         -cursor $cursor_ptr \
5169         -xscrollcommand {.vpane.files.workdir.sx set} \
5170         -yscrollcommand {.vpane.files.workdir.sy set} \
5171         -state disabled
5172 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5173 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5174 pack .vpane.files.workdir.title -side top -fill x
5175 pack .vpane.files.workdir.sx -side bottom -fill x
5176 pack .vpane.files.workdir.sy -side right -fill y
5177 pack $ui_workdir -side left -fill both -expand 1
5178 .vpane.files add .vpane.files.workdir -sticky nsew
5179
5180 foreach i [list $ui_index $ui_workdir] {
5181         $i tag conf in_diff -font font_uibold
5182         $i tag conf in_sel \
5183                 -background [$i cget -foreground] \
5184                 -foreground [$i cget -background]
5185 }
5186 unset i
5187
5188 # -- Diff and Commit Area
5189 #
5190 frame .vpane.lower -height 300 -width 400
5191 frame .vpane.lower.commarea
5192 frame .vpane.lower.diff -relief sunken -borderwidth 1
5193 pack .vpane.lower.commarea -side top -fill x
5194 pack .vpane.lower.diff -side bottom -fill both -expand 1
5195 .vpane add .vpane.lower -sticky nsew
5196
5197 # -- Commit Area Buttons
5198 #
5199 frame .vpane.lower.commarea.buttons
5200 label .vpane.lower.commarea.buttons.l -text {} \
5201         -anchor w \
5202         -justify left \
5203         -font font_ui
5204 pack .vpane.lower.commarea.buttons.l -side top -fill x
5205 pack .vpane.lower.commarea.buttons -side left -fill y
5206
5207 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5208         -command do_rescan \
5209         -font font_ui
5210 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5211 lappend disable_on_lock \
5212         {.vpane.lower.commarea.buttons.rescan conf -state}
5213
5214 button .vpane.lower.commarea.buttons.incall -text {Add All} \
5215         -command do_add_all \
5216         -font font_ui
5217 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5218 lappend disable_on_lock \
5219         {.vpane.lower.commarea.buttons.incall conf -state}
5220
5221 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5222         -command do_signoff \
5223         -font font_ui
5224 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5225
5226 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5227         -command do_commit \
5228         -font font_ui
5229 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5230 lappend disable_on_lock \
5231         {.vpane.lower.commarea.buttons.commit conf -state}
5232
5233 # -- Commit Message Buffer
5234 #
5235 frame .vpane.lower.commarea.buffer
5236 frame .vpane.lower.commarea.buffer.header
5237 set ui_comm .vpane.lower.commarea.buffer.t
5238 set ui_coml .vpane.lower.commarea.buffer.header.l
5239 radiobutton .vpane.lower.commarea.buffer.header.new \
5240         -text {New Commit} \
5241         -command do_select_commit_type \
5242         -variable selected_commit_type \
5243         -value new \
5244         -font font_ui
5245 lappend disable_on_lock \
5246         [list .vpane.lower.commarea.buffer.header.new conf -state]
5247 radiobutton .vpane.lower.commarea.buffer.header.amend \
5248         -text {Amend Last Commit} \
5249         -command do_select_commit_type \
5250         -variable selected_commit_type \
5251         -value amend \
5252         -font font_ui
5253 lappend disable_on_lock \
5254         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5255 label $ui_coml \
5256         -anchor w \
5257         -justify left \
5258         -font font_ui
5259 proc trace_commit_type {varname args} {
5260         global ui_coml commit_type
5261         switch -glob -- $commit_type {
5262         initial       {set txt {Initial Commit Message:}}
5263         amend         {set txt {Amended Commit Message:}}
5264         amend-initial {set txt {Amended Initial Commit Message:}}
5265         amend-merge   {set txt {Amended Merge Commit Message:}}
5266         merge         {set txt {Merge Commit Message:}}
5267         *             {set txt {Commit Message:}}
5268         }
5269         $ui_coml conf -text $txt
5270 }
5271 trace add variable commit_type write trace_commit_type
5272 pack $ui_coml -side left -fill x
5273 pack .vpane.lower.commarea.buffer.header.amend -side right
5274 pack .vpane.lower.commarea.buffer.header.new -side right
5275
5276 text $ui_comm -background white -borderwidth 1 \
5277         -undo true \
5278         -maxundo 20 \
5279         -autoseparators true \
5280         -relief sunken \
5281         -width 75 -height 9 -wrap none \
5282         -font font_diff \
5283         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5284 scrollbar .vpane.lower.commarea.buffer.sby \
5285         -command [list $ui_comm yview]
5286 pack .vpane.lower.commarea.buffer.header -side top -fill x
5287 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5288 pack $ui_comm -side left -fill y
5289 pack .vpane.lower.commarea.buffer -side left -fill y
5290
5291 # -- Commit Message Buffer Context Menu
5292 #
5293 set ctxm .vpane.lower.commarea.buffer.ctxm
5294 menu $ctxm -tearoff 0
5295 $ctxm add command \
5296         -label {Cut} \
5297         -font font_ui \
5298         -command {tk_textCut $ui_comm}
5299 $ctxm add command \
5300         -label {Copy} \
5301         -font font_ui \
5302         -command {tk_textCopy $ui_comm}
5303 $ctxm add command \
5304         -label {Paste} \
5305         -font font_ui \
5306         -command {tk_textPaste $ui_comm}
5307 $ctxm add command \
5308         -label {Delete} \
5309         -font font_ui \
5310         -command {$ui_comm delete sel.first sel.last}
5311 $ctxm add separator
5312 $ctxm add command \
5313         -label {Select All} \
5314         -font font_ui \
5315         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5316 $ctxm add command \
5317         -label {Copy All} \
5318         -font font_ui \
5319         -command {
5320                 $ui_comm tag add sel 0.0 end
5321                 tk_textCopy $ui_comm
5322                 $ui_comm tag remove sel 0.0 end
5323         }
5324 $ctxm add separator
5325 $ctxm add command \
5326         -label {Sign Off} \
5327         -font font_ui \
5328         -command do_signoff
5329 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5330
5331 # -- Diff Header
5332 #
5333 set current_diff_path {}
5334 set current_diff_side {}
5335 set diff_actions [list]
5336 proc trace_current_diff_path {varname args} {
5337         global current_diff_path diff_actions file_states
5338         if {$current_diff_path eq {}} {
5339                 set s {}
5340                 set f {}
5341                 set p {}
5342                 set o disabled
5343         } else {
5344                 set p $current_diff_path
5345                 set s [mapdesc [lindex $file_states($p) 0] $p]
5346                 set f {File:}
5347                 set p [escape_path $p]
5348                 set o normal
5349         }
5350
5351         .vpane.lower.diff.header.status configure -text $s
5352         .vpane.lower.diff.header.file configure -text $f
5353         .vpane.lower.diff.header.path configure -text $p
5354         foreach w $diff_actions {
5355                 uplevel #0 $w $o
5356         }
5357 }
5358 trace add variable current_diff_path write trace_current_diff_path
5359
5360 frame .vpane.lower.diff.header -background orange
5361 label .vpane.lower.diff.header.status \
5362         -background orange \
5363         -width $max_status_desc \
5364         -anchor w \
5365         -justify left \
5366         -font font_ui
5367 label .vpane.lower.diff.header.file \
5368         -background orange \
5369         -anchor w \
5370         -justify left \
5371         -font font_ui
5372 label .vpane.lower.diff.header.path \
5373         -background orange \
5374         -anchor w \
5375         -justify left \
5376         -font font_ui
5377 pack .vpane.lower.diff.header.status -side left
5378 pack .vpane.lower.diff.header.file -side left
5379 pack .vpane.lower.diff.header.path -fill x
5380 set ctxm .vpane.lower.diff.header.ctxm
5381 menu $ctxm -tearoff 0
5382 $ctxm add command \
5383         -label {Copy} \
5384         -font font_ui \
5385         -command {
5386                 clipboard clear
5387                 clipboard append \
5388                         -format STRING \
5389                         -type STRING \
5390                         -- $current_diff_path
5391         }
5392 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5393 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5394
5395 # -- Diff Body
5396 #
5397 frame .vpane.lower.diff.body
5398 set ui_diff .vpane.lower.diff.body.t
5399 text $ui_diff -background white -borderwidth 0 \
5400         -width 80 -height 15 -wrap none \
5401         -font font_diff \
5402         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5403         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5404         -state disabled
5405 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5406         -command [list $ui_diff xview]
5407 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5408         -command [list $ui_diff yview]
5409 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5410 pack .vpane.lower.diff.body.sby -side right -fill y
5411 pack $ui_diff -side left -fill both -expand 1
5412 pack .vpane.lower.diff.header -side top -fill x
5413 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5414
5415 $ui_diff tag conf d_cr -elide true
5416 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5417 $ui_diff tag conf d_+ -foreground {#00a000}
5418 $ui_diff tag conf d_- -foreground red
5419
5420 $ui_diff tag conf d_++ -foreground {#00a000}
5421 $ui_diff tag conf d_-- -foreground red
5422 $ui_diff tag conf d_+s \
5423         -foreground {#00a000} \
5424         -background {#e2effa}
5425 $ui_diff tag conf d_-s \
5426         -foreground red \
5427         -background {#e2effa}
5428 $ui_diff tag conf d_s+ \
5429         -foreground {#00a000} \
5430         -background ivory1
5431 $ui_diff tag conf d_s- \
5432         -foreground red \
5433         -background ivory1
5434
5435 $ui_diff tag conf d<<<<<<< \
5436         -foreground orange \
5437         -font font_diffbold
5438 $ui_diff tag conf d======= \
5439         -foreground orange \
5440         -font font_diffbold
5441 $ui_diff tag conf d>>>>>>> \
5442         -foreground orange \
5443         -font font_diffbold
5444
5445 $ui_diff tag raise sel
5446
5447 # -- Diff Body Context Menu
5448 #
5449 set ctxm .vpane.lower.diff.body.ctxm
5450 menu $ctxm -tearoff 0
5451 $ctxm add command \
5452         -label {Refresh} \
5453         -font font_ui \
5454         -command reshow_diff
5455 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5456 $ctxm add command \
5457         -label {Copy} \
5458         -font font_ui \
5459         -command {tk_textCopy $ui_diff}
5460 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5461 $ctxm add command \
5462         -label {Select All} \
5463         -font font_ui \
5464         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5465 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5466 $ctxm add command \
5467         -label {Copy All} \
5468         -font font_ui \
5469         -command {
5470                 $ui_diff tag add sel 0.0 end
5471                 tk_textCopy $ui_diff
5472                 $ui_diff tag remove sel 0.0 end
5473         }
5474 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5475 $ctxm add separator
5476 $ctxm add command \
5477         -label {Apply/Reverse Hunk} \
5478         -font font_ui \
5479         -command {apply_hunk $cursorX $cursorY}
5480 set ui_diff_applyhunk [$ctxm index last]
5481 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5482 $ctxm add separator
5483 $ctxm add command \
5484         -label {Decrease Font Size} \
5485         -font font_ui \
5486         -command {incr_font_size font_diff -1}
5487 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5488 $ctxm add command \
5489         -label {Increase Font Size} \
5490         -font font_ui \
5491         -command {incr_font_size font_diff 1}
5492 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5493 $ctxm add separator
5494 $ctxm add command \
5495         -label {Show Less Context} \
5496         -font font_ui \
5497         -command {if {$repo_config(gui.diffcontext) >= 2} {
5498                 incr repo_config(gui.diffcontext) -1
5499                 reshow_diff
5500         }}
5501 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5502 $ctxm add command \
5503         -label {Show More Context} \
5504         -font font_ui \
5505         -command {
5506                 incr repo_config(gui.diffcontext)
5507                 reshow_diff
5508         }
5509 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5510 $ctxm add separator
5511 $ctxm add command -label {Options...} \
5512         -font font_ui \
5513         -command do_options
5514 bind_button3 $ui_diff "
5515         set cursorX %x
5516         set cursorY %y
5517         if {\$ui_index eq \$current_diff_side} {
5518                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5519         } else {
5520                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5521         }
5522         tk_popup $ctxm %X %Y
5523 "
5524 unset ui_diff_applyhunk
5525
5526 # -- Status Bar
5527 #
5528 set ui_status_value {Initializing...}
5529 label .status -textvariable ui_status_value \
5530         -anchor w \
5531         -justify left \
5532         -borderwidth 1 \
5533         -relief sunken \
5534         -font font_ui
5535 pack .status -anchor w -side bottom -fill x
5536
5537 # -- Load geometry
5538 #
5539 catch {
5540 set gm $repo_config(gui.geometry)
5541 wm geometry . [lindex $gm 0]
5542 .vpane sash place 0 \
5543         [lindex [.vpane sash coord 0] 0] \
5544         [lindex $gm 1]
5545 .vpane.files sash place 0 \
5546         [lindex $gm 2] \
5547         [lindex [.vpane.files sash coord 0] 1]
5548 unset gm
5549 }
5550
5551 # -- Key Bindings
5552 #
5553 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5554 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5555 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5556 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5557 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5558 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5559 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5560 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5561 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5562 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5563 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5564
5565 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5566 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5567 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5568 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5569 bind $ui_diff <$M1B-Key-v> {break}
5570 bind $ui_diff <$M1B-Key-V> {break}
5571 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5572 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5573 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5574 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5575 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5576 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5577 bind $ui_diff <Button-1>   {focus %W}
5578
5579 if {!$single_commit} {
5580         bind . <$M1B-Key-n> do_create_branch
5581         bind . <$M1B-Key-N> do_create_branch
5582 }
5583
5584 bind .   <Destroy> do_quit
5585 bind all <Key-F5> do_rescan
5586 bind all <$M1B-Key-r> do_rescan
5587 bind all <$M1B-Key-R> do_rescan
5588 bind .   <$M1B-Key-s> do_signoff
5589 bind .   <$M1B-Key-S> do_signoff
5590 bind .   <$M1B-Key-i> do_add_all
5591 bind .   <$M1B-Key-I> do_add_all
5592 bind .   <$M1B-Key-Return> do_commit
5593 bind all <$M1B-Key-q> do_quit
5594 bind all <$M1B-Key-Q> do_quit
5595 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5596 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5597 foreach i [list $ui_index $ui_workdir] {
5598         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5599         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5600         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5601 }
5602 unset i
5603
5604 set file_lists($ui_index) [list]
5605 set file_lists($ui_workdir) [list]
5606
5607 set HEAD {}
5608 set PARENT {}
5609 set MERGE_HEAD [list]
5610 set commit_type {}
5611 set empty_tree {}
5612 set current_branch {}
5613 set current_diff_path {}
5614 set selected_commit_type new
5615
5616 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5617 focus -force $ui_comm
5618
5619 # -- Warn the user about environmental problems.  Cygwin's Tcl
5620 #    does *not* pass its env array onto any processes it spawns.
5621 #    This means that git processes get none of our environment.
5622 #
5623 if {[is_Cygwin]} {
5624         set ignored_env 0
5625         set suggest_user {}
5626         set msg "Possible environment issues exist.
5627
5628 The following environment variables are probably
5629 going to be ignored by any Git subprocess run
5630 by [appname]:
5631
5632 "
5633         foreach name [array names env] {
5634                 switch -regexp -- $name {
5635                 {^GIT_INDEX_FILE$} -
5636                 {^GIT_OBJECT_DIRECTORY$} -
5637                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5638                 {^GIT_DIFF_OPTS$} -
5639                 {^GIT_EXTERNAL_DIFF$} -
5640                 {^GIT_PAGER$} -
5641                 {^GIT_TRACE$} -
5642                 {^GIT_CONFIG$} -
5643                 {^GIT_CONFIG_LOCAL$} -
5644                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5645                         append msg " - $name\n"
5646                         incr ignored_env
5647                 }
5648                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5649                         append msg " - $name\n"
5650                         incr ignored_env
5651                         set suggest_user $name
5652                 }
5653                 }
5654         }
5655         if {$ignored_env > 0} {
5656                 append msg "
5657 This is due to a known issue with the
5658 Tcl binary distributed by Cygwin."
5659
5660                 if {$suggest_user ne {}} {
5661                         append msg "
5662
5663 A good replacement for $suggest_user
5664 is placing values for the user.name and
5665 user.email settings into your personal
5666 ~/.gitconfig file.
5667 "
5668                 }
5669                 warn_popup $msg
5670         }
5671         unset ignored_env msg suggest_user name
5672 }
5673
5674 # -- Only initialize complex UI if we are going to stay running.
5675 #
5676 if {!$single_commit} {
5677         load_all_remotes
5678         load_all_heads
5679
5680         populate_branch_menu
5681         populate_fetch_menu
5682         populate_push_menu
5683 }
5684
5685 # -- Only suggest a gc run if we are going to stay running.
5686 #
5687 if {!$single_commit} {
5688         set object_limit 2000
5689         if {[is_Windows]} {set object_limit 200}
5690         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5691         if {$objects_current >= $object_limit} {
5692                 if {[ask_popup \
5693                         "This repository currently has $objects_current loose objects.
5694
5695 To maintain optimal performance it is strongly
5696 recommended that you compress the database
5697 when more than $object_limit loose objects exist.
5698
5699 Compress the database now?"] eq yes} {
5700                         do_gc
5701                 }
5702         }
5703         unset object_limit _junk objects_current
5704 }
5705
5706 lock_index begin-read
5707 after 1 do_rescan