git-gui.sh

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