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