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