git.oblomov.eu Git - git/blob - 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 in an octopus merge.  This exceeds Git's internal limit of 15 branches per merge.
2911
2912 Please select fewer branches.  To merge more than 15 branches, merge the branches in batches.
2913 "
2914                 return
2915         }
2916
2917         set msg "Merging $current_branch, [join $names {, }]"
2918         set ui_status_value "$msg..."
2919         set cons [new_console "Merge" $msg]
2920         console_exec $cons $cmd [list finish_merge $revcnt]
2921         bind $w <Destroy> {}
2922         destroy $w
2923 }
2924
2925 proc finish_merge {revcnt w ok} {
2926         console_done $w $ok
2927         if {$ok} {
2928                 set msg {Merge completed successfully.}
2929         } else {
2930                 if {$revcnt != 1} {
2931                         info_popup "Octopus merge failed.
2932
2933 Your merge of $revcnt branches has failed.
2934
2935 There are file-level conflicts between the branches which must be resolved manually.
2936
2937 The working directory will now be reset.
2938
2939 You can attempt this merge again by merging only one branch at a time." $w
2940
2941                         set fd [open "| git read-tree --reset -u HEAD" r]
2942                         fconfigure $fd -blocking 0 -translation binary
2943                         fileevent $fd readable [list reset_hard_wait $fd]
2944                         set ui_status_value {Aborting... please wait...}
2945                         return
2946                 }
2947
2948                 set msg {Merge failed.  Conflict resolution is required.}
2949         }
2950         unlock_index
2951         rescan [list set ui_status_value $msg]
2952 }
2953
2954 proc do_local_merge {} {
2955         global current_branch
2956
2957         if {![can_merge]} return
2958
2959         set w .merge_setup
2960         toplevel $w
2961         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2962
2963         label $w.header \
2964                 -text "Merge Into $current_branch" \
2965                 -font font_uibold
2966         pack $w.header -side top -fill x
2967
2968         frame $w.buttons
2969         button $w.buttons.visualize -text Visualize \
2970                 -font font_ui \
2971                 -command [list visualize_local_merge $w]
2972         pack $w.buttons.visualize -side left
2973         button $w.buttons.create -text Merge \
2974                 -font font_ui \
2975                 -command [list start_local_merge_action $w]
2976         pack $w.buttons.create -side right
2977         button $w.buttons.cancel -text {Cancel} \
2978                 -font font_ui \
2979                 -command [list destroy $w]
2980         pack $w.buttons.cancel -side right -padx 5
2981         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2982
2983         labelframe $w.source \
2984                 -text {Source Branches} \
2985                 -font font_ui
2986         listbox $w.source.l \
2987                 -height 10 \
2988                 -width 70 \
2989                 -selectmode extended \
2990                 -yscrollcommand [list $w.source.sby set] \
2991                 -font font_ui
2992         scrollbar $w.source.sby -command [list $w.source.l yview]
2993         pack $w.source.sby -side right -fill y
2994         pack $w.source.l -side left -fill both -expand 1
2995         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2996
2997         set cmd [list git for-each-ref]
2998         lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2999         lappend cmd refs/heads
3000         lappend cmd refs/remotes
3001         lappend cmd refs/tags
3002         set fr_fd [open "| $cmd" r]
3003         fconfigure $fr_fd -translation binary
3004         while {[gets $fr_fd line] > 0} {
3005                 set line [split $line { }]
3006                 set sha1([lindex $line 0]) [lindex $line 2]
3007                 set sha1([lindex $line 1]) [lindex $line 2]
3008         }
3009         close $fr_fd
3010
3011         set to_show {}
3012         set fr_fd [open "| git rev-list --all --not HEAD"]
3013         while {[gets $fr_fd line] > 0} {
3014                 if {[catch {set ref $sha1($line)}]} continue
3015                 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
3016                 lappend to_show $ref
3017         }
3018         close $fr_fd
3019
3020         foreach ref [lsort -unique $to_show] {
3021                 $w.source.l insert end $ref
3022         }
3023
3024         bind $w <Visibility> "grab $w"
3025         bind $w <Key-Escape> "unlock_index;destroy $w"
3026         bind $w <Destroy> unlock_index
3027         wm title $w "[appname] ([reponame]): Merge"
3028         tkwait window $w
3029 }
3030
3031 proc do_reset_hard {} {
3032         global HEAD commit_type file_states
3033
3034         if {[string match amend* $commit_type]} {
3035                 info_popup {Cannot abort while amending.
3036
3037 You must finish amending this commit.
3038 }
3039                 return
3040         }
3041
3042         if {![lock_index abort]} return
3043
3044         if {[string match *merge* $commit_type]} {
3045                 set op merge
3046         } else {
3047                 set op commit
3048         }
3049
3050         if {[ask_popup "Abort $op?
3051
3052 Aborting the current $op will cause *ALL* uncommitted changes to be lost.
3053
3054 Continue with aborting the current $op?"] eq {yes}} {
3055                 set fd [open "| git read-tree --reset -u HEAD" r]
3056                 fconfigure $fd -blocking 0 -translation binary
3057                 fileevent $fd readable [list reset_hard_wait $fd]
3058                 set ui_status_value {Aborting... please wait...}
3059         } else {
3060                 unlock_index
3061         }
3062 }
3063
3064 proc reset_hard_wait {fd} {
3065         global ui_comm
3066
3067         read $fd
3068         if {[eof $fd]} {
3069                 close $fd
3070                 unlock_index
3071
3072                 $ui_comm delete 0.0 end
3073                 $ui_comm edit modified false
3074
3075                 catch {file delete [gitdir MERGE_HEAD]}
3076                 catch {file delete [gitdir rr-cache MERGE_RR]}
3077                 catch {file delete [gitdir SQUASH_MSG]}
3078                 catch {file delete [gitdir MERGE_MSG]}
3079                 catch {file delete [gitdir GITGUI_MSG]}
3080
3081                 rescan {set ui_status_value {Abort completed.  Ready.}}
3082         }
3083 }
3084
3085 ######################################################################
3086 ##
3087 ## browser
3088
3089 set next_browser_id 0
3090
3091 proc new_browser {commit} {
3092         global next_browser_id cursor_ptr M1B
3093         global browser_commit browser_status browser_stack browser_path browser_busy
3094
3095         if {[winfo ismapped .]} {
3096                 set w .browser[incr next_browser_id]
3097                 set tl $w
3098                 toplevel $w
3099         } else {
3100                 set w {}
3101                 set tl .
3102         }
3103         set w_list $w.list.l
3104         set browser_commit($w_list) $commit
3105         set browser_status($w_list) {Starting...}
3106         set browser_stack($w_list) {}
3107         set browser_path($w_list) $browser_commit($w_list):
3108         set browser_busy($w_list) 1
3109
3110         label $w.path -textvariable browser_path($w_list) \
3111                 -anchor w \
3112                 -justify left \
3113                 -borderwidth 1 \
3114                 -relief sunken \
3115                 -font font_uibold
3116         pack $w.path -anchor w -side top -fill x
3117
3118         frame $w.list
3119         text $w_list -background white -borderwidth 0 \
3120                 -cursor $cursor_ptr \
3121                 -state disabled \
3122                 -wrap none \
3123                 -height 20 \
3124                 -width 70 \
3125                 -xscrollcommand [list $w.list.sbx set] \
3126                 -yscrollcommand [list $w.list.sby set] \
3127                 -font font_ui
3128         $w_list tag conf in_sel \
3129                 -background [$w_list cget -foreground] \
3130                 -foreground [$w_list cget -background]
3131         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3132         scrollbar $w.list.sby -orient v -command [list $w_list yview]
3133         pack $w.list.sbx -side bottom -fill x
3134         pack $w.list.sby -side right -fill y
3135         pack $w_list -side left -fill both -expand 1
3136         pack $w.list -side top -fill both -expand 1
3137
3138         label $w.status -textvariable browser_status($w_list) \
3139                 -anchor w \
3140                 -justify left \
3141                 -borderwidth 1 \
3142                 -relief sunken \
3143                 -font font_ui
3144         pack $w.status -anchor w -side bottom -fill x
3145
3146         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3147         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3148         bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3149         bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3150         bind $w_list <Up>              "browser_move -1 $w_list;break"
3151         bind $w_list <Down>            "browser_move 1 $w_list;break"
3152         bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3153         bind $w_list <Return>          "browser_enter $w_list;break"
3154         bind $w_list <Prior>           "browser_page -1 $w_list;break"
3155         bind $w_list <Next>            "browser_page 1 $w_list;break"
3156         bind $w_list <Left>            break
3157         bind $w_list <Right>           break
3158
3159         bind $tl <Visibility> "focus $w"
3160         bind $tl <Destroy> "
3161                 array unset browser_buffer $w_list
3162                 array unset browser_files $w_list
3163                 array unset browser_status $w_list
3164                 array unset browser_stack $w_list
3165                 array unset browser_path $w_list
3166                 array unset browser_commit $w_list
3167                 array unset browser_busy $w_list
3168         "
3169         wm title $tl "[appname] ([reponame]): File Browser"
3170         ls_tree $w_list $browser_commit($w_list) {}
3171 }
3172
3173 proc browser_move {dir w} {
3174         global browser_files browser_busy
3175
3176         if {$browser_busy($w)} return
3177         set lno [lindex [split [$w index in_sel.first] .] 0]
3178         incr lno $dir
3179         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3180                 $w tag remove in_sel 0.0 end
3181                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3182                 $w see $lno.0
3183         }
3184 }
3185
3186 proc browser_page {dir w} {
3187         global browser_files browser_busy
3188
3189         if {$browser_busy($w)} return
3190         $w yview scroll $dir pages
3191         set lno [expr {int(
3192                   [lindex [$w yview] 0]
3193                 * [llength $browser_files($w)]
3194                 + 1)}]
3195         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3196                 $w tag remove in_sel 0.0 end
3197                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3198                 $w see $lno.0
3199         }
3200 }
3201
3202 proc browser_parent {w} {
3203         global browser_files browser_status browser_path
3204         global browser_stack browser_busy
3205
3206         if {$browser_busy($w)} return
3207         set info [lindex $browser_files($w) 0]
3208         if {[lindex $info 0] eq {parent}} {
3209                 set parent [lindex $browser_stack($w) end-1]
3210                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3211                 if {$browser_stack($w) eq {}} {
3212                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3213                 } else {
3214                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3215                 }
3216                 set browser_status($w) "Loading $browser_path($w)..."
3217                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3218         }
3219 }
3220
3221 proc browser_enter {w} {
3222         global browser_files browser_status browser_path
3223         global browser_commit browser_stack browser_busy
3224
3225         if {$browser_busy($w)} return
3226         set lno [lindex [split [$w index in_sel.first] .] 0]
3227         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3228         if {$info ne {}} {
3229                 switch -- [lindex $info 0] {
3230                 parent {
3231                         browser_parent $w
3232                 }
3233                 tree {
3234                         set name [lindex $info 2]
3235                         set escn [escape_path $name]
3236                         set browser_status($w) "Loading $escn..."
3237                         append browser_path($w) $escn
3238                         ls_tree $w [lindex $info 1] $name
3239                 }
3240                 blob {
3241                         set name [lindex $info 2]
3242                         set p {}
3243                         foreach n $browser_stack($w) {
3244                                 append p [lindex $n 1]
3245                         }
3246                         append p $name
3247                         show_blame $browser_commit($w) $p
3248                 }
3249                 }
3250         }
3251 }
3252
3253 proc browser_click {was_double_click w pos} {
3254         global browser_files browser_busy
3255
3256         if {$browser_busy($w)} return
3257         set lno [lindex [split [$w index $pos] .] 0]
3258         focus $w
3259
3260         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3261                 $w tag remove in_sel 0.0 end
3262                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3263                 if {$was_double_click} {
3264                         browser_enter $w
3265                 }
3266         }
3267 }
3268
3269 proc ls_tree {w tree_id name} {
3270         global browser_buffer browser_files browser_stack browser_busy
3271
3272         set browser_buffer($w) {}
3273         set browser_files($w) {}
3274         set browser_busy($w) 1
3275
3276         $w conf -state normal
3277         $w tag remove in_sel 0.0 end
3278         $w delete 0.0 end
3279         if {$browser_stack($w) ne {}} {
3280                 $w image create end \
3281                         -align center -padx 5 -pady 1 \
3282                         -name icon0 \
3283                         -image file_uplevel
3284                 $w insert end {[Up To Parent]}
3285                 lappend browser_files($w) parent
3286         }
3287         lappend browser_stack($w) [list $tree_id $name]
3288         $w conf -state disabled
3289
3290         set cmd [list git ls-tree -z $tree_id]
3291         set fd [open "| $cmd" r]
3292         fconfigure $fd -blocking 0 -translation binary -encoding binary
3293         fileevent $fd readable [list read_ls_tree $fd $w]
3294 }
3295
3296 proc read_ls_tree {fd w} {
3297         global browser_buffer browser_files browser_status browser_busy
3298
3299         if {![winfo exists $w]} {
3300                 catch {close $fd}
3301                 return
3302         }
3303
3304         append browser_buffer($w) [read $fd]
3305         set pck [split $browser_buffer($w) "\0"]
3306         set browser_buffer($w) [lindex $pck end]
3307
3308         set n [llength $browser_files($w)]
3309         $w conf -state normal
3310         foreach p [lrange $pck 0 end-1] {
3311                 set info [split $p "\t"]
3312                 set path [lindex $info 1]
3313                 set info [split [lindex $info 0] { }]
3314                 set type [lindex $info 1]
3315                 set object [lindex $info 2]
3316
3317                 switch -- $type {
3318                 blob {
3319                         set image file_mod
3320                 }
3321                 tree {
3322                         set image file_dir
3323                         append path /
3324                 }
3325                 default {
3326                         set image file_question
3327                 }
3328                 }
3329
3330                 if {$n > 0} {$w insert end "\n"}
3331                 $w image create end \
3332                         -align center -padx 5 -pady 1 \
3333                         -name icon[incr n] \
3334                         -image $image
3335                 $w insert end [escape_path $path]
3336                 lappend browser_files($w) [list $type $object $path]
3337         }
3338         $w conf -state disabled
3339
3340         if {[eof $fd]} {
3341                 close $fd
3342                 set browser_status($w) Ready.
3343                 set browser_busy($w) 0
3344                 array unset browser_buffer $w
3345                 if {$n > 0} {
3346                         $w tag add in_sel 1.0 2.0
3347                         focus -force $w
3348                 }
3349         }
3350 }
3351
3352 proc show_blame {commit path} {
3353         global next_browser_id blame_status blame_data
3354
3355         if {[winfo ismapped .]} {
3356                 set w .browser[incr next_browser_id]
3357                 set tl $w
3358                 toplevel $w
3359         } else {
3360                 set w {}
3361                 set tl .
3362         }
3363         set blame_status($w) {Loading current file content...}
3364
3365         label $w.path -text "$commit:$path" \
3366                 -anchor w \
3367                 -justify left \
3368                 -borderwidth 1 \
3369                 -relief sunken \
3370                 -font font_uibold
3371         pack $w.path -side top -fill x
3372
3373         frame $w.out
3374         text $w.out.loaded_t \
3375                 -background white -borderwidth 0 \
3376                 -state disabled \
3377                 -wrap none \
3378                 -height 40 \
3379                 -width 1 \
3380                 -font font_diff
3381         $w.out.loaded_t tag conf annotated -background grey
3382
3383         text $w.out.linenumber_t \
3384                 -background white -borderwidth 0 \
3385                 -state disabled \
3386                 -wrap none \
3387                 -height 40 \
3388                 -width 5 \
3389                 -font font_diff
3390         $w.out.linenumber_t tag conf linenumber -justify right
3391
3392         text $w.out.file_t \
3393                 -background white -borderwidth 0 \
3394                 -state disabled \
3395                 -wrap none \
3396                 -height 40 \
3397                 -width 80 \
3398                 -xscrollcommand [list $w.out.sbx set] \
3399                 -font font_diff
3400
3401         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3402         scrollbar $w.out.sby -orient v \
3403                 -command [list scrollbar2many [list \
3404                 $w.out.loaded_t \
3405                 $w.out.linenumber_t \
3406                 $w.out.file_t \
3407                 ] yview]
3408         grid \
3409                 $w.out.linenumber_t \
3410                 $w.out.loaded_t \
3411                 $w.out.file_t \
3412                 $w.out.sby \
3413                 -sticky nsew
3414         grid conf $w.out.sbx -column 2 -sticky we
3415         grid columnconfigure $w.out 2 -weight 1
3416         grid rowconfigure $w.out 0 -weight 1
3417         pack $w.out -fill both -expand 1
3418
3419         label $w.status -textvariable blame_status($w) \
3420                 -anchor w \
3421                 -justify left \
3422                 -borderwidth 1 \
3423                 -relief sunken \
3424                 -font font_ui
3425         pack $w.status -side bottom -fill x
3426
3427         frame $w.cm
3428         text $w.cm.t \
3429                 -background white -borderwidth 0 \
3430                 -state disabled \
3431                 -wrap none \
3432                 -height 10 \
3433                 -width 80 \
3434                 -xscrollcommand [list $w.cm.sbx set] \
3435                 -yscrollcommand [list $w.cm.sby set] \
3436                 -font font_diff
3437         scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3438         scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3439         pack $w.cm.sby -side right -fill y
3440         pack $w.cm.sbx -side bottom -fill x
3441         pack $w.cm.t -expand 1 -fill both
3442         pack $w.cm -side bottom -fill x
3443
3444         menu $w.ctxm -tearoff 0
3445         $w.ctxm add command -label "Copy Commit" \
3446                 -font font_ui \
3447                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3448
3449         foreach i [list \
3450                 $w.out.loaded_t \
3451                 $w.out.linenumber_t \
3452                 $w.out.file_t] {
3453                 $i tag conf in_sel \
3454                         -background [$i cget -foreground] \
3455                         -foreground [$i cget -background]
3456                 $i conf -yscrollcommand \
3457                         [list many2scrollbar [list \
3458                         $w.out.loaded_t \
3459                         $w.out.linenumber_t \
3460                         $w.out.file_t \
3461                         ] yview $w.out.sby]
3462                 bind $i <Button-1> "
3463                         blame_click {$w} \\
3464                                 $w.cm.t \\
3465                                 $w.out.linenumber_t \\
3466                                 $w.out.file_t \\
3467                                 $i @%x,%y
3468                         focus $i
3469                 "
3470                 bind_button3 $i "
3471                         set cursorX %x
3472                         set cursorY %y
3473                         set cursorW %W
3474                         tk_popup $w.ctxm %X %Y
3475                 "
3476         }
3477
3478         bind $w.cm.t <Button-1> "focus $w.cm.t"
3479         bind $tl <Visibility> "focus $tl"
3480         bind $tl <Destroy> "
3481                 array unset blame_status {$w}
3482                 array unset blame_data $w,*
3483         "
3484         wm title $tl "[appname] ([reponame]): File Viewer"
3485
3486         set blame_data($w,commit_count) 0
3487         set blame_data($w,commit_list) {}
3488         set blame_data($w,total_lines) 0
3489         set blame_data($w,blame_lines) 0
3490         set blame_data($w,highlight_commit) {}
3491         set blame_data($w,highlight_line) -1
3492
3493         set cmd [list git cat-file blob "$commit:$path"]
3494         set fd [open "| $cmd" r]
3495         fconfigure $fd -blocking 0 -translation lf -encoding binary
3496         fileevent $fd readable [list read_blame_catfile \
3497                 $fd $w $commit $path \
3498                 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3499 }
3500
3501 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3502         global blame_status blame_data
3503
3504         if {![winfo exists $w_file]} {
3505                 catch {close $fd}
3506                 return
3507         }
3508
3509         set n $blame_data($w,total_lines)
3510         $w_load conf -state normal
3511         $w_line conf -state normal
3512         $w_file conf -state normal
3513         while {[gets $fd line] >= 0} {
3514                 regsub "\r\$" $line {} line
3515                 incr n
3516                 $w_load insert end "\n"
3517                 $w_line insert end "$n\n" linenumber
3518                 $w_file insert end "$line\n"
3519         }
3520         $w_load conf -state disabled
3521         $w_line conf -state disabled
3522         $w_file conf -state disabled
3523         set blame_data($w,total_lines) $n
3524
3525         if {[eof $fd]} {
3526                 close $fd
3527                 blame_incremental_status $w
3528                 set cmd [list git blame -M -C --incremental]
3529                 lappend cmd $commit -- $path
3530                 set fd [open "| $cmd" r]
3531                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3532                 fileevent $fd readable [list read_blame_incremental $fd $w \
3533                         $w_load $w_cmit $w_line $w_file]
3534         }
3535 }
3536
3537 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3538         global blame_status blame_data
3539
3540         if {![winfo exists $w_file]} {
3541                 catch {close $fd}
3542                 return
3543         }
3544
3545         while {[gets $fd line] >= 0} {
3546                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3547                         cmit original_line final_line line_count]} {
3548                         set blame_data($w,commit) $cmit
3549                         set blame_data($w,original_line) $original_line
3550                         set blame_data($w,final_line) $final_line
3551                         set blame_data($w,line_count) $line_count
3552
3553                         if {[catch {set g $blame_data($w,$cmit,order)}]} {
3554                                 $w_line tag conf g$cmit
3555                                 $w_file tag conf g$cmit
3556                                 $w_line tag raise in_sel
3557                                 $w_file tag raise in_sel
3558                                 $w_file tag raise sel
3559                                 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3560                                 incr blame_data($w,commit_count)
3561                                 lappend blame_data($w,commit_list) $cmit
3562                         }
3563                 } elseif {[string match {filename *} $line]} {
3564                         set file [string range $line 9 end]
3565                         set n $blame_data($w,line_count)
3566                         set lno $blame_data($w,final_line)
3567                         set cmit $blame_data($w,commit)
3568
3569                         while {$n > 0} {
3570                                 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3571                                         $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3572                                 } else {
3573                                         $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3574                                         $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3575                                 }
3576
3577                                 set blame_data($w,line$lno,commit) $cmit
3578                                 set blame_data($w,line$lno,file) $file
3579                                 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3580                                 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3581
3582                                 if {$blame_data($w,highlight_line) == -1} {
3583                                         if {[lindex [$w_file yview] 0] == 0} {
3584                                                 $w_file see $lno.0
3585                                                 blame_showcommit $w $w_cmit $w_line $w_file $lno
3586                                         }
3587                                 } elseif {$blame_data($w,highlight_line) == $lno} {
3588                                         blame_showcommit $w $w_cmit $w_line $w_file $lno
3589                                 }
3590
3591                                 incr n -1
3592                                 incr lno
3593                                 incr blame_data($w,blame_lines)
3594                         }
3595
3596                         set hc $blame_data($w,highlight_commit)
3597                         if {$hc ne {}
3598                                 && [expr {$blame_data($w,$hc,order) + 1}]
3599                                         == $blame_data($w,$cmit,order)} {
3600                                 blame_showcommit $w $w_cmit $w_line $w_file \
3601                                         $blame_data($w,highlight_line)
3602                         }
3603                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3604                         set blame_data($w,$blame_data($w,commit),$header) $data
3605                 }
3606         }
3607
3608         if {[eof $fd]} {
3609                 close $fd
3610                 set blame_status($w) {Annotation complete.}
3611         } else {
3612                 blame_incremental_status $w
3613         }
3614 }
3615
3616 proc blame_incremental_status {w} {
3617         global blame_status blame_data
3618
3619         set have  $blame_data($w,blame_lines)
3620         set total $blame_data($w,total_lines)
3621         set pdone 0
3622         if {$total} {set pdone [expr {100 * $have / $total}]}
3623
3624         set blame_status($w) [format \
3625                 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3626                 $have $total $pdone]
3627 }
3628
3629 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3630         set lno [lindex [split [$cur_w index $pos] .] 0]
3631         if {$lno eq {}} return
3632
3633         $w_line tag remove in_sel 0.0 end
3634         $w_file tag remove in_sel 0.0 end
3635         $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3636         $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3637
3638         blame_showcommit $w $w_cmit $w_line $w_file $lno
3639 }
3640
3641 set blame_colors {
3642         #ff4040
3643         #ff40ff
3644         #4040ff
3645 }
3646
3647 proc blame_showcommit {w w_cmit w_line w_file lno} {
3648         global blame_colors blame_data repo_config
3649
3650         set cmit $blame_data($w,highlight_commit)
3651         if {$cmit ne {}} {
3652                 set idx $blame_data($w,$cmit,order)
3653                 set i 0
3654                 foreach c $blame_colors {
3655                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3656                         $w_line tag conf g$h -background white
3657                         $w_file tag conf g$h -background white
3658                         incr i
3659                 }
3660         }
3661
3662         $w_cmit conf -state normal
3663         $w_cmit delete 0.0 end
3664         if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3665                 set cmit {}
3666                 $w_cmit insert end "Loading annotation..."
3667         } else {
3668                 set idx $blame_data($w,$cmit,order)
3669                 set i 0
3670                 foreach c $blame_colors {
3671                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3672                         $w_line tag conf g$h -background $c
3673                         $w_file tag conf g$h -background $c
3674                         incr i
3675                 }
3676
3677                 set author_name {}
3678                 set author_email {}
3679                 set author_time {}
3680                 catch {set author_name $blame_data($w,$cmit,author)}
3681                 catch {set author_email $blame_data($w,$cmit,author-mail)}
3682                 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3683
3684                 set committer_name {}
3685                 set committer_email {}
3686                 set committer_time {}
3687                 catch {set committer_name $blame_data($w,$cmit,committer)}
3688                 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3689                 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3690
3691                 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3692                         set msg {}
3693                         catch {
3694                                 set fd [open "| git cat-file commit $cmit" r]
3695                                 fconfigure $fd -encoding binary -translation lf
3696                                 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3697                                         set enc utf-8
3698                                 }
3699                                 while {[gets $fd line] > 0} {
3700                                         if {[string match {encoding *} $line]} {
3701                                                 set enc [string tolower [string range $line 9 end]]
3702                                         }
3703                                 }
3704                                 set msg [encoding convertfrom $enc [read $fd]]
3705                                 set msg [string trim $msg]
3706                                 close $fd
3707
3708                                 set author_name [encoding convertfrom $enc $author_name]
3709                                 set committer_name [encoding convertfrom $enc $committer_name]
3710
3711                                 set blame_data($w,$cmit,author) $author_name
3712                                 set blame_data($w,$cmit,committer) $committer_name
3713                         }
3714                         set blame_data($w,$cmit,message) $msg
3715                 }
3716
3717                 $w_cmit insert end "commit $cmit\n"
3718                 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3719                 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3720                 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3721                 $w_cmit insert end "\n"
3722                 $w_cmit insert end $msg
3723         }
3724         $w_cmit conf -state disabled
3725
3726         set blame_data($w,highlight_line) $lno
3727         set blame_data($w,highlight_commit) $cmit
3728 }
3729
3730 proc blame_copycommit {w i pos} {
3731         global blame_data
3732         set lno [lindex [split [$i index $pos] .] 0]
3733         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3734                 clipboard clear
3735                 clipboard append \
3736                         -format STRING \
3737                         -type STRING \
3738                         -- $commit
3739         }
3740 }
3741
3742 ######################################################################
3743 ##
3744 ## icons
3745
3746 set filemask {
3747 #define mask_width 14
3748 #define mask_height 15
3749 static unsigned char mask_bits[] = {
3750    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3751    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3752    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3753 }
3754
3755 image create bitmap file_plain -background white -foreground black -data {
3756 #define plain_width 14
3757 #define plain_height 15
3758 static unsigned char plain_bits[] = {
3759    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3760    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3761    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3762 } -maskdata $filemask
3763
3764 image create bitmap file_mod -background white -foreground blue -data {
3765 #define mod_width 14
3766 #define mod_height 15
3767 static unsigned char mod_bits[] = {
3768    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3769    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3770    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3771 } -maskdata $filemask
3772
3773 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3774 #define file_fulltick_width 14
3775 #define file_fulltick_height 15
3776 static unsigned char file_fulltick_bits[] = {
3777    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3778    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3779    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3780 } -maskdata $filemask
3781
3782 image create bitmap file_parttick -background white -foreground "#005050" -data {
3783 #define parttick_width 14
3784 #define parttick_height 15
3785 static unsigned char parttick_bits[] = {
3786    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3787    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3788    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3789 } -maskdata $filemask
3790
3791 image create bitmap file_question -background white -foreground black -data {
3792 #define file_question_width 14
3793 #define file_question_height 15
3794 static unsigned char file_question_bits[] = {
3795    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3796    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3797    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3798 } -maskdata $filemask
3799
3800 image create bitmap file_removed -background white -foreground red -data {
3801 #define file_removed_width 14
3802 #define file_removed_height 15
3803 static unsigned char file_removed_bits[] = {
3804    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3805    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3806    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3807 } -maskdata $filemask
3808
3809 image create bitmap file_merge -background white -foreground blue -data {
3810 #define file_merge_width 14
3811 #define file_merge_height 15
3812 static unsigned char file_merge_bits[] = {
3813    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3814    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3815    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3816 } -maskdata $filemask
3817
3818 set file_dir_data {
3819 #define file_width 18
3820 #define file_height 18
3821 static unsigned char file_bits[] = {
3822   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3823   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3824   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3825   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3826   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3827 }
3828 image create bitmap file_dir -background white -foreground blue \
3829         -data $file_dir_data -maskdata $file_dir_data
3830 unset file_dir_data
3831
3832 set file_uplevel_data {
3833 #define up_width 15
3834 #define up_height 15
3835 static unsigned char up_bits[] = {
3836   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3837   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3838   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3839 }
3840 image create bitmap file_uplevel -background white -foreground red \
3841         -data $file_uplevel_data -maskdata $file_uplevel_data
3842 unset file_uplevel_data
3843
3844 set ui_index .vpane.files.index.list
3845 set ui_workdir .vpane.files.workdir.list
3846
3847 set all_icons(_$ui_index)   file_plain
3848 set all_icons(A$ui_index)   file_fulltick
3849 set all_icons(M$ui_index)   file_fulltick
3850 set all_icons(D$ui_index)   file_removed
3851 set all_icons(U$ui_index)   file_merge
3852
3853 set all_icons(_$ui_workdir) file_plain
3854 set all_icons(M$ui_workdir) file_mod
3855 set all_icons(D$ui_workdir) file_question
3856 set all_icons(U$ui_workdir) file_merge
3857 set all_icons(O$ui_workdir) file_plain
3858
3859 set max_status_desc 0
3860 foreach i {
3861                 {__ "Unmodified"}
3862
3863                 {_M "Modified, not staged"}
3864                 {M_ "Staged for commit"}
3865                 {MM "Portions staged for commit"}
3866                 {MD "Staged for commit, missing"}
3867
3868                 {_O "Untracked, not staged"}
3869                 {A_ "Staged for commit"}
3870                 {AM "Portions staged for commit"}
3871                 {AD "Staged for commit, missing"}
3872
3873                 {_D "Missing"}
3874                 {D_ "Staged for removal"}
3875                 {DO "Staged for removal, still present"}
3876
3877                 {U_ "Requires merge resolution"}
3878                 {UU "Requires merge resolution"}
3879                 {UM "Requires merge resolution"}
3880                 {UD "Requires merge resolution"}
3881         } {
3882         if {$max_status_desc < [string length [lindex $i 1]]} {
3883                 set max_status_desc [string length [lindex $i 1]]
3884         }
3885         set all_descs([lindex $i 0]) [lindex $i 1]
3886 }
3887 unset i
3888
3889 ######################################################################
3890 ##
3891 ## util
3892
3893 proc bind_button3 {w cmd} {
3894         bind $w <Any-Button-3> $cmd
3895         if {[is_MacOSX]} {
3896                 bind $w <Control-Button-1> $cmd
3897         }
3898 }
3899
3900 proc scrollbar2many {list mode args} {
3901         foreach w $list {eval $w $mode $args}
3902 }
3903
3904 proc many2scrollbar {list mode sb top bottom} {
3905         $sb set $top $bottom
3906         foreach w $list {$w $mode moveto $top}
3907 }
3908
3909 proc incr_font_size {font {amt 1}} {
3910         set sz [font configure $font -size]
3911         incr sz $amt
3912         font configure $font -size $sz
3913         font configure ${font}bold -size $sz
3914 }
3915
3916 proc hook_failed_popup {hook msg} {
3917         set w .hookfail
3918         toplevel $w
3919
3920         frame $w.m
3921         label $w.m.l1 -text "$hook hook failed:" \
3922                 -anchor w \
3923                 -justify left \
3924                 -font font_uibold
3925         text $w.m.t \
3926                 -background white -borderwidth 1 \
3927                 -relief sunken \
3928                 -width 80 -height 10 \
3929                 -font font_diff \
3930                 -yscrollcommand [list $w.m.sby set]
3931         label $w.m.l2 \
3932                 -text {You must correct the above errors before committing.} \
3933                 -anchor w \
3934                 -justify left \
3935                 -font font_uibold
3936         scrollbar $w.m.sby -command [list $w.m.t yview]
3937         pack $w.m.l1 -side top -fill x
3938         pack $w.m.l2 -side bottom -fill x
3939         pack $w.m.sby -side right -fill y
3940         pack $w.m.t -side left -fill both -expand 1
3941         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3942
3943         $w.m.t insert 1.0 $msg
3944         $w.m.t conf -state disabled
3945
3946         button $w.ok -text OK \
3947                 -width 15 \
3948                 -font font_ui \
3949                 -command "destroy $w"
3950         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3951
3952         bind $w <Visibility> "grab $w; focus $w"
3953         bind $w <Key-Return> "destroy $w"
3954         wm title $w "[appname] ([reponame]): error"
3955         tkwait window $w
3956 }
3957
3958 set next_console_id 0
3959
3960 proc new_console {short_title long_title} {
3961         global next_console_id console_data
3962         set w .console[incr next_console_id]
3963         set console_data($w) [list $short_title $long_title]
3964         return [console_init $w]
3965 }
3966
3967 proc console_init {w} {
3968         global console_cr console_data M1B
3969
3970         set console_cr($w) 1.0
3971         toplevel $w
3972         frame $w.m
3973         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3974                 -anchor w \
3975                 -justify left \
3976                 -font font_uibold
3977         text $w.m.t \
3978                 -background white -borderwidth 1 \
3979                 -relief sunken \
3980                 -width 80 -height 10 \
3981                 -font font_diff \
3982                 -state disabled \
3983                 -yscrollcommand [list $w.m.sby set]
3984         label $w.m.s -text {Working... please wait...} \
3985                 -anchor w \
3986                 -justify left \
3987                 -font font_uibold
3988         scrollbar $w.m.sby -command [list $w.m.t yview]
3989         pack $w.m.l1 -side top -fill x
3990         pack $w.m.s -side bottom -fill x
3991         pack $w.m.sby -side right -fill y
3992         pack $w.m.t -side left -fill both -expand 1
3993         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3994
3995         menu $w.ctxm -tearoff 0
3996         $w.ctxm add command -label "Copy" \
3997                 -font font_ui \
3998                 -command "tk_textCopy $w.m.t"
3999         $w.ctxm add command -label "Select All" \
4000                 -font font_ui \
4001                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
4002         $w.ctxm add command -label "Copy All" \
4003                 -font font_ui \
4004                 -command "
4005                         $w.m.t tag add sel 0.0 end
4006                         tk_textCopy $w.m.t
4007                         $w.m.t tag remove sel 0.0 end
4008                 "
4009
4010         button $w.ok -text {Close} \
4011                 -font font_ui \
4012                 -state disabled \
4013                 -command "destroy $w"
4014         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
4015
4016         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
4017         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
4018         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
4019         bind $w <Visibility> "focus $w"
4020         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
4021         return $w
4022 }
4023
4024 proc console_exec {w cmd after} {
4025         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4026         #    But most users need that so we have to relogin. :-(
4027         #
4028         if {[is_Cygwin]} {
4029                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4030         }
4031
4032         # -- Tcl won't let us redirect both stdout and stderr to
4033         #    the same pipe.  So pass it through cat...
4034         #
4035         set cmd [concat | $cmd |& cat]
4036
4037         set fd_f [open $cmd r]
4038         fconfigure $fd_f -blocking 0 -translation binary
4039         fileevent $fd_f readable [list console_read $w $fd_f $after]
4040 }
4041
4042 proc console_read {w fd after} {
4043         global console_cr
4044
4045         set buf [read $fd]
4046         if {$buf ne {}} {
4047                 if {![winfo exists $w]} {console_init $w}
4048                 $w.m.t conf -state normal
4049                 set c 0
4050                 set n [string length $buf]
4051                 while {$c < $n} {
4052                         set cr [string first "\r" $buf $c]
4053                         set lf [string first "\n" $buf $c]
4054                         if {$cr < 0} {set cr [expr {$n + 1}]}
4055                         if {$lf < 0} {set lf [expr {$n + 1}]}
4056
4057                         if {$lf < $cr} {
4058                                 $w.m.t insert end [string range $buf $c $lf]
4059                                 set console_cr($w) [$w.m.t index {end -1c}]
4060                                 set c $lf
4061                                 incr c
4062                         } else {
4063                                 $w.m.t delete $console_cr($w) end
4064                                 $w.m.t insert end "\n"
4065                                 $w.m.t insert end [string range $buf $c $cr]
4066                                 set c $cr
4067                                 incr c
4068                         }
4069                 }
4070                 $w.m.t conf -state disabled
4071                 $w.m.t see end
4072         }
4073
4074         fconfigure $fd -blocking 1
4075         if {[eof $fd]} {
4076                 if {[catch {close $fd}]} {
4077                         set ok 0
4078                 } else {
4079                         set ok 1
4080                 }
4081                 uplevel #0 $after $w $ok
4082                 return
4083         }
4084         fconfigure $fd -blocking 0
4085 }
4086
4087 proc console_chain {cmdlist w {ok 1}} {
4088         if {$ok} {
4089                 if {[llength $cmdlist] == 0} {
4090                         console_done $w $ok
4091                         return
4092                 }
4093
4094                 set cmd [lindex $cmdlist 0]
4095                 set cmdlist [lrange $cmdlist 1 end]
4096
4097                 if {[lindex $cmd 0] eq {console_exec}} {
4098                         console_exec $w \
4099                                 [lindex $cmd 1] \
4100                                 [list console_chain $cmdlist]
4101                 } else {
4102                         uplevel #0 $cmd $cmdlist $w $ok
4103                 }
4104         } else {
4105                 console_done $w $ok
4106         }
4107 }
4108
4109 proc console_done {args} {
4110         global console_cr console_data
4111
4112         switch -- [llength $args] {
4113         2 {
4114                 set w [lindex $args 0]
4115                 set ok [lindex $args 1]
4116         }
4117         3 {
4118                 set w [lindex $args 1]
4119                 set ok [lindex $args 2]
4120         }
4121         default {
4122                 error "wrong number of args: console_done ?ignored? w ok"
4123         }
4124         }
4125
4126         if {$ok} {
4127                 if {[winfo exists $w]} {
4128                         $w.m.s conf -background green -text {Success}
4129                         $w.ok conf -state normal
4130                         focus $w.ok
4131                 }
4132         } else {
4133                 if {![winfo exists $w]} {
4134                         console_init $w
4135                 }
4136                 $w.m.s conf -background red -text {Error: Command Failed}
4137                 $w.ok conf -state normal
4138                 focus $w.ok
4139         }
4140
4141         array unset console_cr $w
4142         array unset console_data $w
4143 }
4144
4145 ######################################################################
4146 ##
4147 ## ui commands
4148
4149 set starting_gitk_msg {Starting gitk... please wait...}
4150
4151 proc do_gitk {revs} {
4152         global env ui_status_value starting_gitk_msg
4153
4154         # -- Always start gitk through whatever we were loaded with.  This
4155         #    lets us bypass using shell process on Windows systems.
4156         #
4157         set cmd [list [info nameofexecutable]]
4158         lappend cmd [gitexec gitk]
4159         if {$revs ne {}} {
4160                 append cmd { }
4161                 append cmd $revs
4162         }
4163
4164         if {[catch {eval exec $cmd &} err]} {
4165                 error_popup "Failed to start gitk:\n\n$err"
4166         } else {
4167                 set ui_status_value $starting_gitk_msg
4168                 after 10000 {
4169                         if {$ui_status_value eq $starting_gitk_msg} {
4170                                 set ui_status_value {Ready.}
4171                         }
4172                 }
4173         }
4174 }
4175
4176 proc do_stats {} {
4177         set fd [open "| git count-objects -v" r]
4178         while {[gets $fd line] > 0} {
4179                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4180                         set stats($name) $value
4181                 }
4182         }
4183         close $fd
4184
4185         set packed_sz 0
4186         foreach p [glob -directory [gitdir objects pack] \
4187                 -type f \
4188                 -nocomplain -- *] {
4189                 incr packed_sz [file size $p]
4190         }
4191         if {$packed_sz > 0} {
4192                 set stats(size-pack) [expr {$packed_sz / 1024}]
4193         }
4194
4195         set w .stats_view
4196         toplevel $w
4197         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4198
4199         label $w.header -text {Database Statistics} \
4200                 -font font_uibold
4201         pack $w.header -side top -fill x
4202
4203         frame $w.buttons -border 1
4204         button $w.buttons.close -text Close \
4205                 -font font_ui \
4206                 -default active \
4207                 -command [list destroy $w]
4208         button $w.buttons.gc -text {Compress Database} \
4209                 -font font_ui \
4210                 -default normal \
4211                 -command "destroy $w;do_gc"
4212         pack $w.buttons.close -side right
4213         pack $w.buttons.gc -side left
4214         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4215
4216         frame $w.stat -borderwidth 1 -relief solid
4217         foreach s {
4218                 {count           {Number of loose objects}}
4219                 {size            {Disk space used by loose objects} { KiB}}
4220                 {in-pack         {Number of packed objects}}
4221                 {packs           {Number of packs}}
4222                 {size-pack       {Disk space used by packed objects} { KiB}}
4223                 {prune-packable  {Packed objects waiting for pruning}}
4224                 {garbage         {Garbage files}}
4225                 } {
4226                 set name [lindex $s 0]
4227                 set label [lindex $s 1]
4228                 if {[catch {set value $stats($name)}]} continue
4229                 if {[llength $s] > 2} {
4230                         set value "$value[lindex $s 2]"
4231                 }
4232
4233                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4234                 label $w.stat.v_$name -text $value -anchor w -font font_ui
4235                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4236         }
4237         pack $w.stat -pady 10 -padx 10
4238
4239         bind $w <Visibility> "grab $w; focus $w.buttons.close"
4240         bind $w <Key-Escape> [list destroy $w]
4241         bind $w <Key-Return> [list destroy $w]
4242         wm title $w "[appname] ([reponame]): Database Statistics"
4243         tkwait window $w
4244 }
4245
4246 proc do_gc {} {
4247         set w [new_console {gc} {Compressing the object database}]
4248         console_chain {
4249                 {console_exec {git pack-refs --prune}}
4250                 {console_exec {git reflog expire --all}}
4251                 {console_exec {git repack -a -d -l}}
4252                 {console_exec {git rerere gc}}
4253         } $w
4254 }
4255
4256 proc do_fsck_objects {} {
4257         set w [new_console {fsck-objects} \
4258                 {Verifying the object database with fsck-objects}]
4259         set cmd [list git fsck-objects]
4260         lappend cmd --full
4261         lappend cmd --cache
4262         lappend cmd --strict
4263         console_exec $w $cmd console_done
4264 }
4265
4266 set is_quitting 0
4267
4268 proc do_quit {} {
4269         global ui_comm is_quitting repo_config commit_type
4270
4271         if {$is_quitting} return
4272         set is_quitting 1
4273
4274         if {[winfo exists $ui_comm]} {
4275                 # -- Stash our current commit buffer.
4276                 #
4277                 set save [gitdir GITGUI_MSG]
4278                 set msg [string trim [$ui_comm get 0.0 end]]
4279                 regsub -all -line {[ \r\t]+$} $msg {} msg
4280                 if {(![string match amend* $commit_type]
4281                         || [$ui_comm edit modified])
4282                         && $msg ne {}} {
4283                         catch {
4284                                 set fd [open $save w]
4285                                 puts -nonewline $fd $msg
4286                                 close $fd
4287                         }
4288                 } else {
4289                         catch {file delete $save}
4290                 }
4291
4292                 # -- Stash our current window geometry into this repository.
4293                 #
4294                 set cfg_geometry [list]
4295                 lappend cfg_geometry [wm geometry .]
4296                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4297                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4298                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4299                         set rc_geometry {}
4300                 }
4301                 if {$cfg_geometry ne $rc_geometry} {
4302                         catch {git config gui.geometry $cfg_geometry}
4303                 }
4304         }
4305
4306         destroy .
4307 }
4308
4309 proc do_rescan {} {
4310         rescan {set ui_status_value {Ready.}}
4311 }
4312
4313 proc unstage_helper {txt paths} {
4314         global file_states current_diff_path
4315
4316         if {![lock_index begin-update]} return
4317
4318         set pathList [list]
4319         set after {}
4320         foreach path $paths {
4321                 switch -glob -- [lindex $file_states($path) 0] {
4322                 A? -
4323                 M? -
4324                 D? {
4325                         lappend pathList $path
4326                         if {$path eq $current_diff_path} {
4327                                 set after {reshow_diff;}
4328                         }
4329                 }
4330                 }
4331         }
4332         if {$pathList eq {}} {
4333                 unlock_index
4334         } else {
4335                 update_indexinfo \
4336                         $txt \
4337                         $pathList \
4338                         [concat $after {set ui_status_value {Ready.}}]
4339         }
4340 }
4341
4342 proc do_unstage_selection {} {
4343         global current_diff_path selected_paths
4344
4345         if {[array size selected_paths] > 0} {
4346                 unstage_helper \
4347                         {Unstaging selected files from commit} \
4348                         [array names selected_paths]
4349         } elseif {$current_diff_path ne {}} {
4350                 unstage_helper \
4351                         "Unstaging [short_path $current_diff_path] from commit" \
4352                         [list $current_diff_path]
4353         }
4354 }
4355
4356 proc add_helper {txt paths} {
4357         global file_states current_diff_path
4358
4359         if {![lock_index begin-update]} return
4360
4361         set pathList [list]
4362         set after {}
4363         foreach path $paths {
4364                 switch -glob -- [lindex $file_states($path) 0] {
4365                 _O -
4366                 ?M -
4367                 ?D -
4368                 U? {
4369                         lappend pathList $path
4370                         if {$path eq $current_diff_path} {
4371                                 set after {reshow_diff;}
4372                         }
4373                 }
4374                 }
4375         }
4376         if {$pathList eq {}} {
4377                 unlock_index
4378         } else {
4379                 update_index \
4380                         $txt \
4381                         $pathList \
4382                         [concat $after {set ui_status_value {Ready to commit.}}]
4383         }
4384 }
4385
4386 proc do_add_selection {} {
4387         global current_diff_path selected_paths
4388
4389         if {[array size selected_paths] > 0} {
4390                 add_helper \
4391                         {Adding selected files} \
4392                         [array names selected_paths]
4393         } elseif {$current_diff_path ne {}} {
4394                 add_helper \
4395                         "Adding [short_path $current_diff_path]" \
4396                         [list $current_diff_path]
4397         }
4398 }
4399
4400 proc do_add_all {} {
4401         global file_states
4402
4403         set paths [list]
4404         foreach path [array names file_states] {
4405                 switch -glob -- [lindex $file_states($path) 0] {
4406                 U? {continue}
4407                 ?M -
4408                 ?D {lappend paths $path}
4409                 }
4410         }
4411         add_helper {Adding all changed files} $paths
4412 }
4413
4414 proc revert_helper {txt paths} {
4415         global file_states current_diff_path
4416
4417         if {![lock_index begin-update]} return
4418
4419         set pathList [list]
4420         set after {}
4421         foreach path $paths {
4422                 switch -glob -- [lindex $file_states($path) 0] {
4423                 U? {continue}
4424                 ?M -
4425                 ?D {
4426                         lappend pathList $path
4427                         if {$path eq $current_diff_path} {
4428                                 set after {reshow_diff;}
4429                         }
4430                 }
4431                 }
4432         }
4433
4434         set n [llength $pathList]
4435         if {$n == 0} {
4436                 unlock_index
4437                 return
4438         } elseif {$n == 1} {
4439                 set s "[short_path [lindex $pathList]]"
4440         } else {
4441                 set s "these $n files"
4442         }
4443
4444         set reply [tk_dialog \
4445                 .confirm_revert \
4446                 "[appname] ([reponame])" \
4447                 "Revert changes in $s?
4448
4449 Any unadded changes will be permanently lost by the revert." \
4450                 question \
4451                 1 \
4452                 {Do Nothing} \
4453                 {Revert Changes} \
4454                 ]
4455         if {$reply == 1} {
4456                 checkout_index \
4457                         $txt \
4458                         $pathList \
4459                         [concat $after {set ui_status_value {Ready.}}]
4460         } else {
4461                 unlock_index
4462         }
4463 }
4464
4465 proc do_revert_selection {} {
4466         global current_diff_path selected_paths
4467
4468         if {[array size selected_paths] > 0} {
4469                 revert_helper \
4470                         {Reverting selected files} \
4471                         [array names selected_paths]
4472         } elseif {$current_diff_path ne {}} {
4473                 revert_helper \
4474                         "Reverting [short_path $current_diff_path]" \
4475                         [list $current_diff_path]
4476         }
4477 }
4478
4479 proc do_signoff {} {
4480         global ui_comm
4481
4482         set me [committer_ident]
4483         if {$me eq {}} return
4484
4485         set sob "Signed-off-by: $me"
4486         set last [$ui_comm get {end -1c linestart} {end -1c}]
4487         if {$last ne $sob} {
4488                 $ui_comm edit separator
4489                 if {$last ne {}
4490                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4491                         $ui_comm insert end "\n"
4492                 }
4493                 $ui_comm insert end "\n$sob"
4494                 $ui_comm edit separator
4495                 $ui_comm see end
4496         }
4497 }
4498
4499 proc do_select_commit_type {} {
4500         global commit_type selected_commit_type
4501
4502         if {$selected_commit_type eq {new}
4503                 && [string match amend* $commit_type]} {
4504                 create_new_commit
4505         } elseif {$selected_commit_type eq {amend}
4506                 && ![string match amend* $commit_type]} {
4507                 load_last_commit
4508
4509                 # The amend request was rejected...
4510                 #
4511                 if {![string match amend* $commit_type]} {
4512                         set selected_commit_type new
4513                 }
4514         }
4515 }
4516
4517 proc do_commit {} {
4518         commit_tree
4519 }
4520
4521 proc do_about {} {
4522         global appvers copyright
4523         global tcl_patchLevel tk_patchLevel
4524
4525         set w .about_dialog
4526         toplevel $w
4527         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4528
4529         label $w.header -text "About [appname]" \
4530                 -font font_uibold
4531         pack $w.header -side top -fill x
4532
4533         frame $w.buttons
4534         button $w.buttons.close -text {Close} \
4535                 -font font_ui \
4536                 -default active \
4537                 -command [list destroy $w]
4538         pack $w.buttons.close -side right
4539         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4540
4541         label $w.desc \
4542                 -text "git-gui - a graphical user interface for Git.
4543 $copyright" \
4544                 -padx 5 -pady 5 \
4545                 -justify left \
4546                 -anchor w \
4547                 -borderwidth 1 \
4548                 -relief solid \
4549                 -font font_ui
4550         pack $w.desc -side top -fill x -padx 5 -pady 5
4551
4552         set v {}
4553         append v "git-gui version $appvers\n"
4554         append v "[git version]\n"
4555         append v "\n"
4556         if {$tcl_patchLevel eq $tk_patchLevel} {
4557                 append v "Tcl/Tk version $tcl_patchLevel"
4558         } else {
4559                 append v "Tcl version $tcl_patchLevel"
4560                 append v ", Tk version $tk_patchLevel"
4561         }
4562
4563         label $w.vers \
4564                 -text $v \
4565                 -padx 5 -pady 5 \
4566                 -justify left \
4567                 -anchor w \
4568                 -borderwidth 1 \
4569                 -relief solid \
4570                 -font font_ui
4571         pack $w.vers -side top -fill x -padx 5 -pady 5
4572
4573         menu $w.ctxm -tearoff 0
4574         $w.ctxm add command \
4575                 -label {Copy} \
4576                 -font font_ui \
4577                 -command "
4578                 clipboard clear
4579                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4580         "
4581
4582         bind $w <Visibility> "grab $w; focus $w.buttons.close"
4583         bind $w <Key-Escape> "destroy $w"
4584         bind $w <Key-Return> "destroy $w"
4585         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4586         wm title $w "About [appname]"
4587         tkwait window $w
4588 }
4589
4590 proc do_options {} {
4591         global repo_config global_config font_descs
4592         global repo_config_new global_config_new
4593
4594         array unset repo_config_new
4595         array unset global_config_new
4596         foreach name [array names repo_config] {
4597                 set repo_config_new($name) $repo_config($name)
4598         }
4599         load_config 1
4600         foreach name [array names repo_config] {
4601                 switch -- $name {
4602                 gui.diffcontext {continue}
4603                 }
4604                 set repo_config_new($name) $repo_config($name)
4605         }
4606         foreach name [array names global_config] {
4607                 set global_config_new($name) $global_config($name)
4608         }
4609
4610         set w .options_editor
4611         toplevel $w
4612         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4613
4614         label $w.header -text "Options" \
4615                 -font font_uibold
4616         pack $w.header -side top -fill x
4617
4618         frame $w.buttons
4619         button $w.buttons.restore -text {Restore Defaults} \
4620                 -font font_ui \
4621                 -default normal \
4622                 -command do_restore_defaults
4623         pack $w.buttons.restore -side left
4624         button $w.buttons.save -text Save \
4625                 -font font_ui \
4626                 -default active \
4627                 -command [list do_save_config $w]
4628         pack $w.buttons.save -side right
4629         button $w.buttons.cancel -text {Cancel} \
4630                 -font font_ui \
4631                 -default normal \
4632                 -command [list destroy $w]
4633         pack $w.buttons.cancel -side right -padx 5
4634         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4635
4636         labelframe $w.repo -text "[reponame] Repository" \
4637                 -font font_ui
4638         labelframe $w.global -text {Global (All Repositories)} \
4639                 -font font_ui
4640         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4641         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4642
4643         set optid 0
4644         foreach option {
4645                 {t user.name {User Name}}
4646                 {t user.email {Email Address}}
4647
4648                 {b merge.summary {Summarize Merge Commits}}
4649                 {i-1..5 merge.verbosity {Merge Verbosity}}
4650
4651                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4652                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4653                 {t gui.newbranchtemplate {New Branch Name Template}}
4654                 } {
4655                 set type [lindex $option 0]
4656                 set name [lindex $option 1]
4657                 set text [lindex $option 2]
4658                 incr optid
4659                 foreach f {repo global} {
4660                         switch -glob -- $type {
4661                         b {
4662                                 checkbutton $w.$f.$optid -text $text \
4663                                         -variable ${f}_config_new($name) \
4664                                         -onvalue true \
4665                                         -offvalue false \
4666                                         -font font_ui
4667                                 pack $w.$f.$optid -side top -anchor w
4668                         }
4669                         i-* {
4670                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4671                                 frame $w.$f.$optid
4672                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4673                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4674                                 spinbox $w.$f.$optid.v \
4675                                         -textvariable ${f}_config_new($name) \
4676                                         -from $min \
4677                                         -to $max \
4678                                         -increment 1 \
4679                                         -width [expr {1 + [string length $max]}] \
4680                                         -font font_ui
4681                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4682                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4683                                 pack $w.$f.$optid -side top -anchor w -fill x
4684                         }
4685                         t {
4686                                 frame $w.$f.$optid
4687                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4688                                 entry $w.$f.$optid.v \
4689                                         -borderwidth 1 \
4690                                         -relief sunken \
4691                                         -width 20 \
4692                                         -textvariable ${f}_config_new($name) \
4693                                         -font font_ui
4694                                 pack $w.$f.$optid.l -side left -anchor w
4695                                 pack $w.$f.$optid.v -side left -anchor w \
4696                                         -fill x -expand 1 \
4697                                         -padx 5
4698                                 pack $w.$f.$optid -side top -anchor w -fill x
4699                         }
4700                         }
4701                 }
4702         }
4703
4704         set all_fonts [lsort [font families]]
4705         foreach option $font_descs {
4706                 set name [lindex $option 0]
4707                 set font [lindex $option 1]
4708                 set text [lindex $option 2]
4709
4710                 set global_config_new(gui.$font^^family) \
4711                         [font configure $font -family]
4712                 set global_config_new(gui.$font^^size) \
4713                         [font configure $font -size]
4714
4715                 frame $w.global.$name
4716                 label $w.global.$name.l -text "$text:" -font font_ui
4717                 pack $w.global.$name.l -side left -anchor w -fill x
4718                 set fontmenu [eval tk_optionMenu $w.global.$name.family \
4719                         global_config_new(gui.$font^^family) \
4720                         $all_fonts]
4721                 $w.global.$name.family configure -font font_ui
4722                 $fontmenu configure -font font_ui
4723                 spinbox $w.global.$name.size \
4724                         -textvariable global_config_new(gui.$font^^size) \
4725                         -from 2 -to 80 -increment 1 \
4726                         -width 3 \
4727                         -font font_ui
4728                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4729                 pack $w.global.$name.size -side right -anchor e
4730                 pack $w.global.$name.family -side right -anchor e
4731                 pack $w.global.$name -side top -anchor w -fill x
4732         }
4733
4734         bind $w <Visibility> "grab $w; focus $w.buttons.save"
4735         bind $w <Key-Escape> "destroy $w"
4736         bind $w <Key-Return> [list do_save_config $w]
4737         wm title $w "[appname] ([reponame]): Options"
4738         tkwait window $w
4739 }
4740
4741 proc do_restore_defaults {} {
4742         global font_descs default_config repo_config
4743         global repo_config_new global_config_new
4744
4745         foreach name [array names default_config] {
4746                 set repo_config_new($name) $default_config($name)
4747                 set global_config_new($name) $default_config($name)
4748         }
4749
4750         foreach option $font_descs {
4751                 set name [lindex $option 0]
4752                 set repo_config(gui.$name) $default_config(gui.$name)
4753         }
4754         apply_config
4755
4756         foreach option $font_descs {
4757                 set name [lindex $option 0]
4758                 set font [lindex $option 1]
4759                 set global_config_new(gui.$font^^family) \
4760                         [font configure $font -family]
4761                 set global_config_new(gui.$font^^size) \
4762                         [font configure $font -size]
4763         }
4764 }
4765
4766 proc do_save_config {w} {
4767         if {[catch {save_config} err]} {
4768                 error_popup "Failed to completely save options:\n\n$err"
4769         }
4770         reshow_diff
4771         destroy $w
4772 }
4773
4774 proc do_windows_shortcut {} {
4775         global argv0
4776
4777         set fn [tk_getSaveFile \
4778                 -parent . \
4779                 -title "[appname] ([reponame]): Create Desktop Icon" \
4780                 -initialfile "Git [reponame].bat"]
4781         if {$fn != {}} {
4782                 if {[catch {
4783                                 set fd [open $fn w]
4784                                 puts $fd "@ECHO Entering [reponame]"
4785                                 puts $fd "@ECHO Starting git-gui... please wait..."
4786                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4787                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4788                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4789                                 puts $fd " \"[file normalize $argv0]\""
4790                                 close $fd
4791                         } err]} {
4792                         error_popup "Cannot write script:\n\n$err"
4793                 }
4794         }
4795 }
4796
4797 proc do_cygwin_shortcut {} {
4798         global argv0
4799
4800         if {[catch {
4801                 set desktop [exec cygpath \
4802                         --windows \
4803                         --absolute \
4804                         --long-name \
4805                         --desktop]
4806                 }]} {
4807                         set desktop .
4808         }
4809         set fn [tk_getSaveFile \
4810                 -parent . \
4811                 -title "[appname] ([reponame]): Create Desktop Icon" \
4812                 -initialdir $desktop \
4813                 -initialfile "Git [reponame].bat"]
4814         if {$fn != {}} {
4815                 if {[catch {
4816                                 set fd [open $fn w]
4817                                 set sh [exec cygpath \
4818                                         --windows \
4819                                         --absolute \
4820                                         /bin/sh]
4821                                 set me [exec cygpath \
4822                                         --unix \
4823                                         --absolute \
4824                                         $argv0]
4825                                 set gd [exec cygpath \
4826                                         --unix \
4827                                         --absolute \
4828                                         [gitdir]]
4829                                 set gw [exec cygpath \
4830                                         --windows \
4831                                         --absolute \
4832                                         [file dirname [gitdir]]]
4833                                 regsub -all ' $me "'\\''" me
4834                                 regsub -all ' $gd "'\\''" gd
4835                                 puts $fd "@ECHO Entering $gw"
4836                                 puts $fd "@ECHO Starting git-gui... please wait..."
4837                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4838                                 puts -nonewline $fd "GIT_DIR='$gd'"
4839                                 puts -nonewline $fd " '$me'"
4840                                 puts $fd "&\""
4841                                 close $fd
4842                         } err]} {
4843                         error_popup "Cannot write script:\n\n$err"
4844                 }
4845         }
4846 }
4847
4848 proc do_macosx_app {} {
4849         global argv0 env
4850
4851         set fn [tk_getSaveFile \
4852                 -parent . \
4853                 -title "[appname] ([reponame]): Create Desktop Icon" \
4854                 -initialdir [file join $env(HOME) Desktop] \
4855                 -initialfile "Git [reponame].app"]
4856         if {$fn != {}} {
4857                 if {[catch {
4858                                 set Contents [file join $fn Contents]
4859                                 set MacOS [file join $Contents MacOS]
4860                                 set exe [file join $MacOS git-gui]
4861
4862                                 file mkdir $MacOS
4863
4864                                 set fd [open [file join $Contents Info.plist] w]
4865                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4866 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4867 <plist version="1.0">
4868 <dict>
4869         <key>CFBundleDevelopmentRegion</key>
4870         <string>English</string>
4871         <key>CFBundleExecutable</key>
4872         <string>git-gui</string>
4873         <key>CFBundleIdentifier</key>
4874         <string>org.spearce.git-gui</string>
4875         <key>CFBundleInfoDictionaryVersion</key>
4876         <string>6.0</string>
4877         <key>CFBundlePackageType</key>
4878         <string>APPL</string>
4879         <key>CFBundleSignature</key>
4880         <string>????</string>
4881         <key>CFBundleVersion</key>
4882         <string>1.0</string>
4883         <key>NSPrincipalClass</key>
4884         <string>NSApplication</string>
4885 </dict>
4886 </plist>}
4887                                 close $fd
4888
4889                                 set fd [open $exe w]
4890                                 set gd [file normalize [gitdir]]
4891                                 set ep [file normalize [gitexec]]
4892                                 regsub -all ' $gd "'\\''" gd
4893                                 regsub -all ' $ep "'\\''" ep
4894                                 puts $fd "#!/bin/sh"
4895                                 foreach name [array names env] {
4896                                         if {[string match GIT_* $name]} {
4897                                                 regsub -all ' $env($name) "'\\''" v
4898                                                 puts $fd "export $name='$v'"
4899                                         }
4900                                 }
4901                                 puts $fd "export PATH='$ep':\$PATH"
4902                                 puts $fd "export GIT_DIR='$gd'"
4903                                 puts $fd "exec [file normalize $argv0]"
4904                                 close $fd
4905
4906                                 file attributes $exe -permissions u+x,g+x,o+x
4907                         } err]} {
4908                         error_popup "Cannot write icon:\n\n$err"
4909                 }
4910         }
4911 }
4912
4913 proc toggle_or_diff {w x y} {
4914         global file_states file_lists current_diff_path ui_index ui_workdir
4915         global last_clicked selected_paths
4916
4917         set pos [split [$w index @$x,$y] .]
4918         set lno [lindex $pos 0]
4919         set col [lindex $pos 1]
4920         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4921         if {$path eq {}} {
4922                 set last_clicked {}
4923                 return
4924         }
4925
4926         set last_clicked [list $w $lno]
4927         array unset selected_paths
4928         $ui_index tag remove in_sel 0.0 end
4929         $ui_workdir tag remove in_sel 0.0 end
4930
4931         if {$col == 0} {
4932                 if {$current_diff_path eq $path} {
4933                         set after {reshow_diff;}
4934                 } else {
4935                         set after {}
4936                 }
4937                 if {$w eq $ui_index} {
4938                         update_indexinfo \
4939                                 "Unstaging [short_path $path] from commit" \
4940                                 [list $path] \
4941                                 [concat $after {set ui_status_value {Ready.}}]
4942                 } elseif {$w eq $ui_workdir} {
4943                         update_index \
4944                                 "Adding [short_path $path]" \
4945                                 [list $path] \
4946                                 [concat $after {set ui_status_value {Ready.}}]
4947                 }
4948         } else {
4949                 show_diff $path $w $lno
4950         }
4951 }
4952
4953 proc add_one_to_selection {w x y} {
4954         global file_lists last_clicked selected_paths
4955
4956         set lno [lindex [split [$w index @$x,$y] .] 0]
4957         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4958         if {$path eq {}} {
4959                 set last_clicked {}
4960                 return
4961         }
4962
4963         if {$last_clicked ne {}
4964                 && [lindex $last_clicked 0] ne $w} {
4965                 array unset selected_paths
4966                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4967         }
4968
4969         set last_clicked [list $w $lno]
4970         if {[catch {set in_sel $selected_paths($path)}]} {
4971                 set in_sel 0
4972         }
4973         if {$in_sel} {
4974                 unset selected_paths($path)
4975                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4976         } else {
4977                 set selected_paths($path) 1
4978                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4979         }
4980 }
4981
4982 proc add_range_to_selection {w x y} {
4983         global file_lists last_clicked selected_paths
4984
4985         if {[lindex $last_clicked 0] ne $w} {
4986                 toggle_or_diff $w $x $y
4987                 return
4988         }
4989
4990         set lno [lindex [split [$w index @$x,$y] .] 0]
4991         set lc [lindex $last_clicked 1]
4992         if {$lc < $lno} {
4993                 set begin $lc
4994                 set end $lno
4995         } else {
4996                 set begin $lno
4997                 set end $lc
4998         }
4999
5000         foreach path [lrange $file_lists($w) \
5001                 [expr {$begin - 1}] \
5002                 [expr {$end - 1}]] {
5003                 set selected_paths($path) 1
5004         }
5005         $w tag add in_sel $begin.0 [expr {$end + 1}].0
5006 }
5007
5008 ######################################################################
5009 ##
5010 ## config defaults
5011
5012 set cursor_ptr arrow
5013 font create font_diff -family Courier -size 10
5014 font create font_ui
5015 catch {
5016         label .dummy
5017         eval font configure font_ui [font actual [.dummy cget -font]]
5018         destroy .dummy
5019 }
5020
5021 font create font_uibold
5022 font create font_diffbold
5023
5024 if {[is_Windows]} {
5025         set M1B Control
5026         set M1T Ctrl
5027 } elseif {[is_MacOSX]} {
5028         set M1B M1
5029         set M1T Cmd
5030 } else {
5031         set M1B M1
5032         set M1T M1
5033 }
5034
5035 proc apply_config {} {
5036         global repo_config font_descs
5037
5038         foreach option $font_descs {
5039                 set name [lindex $option 0]
5040                 set font [lindex $option 1]
5041                 if {[catch {
5042                         foreach {cn cv} $repo_config(gui.$name) {
5043                                 font configure $font $cn $cv
5044                         }
5045                         } err]} {
5046                         error_popup "Invalid font specified in gui.$name:\n\n$err"
5047                 }
5048                 foreach {cn cv} [font configure $font] {
5049                         font configure ${font}bold $cn $cv
5050                 }
5051                 font configure ${font}bold -weight bold
5052         }
5053 }
5054
5055 set default_config(merge.summary) false
5056 set default_config(merge.verbosity) 2
5057 set default_config(user.name) {}
5058 set default_config(user.email) {}
5059
5060 set default_config(gui.trustmtime) false
5061 set default_config(gui.diffcontext) 5
5062 set default_config(gui.newbranchtemplate) {}
5063 set default_config(gui.fontui) [font configure font_ui]
5064 set default_config(gui.fontdiff) [font configure font_diff]
5065 set font_descs {
5066         {fontui   font_ui   {Main Font}}
5067         {fontdiff font_diff {Diff/Console Font}}
5068 }
5069 load_config 0
5070 apply_config
5071
5072 ######################################################################
5073 ##
5074 ## feature option selection
5075
5076 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5077         unset _junk
5078 } else {
5079         set subcommand gui
5080 }
5081 if {$subcommand eq {gui.sh}} {
5082         set subcommand gui
5083 }
5084 if {$subcommand eq {gui} && [llength $argv] > 0} {
5085         set subcommand [lindex $argv 0]
5086         set argv [lrange $argv 1 end]
5087 }
5088
5089 enable_option multicommit
5090 enable_option branch
5091 enable_option transport
5092
5093 switch -- $subcommand {
5094 browser -
5095 blame {
5096         disable_option multicommit
5097         disable_option branch
5098         disable_option transport
5099 }
5100 citool {
5101         enable_option singlecommit
5102
5103         disable_option multicommit
5104         disable_option branch
5105         disable_option transport
5106 }
5107 }
5108
5109 ######################################################################
5110 ##
5111 ## ui construction
5112
5113 set ui_comm {}
5114
5115 # -- Menu Bar
5116 #
5117 menu .mbar -tearoff 0
5118 .mbar add cascade -label Repository -menu .mbar.repository -font font_ui
5119 .mbar add cascade -label Edit -menu .mbar.edit -font font_ui
5120 if {[is_enabled branch]} {
5121         .mbar add cascade -label Branch -menu .mbar.branch -font font_ui
5122 }
5123 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5124         .mbar add cascade -label Commit -menu .mbar.commit -font font_ui
5125 }
5126 if {[is_enabled transport]} {
5127         .mbar add cascade -label Merge -menu .mbar.merge -font font_ui
5128         .mbar add cascade -label Fetch -menu .mbar.fetch -font font_ui
5129         .mbar add cascade -label Push -menu .mbar.push -font font_ui
5130 }
5131 . configure -menu .mbar
5132
5133 # -- Repository Menu
5134 #
5135 menu .mbar.repository
5136
5137 .mbar.repository add command \
5138         -label {Browse Current Branch} \
5139         -command {new_browser $current_branch} \
5140         -font font_ui
5141 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5142 .mbar.repository add separator
5143
5144 .mbar.repository add command \
5145         -label {Visualize Current Branch} \
5146         -command {do_gitk $current_branch} \
5147         -font font_ui
5148 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5149 .mbar.repository add command \
5150         -label {Visualize All Branches} \
5151         -command {do_gitk --all} \
5152         -font font_ui
5153 .mbar.repository add separator
5154
5155 if {[is_enabled multicommit]} {
5156         .mbar.repository add command -label {Database Statistics} \
5157                 -command do_stats \
5158                 -font font_ui
5159
5160         .mbar.repository add command -label {Compress Database} \
5161                 -command do_gc \
5162                 -font font_ui
5163
5164         .mbar.repository add command -label {Verify Database} \
5165                 -command do_fsck_objects \
5166                 -font font_ui
5167
5168         .mbar.repository add separator
5169
5170         if {[is_Cygwin]} {
5171                 .mbar.repository add command \
5172                         -label {Create Desktop Icon} \
5173                         -command do_cygwin_shortcut \
5174                         -font font_ui
5175         } elseif {[is_Windows]} {
5176                 .mbar.repository add command \
5177                         -label {Create Desktop Icon} \
5178                         -command do_windows_shortcut \
5179                         -font font_ui
5180         } elseif {[is_MacOSX]} {
5181                 .mbar.repository add command \
5182                         -label {Create Desktop Icon} \
5183                         -command do_macosx_app \
5184                         -font font_ui
5185         }
5186 }
5187
5188 .mbar.repository add command -label Quit \
5189         -command do_quit \
5190         -accelerator $M1T-Q \
5191         -font font_ui
5192
5193 # -- Edit Menu
5194 #
5195 menu .mbar.edit
5196 .mbar.edit add command -label Undo \
5197         -command {catch {[focus] edit undo}} \
5198         -accelerator $M1T-Z \
5199         -font font_ui
5200 .mbar.edit add command -label Redo \
5201         -command {catch {[focus] edit redo}} \
5202         -accelerator $M1T-Y \
5203         -font font_ui
5204 .mbar.edit add separator
5205 .mbar.edit add command -label Cut \
5206         -command {catch {tk_textCut [focus]}} \
5207         -accelerator $M1T-X \
5208         -font font_ui
5209 .mbar.edit add command -label Copy \
5210         -command {catch {tk_textCopy [focus]}} \
5211         -accelerator $M1T-C \
5212         -font font_ui
5213 .mbar.edit add command -label Paste \
5214         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5215         -accelerator $M1T-V \
5216         -font font_ui
5217 .mbar.edit add command -label Delete \
5218         -command {catch {[focus] delete sel.first sel.last}} \
5219         -accelerator Del \
5220         -font font_ui
5221 .mbar.edit add separator
5222 .mbar.edit add command -label {Select All} \
5223         -command {catch {[focus] tag add sel 0.0 end}} \
5224         -accelerator $M1T-A \
5225         -font font_ui
5226
5227 # -- Branch Menu
5228 #
5229 if {[is_enabled branch]} {
5230         menu .mbar.branch
5231
5232         .mbar.branch add command -label {Create...} \
5233                 -command do_create_branch \
5234                 -accelerator $M1T-N \
5235                 -font font_ui
5236         lappend disable_on_lock [list .mbar.branch entryconf \
5237                 [.mbar.branch index last] -state]
5238
5239         .mbar.branch add command -label {Delete...} \
5240                 -command do_delete_branch \
5241                 -font font_ui
5242         lappend disable_on_lock [list .mbar.branch entryconf \
5243                 [.mbar.branch index last] -state]
5244
5245         .mbar.branch add command -label {Reset...} \
5246                 -command do_reset_hard \
5247                 -font font_ui
5248         lappend disable_on_lock [list .mbar.branch entryconf \
5249                 [.mbar.branch index last] -state]
5250 }
5251
5252 # -- Commit Menu
5253 #
5254 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5255         menu .mbar.commit
5256
5257         .mbar.commit add radiobutton \
5258                 -label {New Commit} \
5259                 -command do_select_commit_type \
5260                 -variable selected_commit_type \
5261                 -value new \
5262                 -font font_ui
5263         lappend disable_on_lock \
5264                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5265
5266         .mbar.commit add radiobutton \
5267                 -label {Amend Last Commit} \
5268                 -command do_select_commit_type \
5269                 -variable selected_commit_type \
5270                 -value amend \
5271                 -font font_ui
5272         lappend disable_on_lock \
5273                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5274
5275         .mbar.commit add separator
5276
5277         .mbar.commit add command -label Rescan \
5278                 -command do_rescan \
5279                 -accelerator F5 \
5280                 -font font_ui
5281         lappend disable_on_lock \
5282                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5283
5284         .mbar.commit add command -label {Add To Commit} \
5285                 -command do_add_selection \
5286                 -font font_ui
5287         lappend disable_on_lock \
5288                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5289
5290         .mbar.commit add command -label {Add Existing To Commit} \
5291                 -command do_add_all \
5292                 -accelerator $M1T-I \
5293                 -font font_ui
5294         lappend disable_on_lock \
5295                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5296
5297         .mbar.commit add command -label {Unstage From Commit} \
5298                 -command do_unstage_selection \
5299                 -font font_ui
5300         lappend disable_on_lock \
5301                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5302
5303         .mbar.commit add command -label {Revert Changes} \
5304                 -command do_revert_selection \
5305                 -font font_ui
5306         lappend disable_on_lock \
5307                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5308
5309         .mbar.commit add separator
5310
5311         .mbar.commit add command -label {Sign Off} \
5312                 -command do_signoff \
5313                 -accelerator $M1T-S \
5314                 -font font_ui
5315
5316         .mbar.commit add command -label Commit \
5317                 -command do_commit \
5318                 -accelerator $M1T-Return \
5319                 -font font_ui
5320         lappend disable_on_lock \
5321                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5322 }
5323
5324 # -- Merge Menu
5325 #
5326 if {[is_enabled branch]} {
5327         menu .mbar.merge
5328         .mbar.merge add command -label {Local Merge...} \
5329                 -command do_local_merge \
5330                 -font font_ui
5331         lappend disable_on_lock \
5332                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5333         .mbar.merge add command -label {Abort Merge...} \
5334                 -command do_reset_hard \
5335                 -font font_ui
5336         lappend disable_on_lock \
5337                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5338
5339 }
5340
5341 # -- Transport Menu
5342 #
5343 if {[is_enabled transport]} {
5344         menu .mbar.fetch
5345
5346         menu .mbar.push
5347         .mbar.push add command -label {Push...} \
5348                 -command do_push_anywhere \
5349                 -font font_ui
5350 }
5351
5352 if {[is_MacOSX]} {
5353         # -- Apple Menu (Mac OS X only)
5354         #
5355         .mbar add cascade -label Apple -menu .mbar.apple
5356         menu .mbar.apple
5357
5358         .mbar.apple add command -label "About [appname]" \
5359                 -command do_about \
5360                 -font font_ui
5361         .mbar.apple add command -label "Options..." \
5362                 -command do_options \
5363                 -font font_ui
5364 } else {
5365         # -- Edit Menu
5366         #
5367         .mbar.edit add separator
5368         .mbar.edit add command -label {Options...} \
5369                 -command do_options \
5370                 -font font_ui
5371
5372         # -- Tools Menu
5373         #
5374         if {[file exists /usr/local/miga/lib/gui-miga]
5375                 && [file exists .pvcsrc]} {
5376         proc do_miga {} {
5377                 global ui_status_value
5378                 if {![lock_index update]} return
5379                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5380                 set miga_fd [open "|$cmd" r]
5381                 fconfigure $miga_fd -blocking 0
5382                 fileevent $miga_fd readable [list miga_done $miga_fd]
5383                 set ui_status_value {Running miga...}
5384         }
5385         proc miga_done {fd} {
5386                 read $fd 512
5387                 if {[eof $fd]} {
5388                         close $fd
5389                         unlock_index
5390                         rescan [list set ui_status_value {Ready.}]
5391                 }
5392         }
5393         .mbar add cascade -label Tools -menu .mbar.tools
5394         menu .mbar.tools
5395         .mbar.tools add command -label "Migrate" \
5396                 -command do_miga \
5397                 -font font_ui
5398         lappend disable_on_lock \
5399                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5400         }
5401 }
5402
5403 # -- Help Menu
5404 #
5405 .mbar add cascade -label Help -menu .mbar.help -font font_ui
5406 menu .mbar.help
5407
5408 if {![is_MacOSX]} {
5409         .mbar.help add command -label "About [appname]" \
5410                 -command do_about \
5411                 -font font_ui
5412 }
5413
5414 set browser {}
5415 catch {set browser $repo_config(instaweb.browser)}
5416 set doc_path [file dirname [gitexec]]
5417 set doc_path [file join $doc_path Documentation index.html]
5418
5419 if {[is_Cygwin]} {
5420         set doc_path [exec cygpath --mixed $doc_path]
5421 }
5422
5423 if {$browser eq {}} {
5424         if {[is_MacOSX]} {
5425                 set browser open
5426         } elseif {[is_Cygwin]} {
5427                 set program_files [file dirname [exec cygpath --windir]]
5428                 set program_files [file join $program_files {Program Files}]
5429                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5430                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5431                 if {[file exists $firefox]} {
5432                         set browser $firefox
5433                 } elseif {[file exists $ie]} {
5434                         set browser $ie
5435                 }
5436                 unset program_files firefox ie
5437         }
5438 }
5439
5440 if {[file isfile $doc_path]} {
5441         set doc_url "file:$doc_path"
5442 } else {
5443         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5444 }
5445
5446 if {$browser ne {}} {
5447         .mbar.help add command -label {Online Documentation} \
5448                 -command [list exec $browser $doc_url &] \
5449                 -font font_ui
5450 }
5451 unset browser doc_path doc_url
5452
5453 # -- Standard bindings
5454 #
5455 bind .   <Destroy> do_quit
5456 bind all <$M1B-Key-q> do_quit
5457 bind all <$M1B-Key-Q> do_quit
5458 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5459 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5460
5461 # -- Not a normal commit type invocation?  Do that instead!
5462 #
5463 switch -- $subcommand {
5464 browser {
5465         if {[llength $argv] != 1} {
5466                 puts stderr "usage: $argv0 browser commit"
5467                 exit 1
5468         }
5469         set current_branch [lindex $argv 0]
5470         new_browser $current_branch
5471         return
5472 }
5473 blame {
5474         if {[llength $argv] != 2} {
5475                 puts stderr "usage: $argv0 blame commit path"
5476                 exit 1
5477         }
5478         set current_branch [lindex $argv 0]
5479         show_blame $current_branch [lindex $argv 1]
5480         return
5481 }
5482 citool -
5483 gui {
5484         if {[llength $argv] != 0} {
5485                 puts -nonewline stderr "usage: $argv0"
5486                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5487                         puts -nonewline stderr " $subcommand"
5488                 }
5489                 puts stderr {}
5490                 exit 1
5491         }
5492         # fall through to setup UI for commits
5493 }
5494 default {
5495         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5496         exit 1
5497 }
5498 }
5499
5500 # -- Branch Control
5501 #
5502 frame .branch \
5503         -borderwidth 1 \
5504         -relief sunken
5505 label .branch.l1 \
5506         -text {Current Branch:} \
5507         -anchor w \
5508         -justify left \
5509         -font font_ui
5510 label .branch.cb \
5511         -textvariable current_branch \
5512         -anchor w \
5513         -justify left \
5514         -font font_ui
5515 pack .branch.l1 -side left
5516 pack .branch.cb -side left -fill x
5517 pack .branch -side top -fill x
5518
5519 # -- Main Window Layout
5520 #
5521 panedwindow .vpane -orient vertical
5522 panedwindow .vpane.files -orient horizontal
5523 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5524 pack .vpane -anchor n -side top -fill both -expand 1
5525
5526 # -- Index File List
5527 #
5528 frame .vpane.files.index -height 100 -width 200
5529 label .vpane.files.index.title -text {Changes To Be Committed} \
5530         -background green \
5531         -font font_ui
5532 text $ui_index -background white -borderwidth 0 \
5533         -width 20 -height 10 \
5534         -wrap none \
5535         -font font_ui \
5536         -cursor $cursor_ptr \
5537         -xscrollcommand {.vpane.files.index.sx set} \
5538         -yscrollcommand {.vpane.files.index.sy set} \
5539         -state disabled
5540 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5541 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5542 pack .vpane.files.index.title -side top -fill x
5543 pack .vpane.files.index.sx -side bottom -fill x
5544 pack .vpane.files.index.sy -side right -fill y
5545 pack $ui_index -side left -fill both -expand 1
5546 .vpane.files add .vpane.files.index -sticky nsew
5547
5548 # -- Working Directory File List
5549 #
5550 frame .vpane.files.workdir -height 100 -width 200
5551 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5552         -background red \
5553         -font font_ui
5554 text $ui_workdir -background white -borderwidth 0 \
5555         -width 20 -height 10 \
5556         -wrap none \
5557         -font font_ui \
5558         -cursor $cursor_ptr \
5559         -xscrollcommand {.vpane.files.workdir.sx set} \
5560         -yscrollcommand {.vpane.files.workdir.sy set} \
5561         -state disabled
5562 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5563 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5564 pack .vpane.files.workdir.title -side top -fill x
5565 pack .vpane.files.workdir.sx -side bottom -fill x
5566 pack .vpane.files.workdir.sy -side right -fill y
5567 pack $ui_workdir -side left -fill both -expand 1
5568 .vpane.files add .vpane.files.workdir -sticky nsew
5569
5570 foreach i [list $ui_index $ui_workdir] {
5571         $i tag conf in_diff -font font_uibold
5572         $i tag conf in_sel \
5573                 -background [$i cget -foreground] \
5574                 -foreground [$i cget -background]
5575 }
5576 unset i
5577
5578 # -- Diff and Commit Area
5579 #
5580 frame .vpane.lower -height 300 -width 400
5581 frame .vpane.lower.commarea
5582 frame .vpane.lower.diff -relief sunken -borderwidth 1
5583 pack .vpane.lower.commarea -side top -fill x
5584 pack .vpane.lower.diff -side bottom -fill both -expand 1
5585 .vpane add .vpane.lower -sticky nsew
5586
5587 # -- Commit Area Buttons
5588 #
5589 frame .vpane.lower.commarea.buttons
5590 label .vpane.lower.commarea.buttons.l -text {} \
5591         -anchor w \
5592         -justify left \
5593         -font font_ui
5594 pack .vpane.lower.commarea.buttons.l -side top -fill x
5595 pack .vpane.lower.commarea.buttons -side left -fill y
5596
5597 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5598         -command do_rescan \
5599         -font font_ui
5600 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5601 lappend disable_on_lock \
5602         {.vpane.lower.commarea.buttons.rescan conf -state}
5603
5604 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5605         -command do_add_all \
5606         -font font_ui
5607 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5608 lappend disable_on_lock \
5609         {.vpane.lower.commarea.buttons.incall conf -state}
5610
5611 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5612         -command do_signoff \
5613         -font font_ui
5614 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5615
5616 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5617         -command do_commit \
5618         -font font_ui
5619 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5620 lappend disable_on_lock \
5621         {.vpane.lower.commarea.buttons.commit conf -state}
5622
5623 # -- Commit Message Buffer
5624 #
5625 frame .vpane.lower.commarea.buffer
5626 frame .vpane.lower.commarea.buffer.header
5627 set ui_comm .vpane.lower.commarea.buffer.t
5628 set ui_coml .vpane.lower.commarea.buffer.header.l
5629 radiobutton .vpane.lower.commarea.buffer.header.new \
5630         -text {New Commit} \
5631         -command do_select_commit_type \
5632         -variable selected_commit_type \
5633         -value new \
5634         -font font_ui
5635 lappend disable_on_lock \
5636         [list .vpane.lower.commarea.buffer.header.new conf -state]
5637 radiobutton .vpane.lower.commarea.buffer.header.amend \
5638         -text {Amend Last Commit} \
5639         -command do_select_commit_type \
5640         -variable selected_commit_type \
5641         -value amend \
5642         -font font_ui
5643 lappend disable_on_lock \
5644         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5645 label $ui_coml \
5646         -anchor w \
5647         -justify left \
5648         -font font_ui
5649 proc trace_commit_type {varname args} {
5650         global ui_coml commit_type
5651         switch -glob -- $commit_type {
5652         initial       {set txt {Initial Commit Message:}}
5653         amend         {set txt {Amended Commit Message:}}
5654         amend-initial {set txt {Amended Initial Commit Message:}}
5655         amend-merge   {set txt {Amended Merge Commit Message:}}
5656         merge         {set txt {Merge Commit Message:}}
5657         *             {set txt {Commit Message:}}
5658         }
5659         $ui_coml conf -text $txt
5660 }
5661 trace add variable commit_type write trace_commit_type
5662 pack $ui_coml -side left -fill x
5663 pack .vpane.lower.commarea.buffer.header.amend -side right
5664 pack .vpane.lower.commarea.buffer.header.new -side right
5665
5666 text $ui_comm -background white -borderwidth 1 \
5667         -undo true \
5668         -maxundo 20 \
5669         -autoseparators true \
5670         -relief sunken \
5671         -width 75 -height 9 -wrap none \
5672         -font font_diff \
5673         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5674 scrollbar .vpane.lower.commarea.buffer.sby \
5675         -command [list $ui_comm yview]
5676 pack .vpane.lower.commarea.buffer.header -side top -fill x
5677 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5678 pack $ui_comm -side left -fill y
5679 pack .vpane.lower.commarea.buffer -side left -fill y
5680
5681 # -- Commit Message Buffer Context Menu
5682 #
5683 set ctxm .vpane.lower.commarea.buffer.ctxm
5684 menu $ctxm -tearoff 0
5685 $ctxm add command \
5686         -label {Cut} \
5687         -font font_ui \
5688         -command {tk_textCut $ui_comm}
5689 $ctxm add command \
5690         -label {Copy} \
5691         -font font_ui \
5692         -command {tk_textCopy $ui_comm}
5693 $ctxm add command \
5694         -label {Paste} \
5695         -font font_ui \
5696         -command {tk_textPaste $ui_comm}
5697 $ctxm add command \
5698         -label {Delete} \
5699         -font font_ui \
5700         -command {$ui_comm delete sel.first sel.last}
5701 $ctxm add separator
5702 $ctxm add command \
5703         -label {Select All} \
5704         -font font_ui \
5705         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5706 $ctxm add command \
5707         -label {Copy All} \
5708         -font font_ui \
5709         -command {
5710                 $ui_comm tag add sel 0.0 end
5711                 tk_textCopy $ui_comm
5712                 $ui_comm tag remove sel 0.0 end
5713         }
5714 $ctxm add separator
5715 $ctxm add command \
5716         -label {Sign Off} \
5717         -font font_ui \
5718         -command do_signoff
5719 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5720
5721 # -- Diff Header
5722 #
5723 proc trace_current_diff_path {varname args} {
5724         global current_diff_path diff_actions file_states
5725         if {$current_diff_path eq {}} {
5726                 set s {}
5727                 set f {}
5728                 set p {}
5729                 set o disabled
5730         } else {
5731                 set p $current_diff_path
5732                 set s [mapdesc [lindex $file_states($p) 0] $p]
5733                 set f {File:}
5734                 set p [escape_path $p]
5735                 set o normal
5736         }
5737
5738         .vpane.lower.diff.header.status configure -text $s
5739         .vpane.lower.diff.header.file configure -text $f
5740         .vpane.lower.diff.header.path configure -text $p
5741         foreach w $diff_actions {
5742                 uplevel #0 $w $o
5743         }
5744 }
5745 trace add variable current_diff_path write trace_current_diff_path
5746
5747 frame .vpane.lower.diff.header -background orange
5748 label .vpane.lower.diff.header.status \
5749         -background orange \
5750         -width $max_status_desc \
5751         -anchor w \
5752         -justify left \
5753         -font font_ui
5754 label .vpane.lower.diff.header.file \
5755         -background orange \
5756         -anchor w \
5757         -justify left \
5758         -font font_ui
5759 label .vpane.lower.diff.header.path \
5760         -background orange \
5761         -anchor w \
5762         -justify left \
5763         -font font_ui
5764 pack .vpane.lower.diff.header.status -side left
5765 pack .vpane.lower.diff.header.file -side left
5766 pack .vpane.lower.diff.header.path -fill x
5767 set ctxm .vpane.lower.diff.header.ctxm
5768 menu $ctxm -tearoff 0
5769 $ctxm add command \
5770         -label {Copy} \
5771         -font font_ui \
5772         -command {
5773                 clipboard clear
5774                 clipboard append \
5775                         -format STRING \
5776                         -type STRING \
5777                         -- $current_diff_path
5778         }
5779 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5780 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5781
5782 # -- Diff Body
5783 #
5784 frame .vpane.lower.diff.body
5785 set ui_diff .vpane.lower.diff.body.t
5786 text $ui_diff -background white -borderwidth 0 \
5787         -width 80 -height 15 -wrap none \
5788         -font font_diff \
5789         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5790         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5791         -state disabled
5792 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5793         -command [list $ui_diff xview]
5794 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5795         -command [list $ui_diff yview]
5796 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5797 pack .vpane.lower.diff.body.sby -side right -fill y
5798 pack $ui_diff -side left -fill both -expand 1
5799 pack .vpane.lower.diff.header -side top -fill x
5800 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5801
5802 $ui_diff tag conf d_cr -elide true
5803 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5804 $ui_diff tag conf d_+ -foreground {#00a000}
5805 $ui_diff tag conf d_- -foreground red
5806
5807 $ui_diff tag conf d_++ -foreground {#00a000}
5808 $ui_diff tag conf d_-- -foreground red
5809 $ui_diff tag conf d_+s \
5810         -foreground {#00a000} \
5811         -background {#e2effa}
5812 $ui_diff tag conf d_-s \
5813         -foreground red \
5814         -background {#e2effa}
5815 $ui_diff tag conf d_s+ \
5816         -foreground {#00a000} \
5817         -background ivory1
5818 $ui_diff tag conf d_s- \
5819         -foreground red \
5820         -background ivory1
5821
5822 $ui_diff tag conf d<<<<<<< \
5823         -foreground orange \
5824         -font font_diffbold
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
5832 $ui_diff tag raise sel
5833
5834 # -- Diff Body Context Menu
5835 #
5836 set ctxm .vpane.lower.diff.body.ctxm
5837 menu $ctxm -tearoff 0
5838 $ctxm add command \
5839         -label {Refresh} \
5840         -font font_ui \
5841         -command reshow_diff
5842 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5843 $ctxm add command \
5844         -label {Copy} \
5845         -font font_ui \
5846         -command {tk_textCopy $ui_diff}
5847 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5848 $ctxm add command \
5849         -label {Select All} \
5850         -font font_ui \
5851         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5852 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5853 $ctxm add command \
5854         -label {Copy All} \
5855         -font font_ui \
5856         -command {
5857                 $ui_diff tag add sel 0.0 end
5858                 tk_textCopy $ui_diff
5859                 $ui_diff tag remove sel 0.0 end
5860         }
5861 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5862 $ctxm add separator
5863 $ctxm add command \
5864         -label {Apply/Reverse Hunk} \
5865         -font font_ui \
5866         -command {apply_hunk $cursorX $cursorY}
5867 set ui_diff_applyhunk [$ctxm index last]
5868 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5869 $ctxm add separator
5870 $ctxm add command \
5871         -label {Decrease Font Size} \
5872         -font font_ui \
5873         -command {incr_font_size font_diff -1}
5874 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5875 $ctxm add command \
5876         -label {Increase Font Size} \
5877         -font font_ui \
5878         -command {incr_font_size font_diff 1}
5879 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5880 $ctxm add separator
5881 $ctxm add command \
5882         -label {Show Less Context} \
5883         -font font_ui \
5884         -command {if {$repo_config(gui.diffcontext) >= 2} {
5885                 incr repo_config(gui.diffcontext) -1
5886                 reshow_diff
5887         }}
5888 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5889 $ctxm add command \
5890         -label {Show More Context} \
5891         -font font_ui \
5892         -command {
5893                 incr repo_config(gui.diffcontext)
5894                 reshow_diff
5895         }
5896 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5897 $ctxm add separator
5898 $ctxm add command -label {Options...} \
5899         -font font_ui \
5900         -command do_options
5901 bind_button3 $ui_diff "
5902         set cursorX %x
5903         set cursorY %y
5904         if {\$ui_index eq \$current_diff_side} {
5905                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5906         } else {
5907                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5908         }
5909         tk_popup $ctxm %X %Y
5910 "
5911 unset ui_diff_applyhunk
5912
5913 # -- Status Bar
5914 #
5915 label .status -textvariable ui_status_value \
5916         -anchor w \
5917         -justify left \
5918         -borderwidth 1 \
5919         -relief sunken \
5920         -font font_ui
5921 pack .status -anchor w -side bottom -fill x
5922
5923 # -- Load geometry
5924 #
5925 catch {
5926 set gm $repo_config(gui.geometry)
5927 wm geometry . [lindex $gm 0]
5928 .vpane sash place 0 \
5929         [lindex [.vpane sash coord 0] 0] \
5930         [lindex $gm 1]
5931 .vpane.files sash place 0 \
5932         [lindex $gm 2] \
5933         [lindex [.vpane.files sash coord 0] 1]
5934 unset gm
5935 }
5936
5937 # -- Key Bindings
5938 #
5939 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5940 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5941 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5942 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5943 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5944 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5945 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5946 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5947 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5948 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5949 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5950
5951 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5952 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5953 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5954 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5955 bind $ui_diff <$M1B-Key-v> {break}
5956 bind $ui_diff <$M1B-Key-V> {break}
5957 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5958 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5959 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5960 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5961 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5962 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5963 bind $ui_diff <Button-1>   {focus %W}
5964
5965 if {[is_enabled branch]} {
5966         bind . <$M1B-Key-n> do_create_branch
5967         bind . <$M1B-Key-N> do_create_branch
5968 }
5969
5970 bind all <Key-F5> do_rescan
5971 bind all <$M1B-Key-r> do_rescan
5972 bind all <$M1B-Key-R> do_rescan
5973 bind .   <$M1B-Key-s> do_signoff
5974 bind .   <$M1B-Key-S> do_signoff
5975 bind .   <$M1B-Key-i> do_add_all
5976 bind .   <$M1B-Key-I> do_add_all
5977 bind .   <$M1B-Key-Return> do_commit
5978 foreach i [list $ui_index $ui_workdir] {
5979         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5980         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5981         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5982 }
5983 unset i
5984
5985 set file_lists($ui_index) [list]
5986 set file_lists($ui_workdir) [list]
5987
5988 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
5989 focus -force $ui_comm
5990
5991 # -- Warn the user about environmental problems.  Cygwin's Tcl
5992 #    does *not* pass its env array onto any processes it spawns.
5993 #    This means that git processes get none of our environment.
5994 #
5995 if {[is_Cygwin]} {
5996         set ignored_env 0
5997         set suggest_user {}
5998         set msg "Possible environment issues exist.
5999
6000 The following environment variables are probably
6001 going to be ignored by any Git subprocess run
6002 by [appname]:
6003
6004 "
6005         foreach name [array names env] {
6006                 switch -regexp -- $name {
6007                 {^GIT_INDEX_FILE$} -
6008                 {^GIT_OBJECT_DIRECTORY$} -
6009                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6010                 {^GIT_DIFF_OPTS$} -
6011                 {^GIT_EXTERNAL_DIFF$} -
6012                 {^GIT_PAGER$} -
6013                 {^GIT_TRACE$} -
6014                 {^GIT_CONFIG$} -
6015                 {^GIT_CONFIG_LOCAL$} -
6016                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6017                         append msg " - $name\n"
6018                         incr ignored_env
6019                 }
6020                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6021                         append msg " - $name\n"
6022                         incr ignored_env
6023                         set suggest_user $name
6024                 }
6025                 }
6026         }
6027         if {$ignored_env > 0} {
6028                 append msg "
6029 This is due to a known issue with the
6030 Tcl binary distributed by Cygwin."
6031
6032                 if {$suggest_user ne {}} {
6033                         append msg "
6034
6035 A good replacement for $suggest_user
6036 is placing values for the user.name and
6037 user.email settings into your personal
6038 ~/.gitconfig file.
6039 "
6040                 }
6041                 warn_popup $msg
6042         }
6043         unset ignored_env msg suggest_user name
6044 }
6045
6046 # -- Only initialize complex UI if we are going to stay running.
6047 #
6048 if {[is_enabled transport]} {
6049         load_all_remotes
6050         load_all_heads
6051
6052         populate_branch_menu
6053         populate_fetch_menu
6054         populate_push_menu
6055 }
6056
6057 # -- Only suggest a gc run if we are going to stay running.
6058 #
6059 if {[is_enabled multicommit]} {
6060         set object_limit 2000
6061         if {[is_Windows]} {set object_limit 200}
6062         regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6063         if {$objects_current >= $object_limit} {
6064                 if {[ask_popup \
6065                         "This repository currently has $objects_current loose objects.
6066
6067 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
6068
6069 Compress the database now?"] eq yes} {
6070                         do_gc
6071                 }
6072         }
6073         unset object_limit _junk objects_current
6074 }
6075
6076 lock_index begin-read
6077 after 1 do_rescan