git-gui.sh

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