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