git-gui.sh

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