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