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