git-gui.sh

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