git-gui.sh

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