git-gui.sh

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