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