git.oblomov.eu Git - git/blob - 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} {
 191         set title [appname]
 192         if {[reponame] ne {}} {
 193                 append title " ([reponame])"
 194         }
 195         tk_messageBox \
 196                 -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
 414         fconfigure $fd_df -blocking 0 -translation binary
 415         fconfigure $fd_lo -blocking 0 -translation 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                 $ui_comm delete 0.0 end
 432                 $ui_comm insert end $content
 433                 return 1
 434         }
 435         return 0
 436 }
 437
 438 proc read_diff_index {fd after} {
 439         global buf_rdi
 440
 441         append buf_rdi [read $fd]
 442         set c 0
 443         set n [string length $buf_rdi]
 444         while {$c < $n} {
 445                 set z1 [string first "\0" $buf_rdi $c]
 446                 if {$z1 == -1} break
 447                 incr z1
 448                 set z2 [string first "\0" $buf_rdi $z1]
 449                 if {$z2 == -1} break
 450
 451                 incr c
 452                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 453                 merge_state \
 454                         [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 455                         [lindex $i 4]? \
 456                         [list [lindex $i 0] [lindex $i 2]] \
 457                         [list]
 458                 set c $z2
 459                 incr c
 460         }
 461         if {$c < $n} {
 462                 set buf_rdi [string range $buf_rdi $c end]
 463         } else {
 464                 set buf_rdi {}
 465         }
 466
 467         rescan_done $fd buf_rdi $after
 468 }
 469
 470 proc read_diff_files {fd after} {
 471         global buf_rdf
 472
 473         append buf_rdf [read $fd]
 474         set c 0
 475         set n [string length $buf_rdf]
 476         while {$c < $n} {
 477                 set z1 [string first "\0" $buf_rdf $c]
 478                 if {$z1 == -1} break
 479                 incr z1
 480                 set z2 [string first "\0" $buf_rdf $z1]
 481                 if {$z2 == -1} break
 482
 483                 incr c
 484                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 485                 merge_state \
 486                         [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 487                         ?[lindex $i 4] \
 488                         [list] \
 489                         [list [lindex $i 0] [lindex $i 2]]
 490                 set c $z2
 491                 incr c
 492         }
 493         if {$c < $n} {
 494                 set buf_rdf [string range $buf_rdf $c end]
 495         } else {
 496                 set buf_rdf {}
 497         }
 498
 499         rescan_done $fd buf_rdf $after
 500 }
 501
 502 proc read_ls_others {fd after} {
 503         global buf_rlo
 504
 505         append buf_rlo [read $fd]
 506         set pck [split $buf_rlo "\0"]
 507         set buf_rlo [lindex $pck end]
 508         foreach p [lrange $pck 0 end-1] {
 509                 merge_state $p ?O
 510         }
 511         rescan_done $fd buf_rlo $after
 512 }
 513
 514 proc rescan_done {fd buf after} {
 515         global rescan_active
 516         global file_states repo_config
 517         upvar $buf to_clear
 518
 519         if {![eof $fd]} return
 520         set to_clear {}
 521         close $fd
 522         if {[incr rescan_active -1] > 0} return
 523
 524         prune_selection
 525         unlock_index
 526         display_all_files
 527         reshow_diff
 528         uplevel #0 $after
 529 }
 530
 531 proc prune_selection {} {
 532         global file_states selected_paths
 533
 534         foreach path [array names selected_paths] {
 535                 if {[catch {set still_here $file_states($path)}]} {
 536                         unset selected_paths($path)
 537                 }
 538         }
 539 }
 540
 541 ######################################################################
 542 ##
 543 ## diff
 544
 545 proc clear_diff {} {
 546         global ui_diff current_diff_path ui_index ui_workdir
 547
 548         $ui_diff conf -state normal
 549         $ui_diff delete 0.0 end
 550         $ui_diff conf -state disabled
 551
 552         set current_diff_path {}
 553
 554         $ui_index tag remove in_diff 0.0 end
 555         $ui_workdir tag remove in_diff 0.0 end
 556 }
 557
 558 proc reshow_diff {} {
 559         global ui_status_value file_states file_lists
 560         global current_diff_path current_diff_side
 561
 562         set p $current_diff_path
 563         if {$p eq {}
 564                 || $current_diff_side eq {}
 565                 || [catch {set s $file_states($p)}]
 566                 || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
 567                 clear_diff
 568         } else {
 569                 show_diff $p $current_diff_side
 570         }
 571 }
 572
 573 proc handle_empty_diff {} {
 574         global current_diff_path file_states file_lists
 575
 576         set path $current_diff_path
 577         set s $file_states($path)
 578         if {[lindex $s 0] ne {_M}} return
 579
 580         info_popup "No differences detected.
 581
 582 [short_path $path] has no changes.
 583
 584 The modification date of this file was updated
 585 by another application, but the content within
 586 the file was not changed.
 587
 588 A rescan will be automatically started to find
 589 other files which may have the same state."
 590
 591         clear_diff
 592         display_file $path __
 593         rescan {set ui_status_value {Ready.}} 0
 594 }
 595
 596 proc show_diff {path w {lno {}}} {
 597         global file_states file_lists
 598         global is_3way_diff diff_active repo_config
 599         global ui_diff ui_status_value ui_index ui_workdir
 600         global current_diff_path current_diff_side
 601
 602         if {$diff_active || ![lock_index read]} return
 603
 604         clear_diff
 605         if {$w eq {} || $lno == {}} {
 606                 foreach w [array names file_lists] {
 607                         set lno [lsearch -sorted $file_lists($w) $path]
 608                         if {$lno >= 0} {
 609                                 incr lno
 610                                 break
 611                         }
 612                 }
 613         }
 614         if {$w ne {} && $lno >= 1} {
 615                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 616         }
 617
 618         set s $file_states($path)
 619         set m [lindex $s 0]
 620         set is_3way_diff 0
 621         set diff_active 1
 622         set current_diff_path $path
 623         set current_diff_side $w
 624         set ui_status_value "Loading diff of [escape_path $path]..."
 625
 626         # - Git won't give us the diff, there's nothing to compare to!
 627         #
 628         if {$m eq {_O}} {
 629                 set max_sz [expr {128 * 1024}]
 630                 if {[catch {
 631                                 set fd [open $path r]
 632                                 set content [read $fd $max_sz]
 633                                 close $fd
 634                                 set sz [file size $path]
 635                         } err ]} {
 636                         set diff_active 0
 637                         unlock_index
 638                         set ui_status_value "Unable to display [escape_path $path]"
 639                         error_popup "Error loading file:\n\n$err"
 640                         return
 641                 }
 642                 $ui_diff conf -state normal
 643                 if {![catch {set type [exec file $path]}]} {
 644                         set n [string length $path]
 645                         if {[string equal -length $n $path $type]} {
 646                                 set type [string range $type $n end]
 647                                 regsub {^:?\s*} $type {} type
 648                         }
 649                         $ui_diff insert end "* $type\n" d_@
 650                 }
 651                 if {[string first "\0" $content] != -1} {
 652                         $ui_diff insert end \
 653                                 "* Binary file (not showing content)." \
 654                                 d_@
 655                 } else {
 656                         if {$sz > $max_sz} {
 657                                 $ui_diff insert end \
 658 "* Untracked file is $sz bytes.
 659 * Showing only first $max_sz bytes.
 660
 661 " d_@
 662                         }
 663                         $ui_diff insert end $content
 664                         if {$sz > $max_sz} {
 665                                 $ui_diff insert end "
 666 * Untracked file clipped here by [appname].
 667 * To see the entire file, use an external editor.
 668 " d_@
 669                         }
 670                 }
 671                 $ui_diff conf -state disabled
 672                 set diff_active 0
 673                 unlock_index
 674                 set ui_status_value {Ready.}
 675                 return
 676         }
 677
 678         set cmd [list | git]
 679         if {$w eq $ui_index} {
 680                 lappend cmd diff-index
 681                 lappend cmd --cached
 682         } elseif {$w eq $ui_workdir} {
 683                 if {[string index $m 0] eq {U}} {
 684                         lappend cmd diff
 685                 } else {
 686                         lappend cmd diff-files
 687                 }
 688         }
 689
 690         lappend cmd -p
 691         lappend cmd --no-color
 692         if {$repo_config(gui.diffcontext) > 0} {
 693                 lappend cmd "-U$repo_config(gui.diffcontext)"
 694         }
 695         if {$w eq $ui_index} {
 696                 lappend cmd [PARENT]
 697         }
 698         lappend cmd --
 699         lappend cmd $path
 700
 701         if {[catch {set fd [open $cmd r]} err]} {
 702                 set diff_active 0
 703                 unlock_index
 704                 set ui_status_value "Unable to display [escape_path $path]"
 705                 error_popup "Error loading diff:\n\n$err"
 706                 return
 707         }
 708
 709         fconfigure $fd -blocking 0 -translation auto
 710         fileevent $fd readable [list read_diff $fd]
 711 }
 712
 713 proc read_diff {fd} {
 714         global ui_diff ui_status_value is_3way_diff diff_active
 715
 716         $ui_diff conf -state normal
 717         while {[gets $fd line] >= 0} {
 718                 # -- Cleanup uninteresting diff header lines.
 719                 #
 720                 if {[string match {diff --git *}      $line]} continue
 721                 if {[string match {diff --cc *}       $line]} continue
 722                 if {[string match {diff --combined *} $line]} continue
 723                 if {[string match {--- *}             $line]} continue
 724                 if {[string match {+++ *}             $line]} continue
 725                 if {$line eq {deleted file mode 120000}} {
 726                         set line "deleted symlink"
 727                 }
 728
 729                 # -- Automatically detect if this is a 3 way diff.
 730                 #
 731                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 732
 733                 if {[string match {index *} $line]
 734                         || [string match {mode *} $line]
 735                         || [string match {new file *} $line]
 736                         || [string match {deleted file *} $line]
 737                         || $line eq {\ No newline at end of file}
 738                         || [regexp {^\* Unmerged path } $line]} {
 739                         set tags {}
 740                 } elseif {$is_3way_diff} {
 741                         set op [string range $line 0 1]
 742                         switch -- $op {
 743                         {  } {set tags {}}
 744                         {@@} {set tags d_@}
 745                         { +} {set tags d_s+}
 746                         { -} {set tags d_s-}
 747                         {+ } {set tags d_+s}
 748                         {- } {set tags d_-s}
 749                         {--} {set tags d_--}
 750                         {++} {
 751                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 752                                         set line [string replace $line 0 1 {  }]
 753                                         set tags d$op
 754                                 } else {
 755                                         set tags d_++
 756                                 }
 757                         }
 758                         default {
 759                                 puts "error: Unhandled 3 way diff marker: {$op}"
 760                                 set tags {}
 761                         }
 762                         }
 763                 } else {
 764                         set op [string index $line 0]
 765                         switch -- $op {
 766                         { } {set tags {}}
 767                         {@} {set tags d_@}
 768                         {-} {set tags d_-}
 769                         {+} {
 770                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 771                                         set line [string replace $line 0 0 { }]
 772                                         set tags d$op
 773                                 } else {
 774                                         set tags d_+
 775                                 }
 776                         }
 777                         default {
 778                                 puts "error: Unhandled 2 way diff marker: {$op}"
 779                                 set tags {}
 780                         }
 781                         }
 782                 }
 783                 $ui_diff insert end $line $tags
 784                 $ui_diff insert end "\n" $tags
 785         }
 786         $ui_diff conf -state disabled
 787
 788         if {[eof $fd]} {
 789                 close $fd
 790                 set diff_active 0
 791                 unlock_index
 792                 set ui_status_value {Ready.}
 793
 794                 if {[$ui_diff index end] eq {2.0}} {
 795                         handle_empty_diff
 796                 }
 797         }
 798 }
 799
 800 ######################################################################
 801 ##
 802 ## commit
 803
 804 proc load_last_commit {} {
 805         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 806
 807         if {[llength $PARENT] == 0} {
 808                 error_popup {There is nothing to amend.
 809
 810 You are about to create the initial commit.
 811 There is no commit before this to amend.
 812 }
 813                 return
 814         }
 815
 816         repository_state curType curHEAD curMERGE_HEAD
 817         if {$curType eq {merge}} {
 818                 error_popup {Cannot amend while merging.
 819
 820 You are currently in the middle of a merge that
 821 has not been fully completed.  You cannot amend
 822 the prior commit unless you first abort the
 823 current merge activity.
 824 }
 825                 return
 826         }
 827
 828         set msg {}
 829         set parents [list]
 830         if {[catch {
 831                         set fd [open "| git cat-file commit $curHEAD" r]
 832                         while {[gets $fd line] > 0} {
 833                                 if {[string match {parent *} $line]} {
 834                                         lappend parents [string range $line 7 end]
 835                                 }
 836                         }
 837                         set msg [string trim [read $fd]]
 838                         close $fd
 839                 } err]} {
 840                 error_popup "Error loading commit data for amend:\n\n$err"
 841                 return
 842         }
 843
 844         set HEAD $curHEAD
 845         set PARENT $parents
 846         set MERGE_HEAD [list]
 847         switch -- [llength $parents] {
 848         0       {set commit_type amend-initial}
 849         1       {set commit_type amend}
 850         default {set commit_type amend-merge}
 851         }
 852
 853         $ui_comm delete 0.0 end
 854         $ui_comm insert end $msg
 855         $ui_comm edit reset
 856         $ui_comm edit modified false
 857         rescan {set ui_status_value {Ready.}}
 858 }
 859
 860 proc create_new_commit {} {
 861         global commit_type ui_comm
 862
 863         set commit_type normal
 864         $ui_comm delete 0.0 end
 865         $ui_comm edit reset
 866         $ui_comm edit modified false
 867         rescan {set ui_status_value {Ready.}}
 868 }
 869
 870 set GIT_COMMITTER_IDENT {}
 871
 872 proc committer_ident {} {
 873         global GIT_COMMITTER_IDENT
 874
 875         if {$GIT_COMMITTER_IDENT eq {}} {
 876                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 877                         error_popup "Unable to obtain your identity:\n\n$err"
 878                         return {}
 879                 }
 880                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 881                         $me me GIT_COMMITTER_IDENT]} {
 882                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 883                         return {}
 884                 }
 885         }
 886
 887         return $GIT_COMMITTER_IDENT
 888 }
 889
 890 proc commit_tree {} {
 891         global HEAD commit_type file_states ui_comm repo_config
 892         global ui_status_value pch_error
 893
 894         if {![lock_index update]} return
 895         if {[committer_ident] eq {}} return
 896
 897         # -- Our in memory state should match the repository.
 898         #
 899         repository_state curType curHEAD curMERGE_HEAD
 900         if {[string match amend* $commit_type]
 901                 && $curType eq {normal}
 902                 && $curHEAD eq $HEAD} {
 903         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 904                 info_popup {Last scanned state does not match repository state.
 905
 906 Another Git program has modified this repository
 907 since the last scan.  A rescan must be performed
 908 before another commit can be created.
 909
 910 The rescan will be automatically started now.
 911 }
 912                 unlock_index
 913                 rescan {set ui_status_value {Ready.}}
 914                 return
 915         }
 916
 917         # -- At least one file should differ in the index.
 918         #
 919         set files_ready 0
 920         foreach path [array names file_states] {
 921                 switch -glob -- [lindex $file_states($path) 0] {
 922                 _? {continue}
 923                 A? -
 924                 D? -
 925                 M? {set files_ready 1}
 926                 U? {
 927                         error_popup "Unmerged files cannot be committed.
 928
 929 File [short_path $path] has merge conflicts.
 930 You must resolve them and add the file before committing.
 931 "
 932                         unlock_index
 933                         return
 934                 }
 935                 default {
 936                         error_popup "Unknown file state [lindex $s 0] detected.
 937
 938 File [short_path $path] cannot be committed by this program.
 939 "
 940                 }
 941                 }
 942         }
 943         if {!$files_ready} {
 944                 info_popup {No changes to commit.
 945
 946 You must add at least 1 file before you can commit.
 947 }
 948                 unlock_index
 949                 return
 950         }
 951
 952         # -- A message is required.
 953         #
 954         set msg [string trim [$ui_comm get 1.0 end]]
 955         if {$msg eq {}} {
 956                 error_popup {Please supply a commit message.
 957
 958 A good commit message has the following format:
 959
 960 - First line: Describe in one sentance what you did.
 961 - Second line: Blank
 962 - Remaining lines: Describe why this change is good.
 963 }
 964                 unlock_index
 965                 return
 966         }
 967
 968         # -- Run the pre-commit hook.
 969         #
 970         set pchook [gitdir hooks pre-commit]
 971
 972         # On Cygwin [file executable] might lie so we need to ask
 973         # the shell if the hook is executable.  Yes that's annoying.
 974         #
 975         if {[is_Windows] && [file isfile $pchook]} {
 976                 set pchook [list sh -c [concat \
 977                         "if test -x \"$pchook\";" \
 978                         "then exec \"$pchook\" 2>&1;" \
 979                         "fi"]]
 980         } elseif {[file executable $pchook]} {
 981                 set pchook [list $pchook |& cat]
 982         } else {
 983                 commit_writetree $curHEAD $msg
 984                 return
 985         }
 986
 987         set ui_status_value {Calling pre-commit hook...}
 988         set pch_error {}
 989         set fd_ph [open "| $pchook" r]
 990         fconfigure $fd_ph -blocking 0 -translation binary
 991         fileevent $fd_ph readable \
 992                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 993 }
 994
 995 proc commit_prehook_wait {fd_ph curHEAD msg} {
 996         global pch_error ui_status_value
 997
 998         append pch_error [read $fd_ph]
 999         fconfigure $fd_ph -blocking 1
1000         if {[eof $fd_ph]} {
1001                 if {[catch {close $fd_ph}]} {
1002                         set ui_status_value {Commit declined by pre-commit hook.}
1003                         hook_failed_popup pre-commit $pch_error
1004                         unlock_index
1005                 } else {
1006                         commit_writetree $curHEAD $msg
1007                 }
1008                 set pch_error {}
1009                 return
1010         }
1011         fconfigure $fd_ph -blocking 0
1012 }
1013
1014 proc commit_writetree {curHEAD msg} {
1015         global ui_status_value
1016
1017         set ui_status_value {Committing changes...}
1018         set fd_wt [open "| git write-tree" r]
1019         fileevent $fd_wt readable \
1020                 [list commit_committree $fd_wt $curHEAD $msg]
1021 }
1022
1023 proc commit_committree {fd_wt curHEAD msg} {
1024         global HEAD PARENT MERGE_HEAD commit_type
1025         global single_commit all_heads current_branch
1026         global ui_status_value ui_comm selected_commit_type
1027         global file_states selected_paths rescan_active
1028
1029         gets $fd_wt tree_id
1030         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1031                 error_popup "write-tree failed:\n\n$err"
1032                 set ui_status_value {Commit failed.}
1033                 unlock_index
1034                 return
1035         }
1036
1037         # -- Create the commit.
1038         #
1039         set cmd [list git commit-tree $tree_id]
1040         set parents [concat $PARENT $MERGE_HEAD]
1041         if {[llength $parents] > 0} {
1042                 foreach p $parents {
1043                         lappend cmd -p $p
1044                 }
1045         } else {
1046                 # git commit-tree writes to stderr during initial commit.
1047                 lappend cmd 2>/dev/null
1048         }
1049         lappend cmd << $msg
1050         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1051                 error_popup "commit-tree failed:\n\n$err"
1052                 set ui_status_value {Commit failed.}
1053                 unlock_index
1054                 return
1055         }
1056
1057         # -- Update the HEAD ref.
1058         #
1059         set reflogm commit
1060         if {$commit_type ne {normal}} {
1061                 append reflogm " ($commit_type)"
1062         }
1063         set i [string first "\n" $msg]
1064         if {$i >= 0} {
1065                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1066         } else {
1067                 append reflogm {: } $msg
1068         }
1069         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1070         if {[catch {eval exec $cmd} err]} {
1071                 error_popup "update-ref failed:\n\n$err"
1072                 set ui_status_value {Commit failed.}
1073                 unlock_index
1074                 return
1075         }
1076
1077         # -- Make sure our current branch exists.
1078         #
1079         if {$commit_type eq {initial}} {
1080                 lappend all_heads $current_branch
1081                 set all_heads [lsort -unique $all_heads]
1082                 populate_branch_menu
1083         }
1084
1085         # -- Cleanup after ourselves.
1086         #
1087         catch {file delete [gitdir MERGE_HEAD]}
1088         catch {file delete [gitdir MERGE_MSG]}
1089         catch {file delete [gitdir SQUASH_MSG]}
1090         catch {file delete [gitdir GITGUI_MSG]}
1091
1092         # -- Let rerere do its thing.
1093         #
1094         if {[file isdirectory [gitdir rr-cache]]} {
1095                 catch {exec git rerere}
1096         }
1097
1098         # -- Run the post-commit hook.
1099         #
1100         set pchook [gitdir hooks post-commit]
1101         if {[is_Windows] && [file isfile $pchook]} {
1102                 set pchook [list sh -c [concat \
1103                         "if test -x \"$pchook\";" \
1104                         "then exec \"$pchook\";" \
1105                         "fi"]]
1106         } elseif {![file executable $pchook]} {
1107                 set pchook {}
1108         }
1109         if {$pchook ne {}} {
1110                 catch {exec $pchook &}
1111         }
1112
1113         $ui_comm delete 0.0 end
1114         $ui_comm edit reset
1115         $ui_comm edit modified false
1116
1117         if {$single_commit} do_quit
1118
1119         # -- Update in memory status
1120         #
1121         set selected_commit_type new
1122         set commit_type normal
1123         set HEAD $cmt_id
1124         set PARENT $cmt_id
1125         set MERGE_HEAD [list]
1126
1127         foreach path [array names file_states] {
1128                 set s $file_states($path)
1129                 set m [lindex $s 0]
1130                 switch -glob -- $m {
1131                 _O -
1132                 _M -
1133                 _D {continue}
1134                 __ -
1135                 A_ -
1136                 M_ -
1137                 D_ {
1138                         unset file_states($path)
1139                         catch {unset selected_paths($path)}
1140                 }
1141                 DO {
1142                         set file_states($path) [list _O [lindex $s 1] {} {}]
1143                 }
1144                 AM -
1145                 AD -
1146                 MM -
1147                 MD {
1148                         set file_states($path) [list \
1149                                 _[string index $m 1] \
1150                                 [lindex $s 1] \
1151                                 [lindex $s 3] \
1152                                 {}]
1153                 }
1154                 }
1155         }
1156
1157         display_all_files
1158         unlock_index
1159         reshow_diff
1160         set ui_status_value \
1161                 "Changes committed as [string range $cmt_id 0 7]."
1162 }
1163
1164 ######################################################################
1165 ##
1166 ## fetch pull push
1167
1168 proc fetch_from {remote} {
1169         set w [new_console "fetch $remote" \
1170                 "Fetching new changes from $remote"]
1171         set cmd [list git fetch]
1172         lappend cmd $remote
1173         console_exec $w $cmd
1174 }
1175
1176 proc pull_remote {remote branch} {
1177         global HEAD commit_type file_states repo_config
1178
1179         if {![lock_index update]} return
1180
1181         # -- Our in memory state should match the repository.
1182         #
1183         repository_state curType curHEAD curMERGE_HEAD
1184         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1185                 info_popup {Last scanned state does not match repository state.
1186
1187 Another Git program has modified this repository
1188 since the last scan.  A rescan must be performed
1189 before a pull operation can be started.
1190
1191 The rescan will be automatically started now.
1192 }
1193                 unlock_index
1194                 rescan {set ui_status_value {Ready.}}
1195                 return
1196         }
1197
1198         # -- No differences should exist before a pull.
1199         #
1200         if {[array size file_states] != 0} {
1201                 error_popup {Uncommitted but modified files are present.
1202
1203 You should not perform a pull with unmodified
1204 files in your working directory as Git will be
1205 unable to recover from an incorrect merge.
1206
1207 You should commit or revert all changes before
1208 starting a pull operation.
1209 }
1210                 unlock_index
1211                 return
1212         }
1213
1214         set w [new_console "pull $remote $branch" \
1215                 "Pulling new changes from branch $branch in $remote"]
1216         set cmd [list git pull]
1217         if {$repo_config(gui.pullsummary) eq {false}} {
1218                 lappend cmd --no-summary
1219         }
1220         lappend cmd $remote
1221         lappend cmd $branch
1222         console_exec $w $cmd [list post_pull_remote $remote $branch]
1223 }
1224
1225 proc post_pull_remote {remote branch success} {
1226         global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1227         global ui_status_value
1228
1229         unlock_index
1230         if {$success} {
1231                 repository_state commit_type HEAD MERGE_HEAD
1232                 set PARENT $HEAD
1233                 set selected_commit_type new
1234                 set ui_status_value "Pulling $branch from $remote complete."
1235         } else {
1236                 rescan [list set ui_status_value \
1237                         "Conflicts detected while pulling $branch from $remote."]
1238         }
1239 }
1240
1241 proc push_to {remote} {
1242         set w [new_console "push $remote" \
1243                 "Pushing changes to $remote"]
1244         set cmd [list git push]
1245         lappend cmd $remote
1246         console_exec $w $cmd
1247 }
1248
1249 ######################################################################
1250 ##
1251 ## ui helpers
1252
1253 proc mapicon {w state path} {
1254         global all_icons
1255
1256         if {[catch {set r $all_icons($state$w)}]} {
1257                 puts "error: no icon for $w state={$state} $path"
1258                 return file_plain
1259         }
1260         return $r
1261 }
1262
1263 proc mapdesc {state path} {
1264         global all_descs
1265
1266         if {[catch {set r $all_descs($state)}]} {
1267                 puts "error: no desc for state={$state} $path"
1268                 return $state
1269         }
1270         return $r
1271 }
1272
1273 proc escape_path {path} {
1274         regsub -all "\n" $path "\\n" path
1275         return $path
1276 }
1277
1278 proc short_path {path} {
1279         return [escape_path [lindex [file split $path] end]]
1280 }
1281
1282 set next_icon_id 0
1283 set null_sha1 [string repeat 0 40]
1284
1285 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1286         global file_states next_icon_id null_sha1
1287
1288         set s0 [string index $new_state 0]
1289         set s1 [string index $new_state 1]
1290
1291         if {[catch {set info $file_states($path)}]} {
1292                 set state __
1293                 set icon n[incr next_icon_id]
1294         } else {
1295                 set state [lindex $info 0]
1296                 set icon [lindex $info 1]
1297                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1298                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1299         }
1300
1301         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1302         elseif {$s0 eq {_}} {set s0 _}
1303
1304         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1305         elseif {$s1 eq {_}} {set s1 _}
1306
1307         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1308                 set head_info [list 0 $null_sha1]
1309         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1310                 && $head_info eq {}} {
1311                 set head_info $index_info
1312         }
1313
1314         set file_states($path) [list $s0$s1 $icon \
1315                 $head_info $index_info \
1316                 ]
1317         return $state
1318 }
1319
1320 proc display_file_helper {w path icon_name old_m new_m} {
1321         global file_lists
1322
1323         if {$new_m eq {_}} {
1324                 set lno [lsearch -sorted $file_lists($w) $path]
1325                 if {$lno >= 0} {
1326                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1327                         incr lno
1328                         $w conf -state normal
1329                         $w delete $lno.0 [expr {$lno + 1}].0
1330                         $w conf -state disabled
1331                 }
1332         } elseif {$old_m eq {_} && $new_m ne {_}} {
1333                 lappend file_lists($w) $path
1334                 set file_lists($w) [lsort -unique $file_lists($w)]
1335                 set lno [lsearch -sorted $file_lists($w) $path]
1336                 incr lno
1337                 $w conf -state normal
1338                 $w image create $lno.0 \
1339                         -align center -padx 5 -pady 1 \
1340                         -name $icon_name \
1341                         -image [mapicon $w $new_m $path]
1342                 $w insert $lno.1 "[escape_path $path]\n"
1343                 $w conf -state disabled
1344         } elseif {$old_m ne $new_m} {
1345                 $w conf -state normal
1346                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1347                 $w conf -state disabled
1348         }
1349 }
1350
1351 proc display_file {path state} {
1352         global file_states selected_paths
1353         global ui_index ui_workdir
1354
1355         set old_m [merge_state $path $state]
1356         set s $file_states($path)
1357         set new_m [lindex $s 0]
1358         set icon_name [lindex $s 1]
1359
1360         set o [string index $old_m 0]
1361         set n [string index $new_m 0]
1362         if {$o eq {U}} {
1363                 set o _
1364         }
1365         if {$n eq {U}} {
1366                 set n _
1367         }
1368         display_file_helper     $ui_index $path $icon_name $o $n
1369
1370         if {[string index $old_m 0] eq {U}} {
1371                 set o U
1372         } else {
1373                 set o [string index $old_m 1]
1374         }
1375         if {[string index $new_m 0] eq {U}} {
1376                 set n U
1377         } else {
1378                 set n [string index $new_m 1]
1379         }
1380         display_file_helper     $ui_workdir $path $icon_name $o $n
1381
1382         if {$new_m eq {__}} {
1383                 unset file_states($path)
1384                 catch {unset selected_paths($path)}
1385         }
1386 }
1387
1388 proc display_all_files_helper {w path icon_name m} {
1389         global file_lists
1390
1391         lappend file_lists($w) $path
1392         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1393         $w image create end \
1394                 -align center -padx 5 -pady 1 \
1395                 -name $icon_name \
1396                 -image [mapicon $w $m $path]
1397         $w insert end "[escape_path $path]\n"
1398 }
1399
1400 proc display_all_files {} {
1401         global ui_index ui_workdir
1402         global file_states file_lists
1403         global last_clicked
1404
1405         $ui_index conf -state normal
1406         $ui_workdir conf -state normal
1407
1408         $ui_index delete 0.0 end
1409         $ui_workdir delete 0.0 end
1410         set last_clicked {}
1411
1412         set file_lists($ui_index) [list]
1413         set file_lists($ui_workdir) [list]
1414
1415         foreach path [lsort [array names file_states]] {
1416                 set s $file_states($path)
1417                 set m [lindex $s 0]
1418                 set icon_name [lindex $s 1]
1419
1420                 set s [string index $m 0]
1421                 if {$s ne {U} && $s ne {_}} {
1422                         display_all_files_helper $ui_index $path \
1423                                 $icon_name $s
1424                 }
1425
1426                 if {[string index $m 0] eq {U}} {
1427                         set s U
1428                 } else {
1429                         set s [string index $m 1]
1430                 }
1431                 if {$s ne {_}} {
1432                         display_all_files_helper $ui_workdir $path \
1433                                 $icon_name $s
1434                 }
1435         }
1436
1437         $ui_index conf -state disabled
1438         $ui_workdir conf -state disabled
1439 }
1440
1441 proc update_indexinfo {msg pathList after} {
1442         global update_index_cp ui_status_value
1443
1444         if {![lock_index update]} return
1445
1446         set update_index_cp 0
1447         set pathList [lsort $pathList]
1448         set totalCnt [llength $pathList]
1449         set batch [expr {int($totalCnt * .01) + 1}]
1450         if {$batch > 25} {set batch 25}
1451
1452         set ui_status_value [format \
1453                 "$msg... %i/%i files (%.2f%%)" \
1454                 $update_index_cp \
1455                 $totalCnt \
1456                 0.0]
1457         set fd [open "| git update-index -z --index-info" w]
1458         fconfigure $fd \
1459                 -blocking 0 \
1460                 -buffering full \
1461                 -buffersize 512 \
1462                 -translation binary
1463         fileevent $fd writable [list \
1464                 write_update_indexinfo \
1465                 $fd \
1466                 $pathList \
1467                 $totalCnt \
1468                 $batch \
1469                 $msg \
1470                 $after \
1471                 ]
1472 }
1473
1474 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1475         global update_index_cp ui_status_value
1476         global file_states current_diff_path
1477
1478         if {$update_index_cp >= $totalCnt} {
1479                 close $fd
1480                 unlock_index
1481                 uplevel #0 $after
1482                 return
1483         }
1484
1485         for {set i $batch} \
1486                 {$update_index_cp < $totalCnt && $i > 0} \
1487                 {incr i -1} {
1488                 set path [lindex $pathList $update_index_cp]
1489                 incr update_index_cp
1490
1491                 set s $file_states($path)
1492                 switch -glob -- [lindex $s 0] {
1493                 A? {set new _O}
1494                 M? {set new _M}
1495                 D_ {set new _D}
1496                 D? {set new _?}
1497                 ?? {continue}
1498                 }
1499                 set info [lindex $s 2]
1500                 if {$info eq {}} continue
1501
1502                 puts -nonewline $fd "$info\t$path\0"
1503                 display_file $path $new
1504         }
1505
1506         set ui_status_value [format \
1507                 "$msg... %i/%i files (%.2f%%)" \
1508                 $update_index_cp \
1509                 $totalCnt \
1510                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1511 }
1512
1513 proc update_index {msg pathList after} {
1514         global update_index_cp ui_status_value
1515
1516         if {![lock_index update]} return
1517
1518         set update_index_cp 0
1519         set pathList [lsort $pathList]
1520         set totalCnt [llength $pathList]
1521         set batch [expr {int($totalCnt * .01) + 1}]
1522         if {$batch > 25} {set batch 25}
1523
1524         set ui_status_value [format \
1525                 "$msg... %i/%i files (%.2f%%)" \
1526                 $update_index_cp \
1527                 $totalCnt \
1528                 0.0]
1529         set fd [open "| git update-index --add --remove -z --stdin" w]
1530         fconfigure $fd \
1531                 -blocking 0 \
1532                 -buffering full \
1533                 -buffersize 512 \
1534                 -translation binary
1535         fileevent $fd writable [list \
1536                 write_update_index \
1537                 $fd \
1538                 $pathList \
1539                 $totalCnt \
1540                 $batch \
1541                 $msg \
1542                 $after \
1543                 ]
1544 }
1545
1546 proc write_update_index {fd pathList totalCnt batch msg after} {
1547         global update_index_cp ui_status_value
1548         global file_states current_diff_path
1549
1550         if {$update_index_cp >= $totalCnt} {
1551                 close $fd
1552                 unlock_index
1553                 uplevel #0 $after
1554                 return
1555         }
1556
1557         for {set i $batch} \
1558                 {$update_index_cp < $totalCnt && $i > 0} \
1559                 {incr i -1} {
1560                 set path [lindex $pathList $update_index_cp]
1561                 incr update_index_cp
1562
1563                 switch -glob -- [lindex $file_states($path) 0] {
1564                 AD {set new __}
1565                 ?D {set new D_}
1566                 _O -
1567                 AM {set new A_}
1568                 U? {
1569                         if {[file exists $path]} {
1570                                 set new M_
1571                         } else {
1572                                 set new D_
1573                         }
1574                 }
1575                 ?M {set new M_}
1576                 ?? {continue}
1577                 }
1578                 puts -nonewline $fd "$path\0"
1579                 display_file $path $new
1580         }
1581
1582         set ui_status_value [format \
1583                 "$msg... %i/%i files (%.2f%%)" \
1584                 $update_index_cp \
1585                 $totalCnt \
1586                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1587 }
1588
1589 proc checkout_index {msg pathList after} {
1590         global update_index_cp ui_status_value
1591
1592         if {![lock_index update]} return
1593
1594         set update_index_cp 0
1595         set pathList [lsort $pathList]
1596         set totalCnt [llength $pathList]
1597         set batch [expr {int($totalCnt * .01) + 1}]
1598         if {$batch > 25} {set batch 25}
1599
1600         set ui_status_value [format \
1601                 "$msg... %i/%i files (%.2f%%)" \
1602                 $update_index_cp \
1603                 $totalCnt \
1604                 0.0]
1605         set cmd [list git checkout-index]
1606         lappend cmd --index
1607         lappend cmd --quiet
1608         lappend cmd --force
1609         lappend cmd -z
1610         lappend cmd --stdin
1611         set fd [open "| $cmd " w]
1612         fconfigure $fd \
1613                 -blocking 0 \
1614                 -buffering full \
1615                 -buffersize 512 \
1616                 -translation binary
1617         fileevent $fd writable [list \
1618                 write_checkout_index \
1619                 $fd \
1620                 $pathList \
1621                 $totalCnt \
1622                 $batch \
1623                 $msg \
1624                 $after \
1625                 ]
1626 }
1627
1628 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1629         global update_index_cp ui_status_value
1630         global file_states current_diff_path
1631
1632         if {$update_index_cp >= $totalCnt} {
1633                 close $fd
1634                 unlock_index
1635                 uplevel #0 $after
1636                 return
1637         }
1638
1639         for {set i $batch} \
1640                 {$update_index_cp < $totalCnt && $i > 0} \
1641                 {incr i -1} {
1642                 set path [lindex $pathList $update_index_cp]
1643                 incr update_index_cp
1644                 switch -glob -- [lindex $file_states($path) 0] {
1645                 U? {continue}
1646                 ?M -
1647                 ?D {
1648                         puts -nonewline $fd "$path\0"
1649                         display_file $path ?_
1650                 }
1651                 }
1652         }
1653
1654         set ui_status_value [format \
1655                 "$msg... %i/%i files (%.2f%%)" \
1656                 $update_index_cp \
1657                 $totalCnt \
1658                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1659 }
1660
1661 ######################################################################
1662 ##
1663 ## branch management
1664
1665 proc is_tracking_branch {name} {
1666         global tracking_branches
1667
1668         if {![catch {set info $tracking_branches($name)}]} {
1669                 return 1
1670         }
1671         foreach t [array names tracking_branches] {
1672                 if {[string match {*/\*} $t] && [string match $t $name]} {
1673                         return 1
1674                 }
1675         }
1676         return 0
1677 }
1678
1679 proc load_all_heads {} {
1680         global all_heads
1681
1682         set all_heads [list]
1683         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1684         while {[gets $fd line] > 0} {
1685                 if {[is_tracking_branch $line]} continue
1686                 if {![regsub ^refs/heads/ $line {} name]} continue
1687                 lappend all_heads $name
1688         }
1689         close $fd
1690
1691         set all_heads [lsort $all_heads]
1692 }
1693
1694 proc populate_branch_menu {} {
1695         global all_heads disable_on_lock
1696
1697         set m .mbar.branch
1698         set last [$m index last]
1699         for {set i 0} {$i <= $last} {incr i} {
1700                 if {[$m type $i] eq {separator}} {
1701                         $m delete $i last
1702                         set new_dol [list]
1703                         foreach a $disable_on_lock {
1704                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1705                                         lappend new_dol $a
1706                                 }
1707                         }
1708                         set disable_on_lock $new_dol
1709                         break
1710                 }
1711         }
1712
1713         $m add separator
1714         foreach b $all_heads {
1715                 $m add radiobutton \
1716                         -label $b \
1717                         -command [list switch_branch $b] \
1718                         -variable current_branch \
1719                         -value $b \
1720                         -font font_ui
1721                 lappend disable_on_lock \
1722                         [list $m entryconf [$m index last] -state]
1723         }
1724 }
1725
1726 proc all_tracking_branches {} {
1727         global tracking_branches
1728
1729         set all_trackings {}
1730         set cmd {}
1731         foreach name [array names tracking_branches] {
1732                 if {[regsub {/\*$} $name {} name]} {
1733                         lappend cmd $name
1734                 } else {
1735                         regsub ^refs/(heads|remotes)/ $name {} name
1736                         lappend all_trackings $name
1737                 }
1738         }
1739
1740         if {$cmd ne {}} {
1741                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1742                 while {[gets $fd name] > 0} {
1743                         regsub ^refs/(heads|remotes)/ $name {} name
1744                         lappend all_trackings $name
1745                 }
1746                 close $fd
1747         }
1748
1749         return [lsort -unique $all_trackings]
1750 }
1751
1752 proc do_create_branch_action {w} {
1753         global all_heads null_sha1 repo_config
1754         global create_branch_checkout create_branch_revtype
1755         global create_branch_head create_branch_trackinghead
1756
1757         set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1758         if {$newbranch eq {}
1759                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1760                 tk_messageBox \
1761                         -icon error \
1762                         -type ok \
1763                         -title [wm title $w] \
1764                         -parent $w \
1765                         -message "Please supply a branch name."
1766                 focus $w.desc.name_t
1767                 return
1768         }
1769         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1770                 tk_messageBox \
1771                         -icon error \
1772                         -type ok \
1773                         -title [wm title $w] \
1774                         -parent $w \
1775                         -message "Branch '$newbranch' already exists."
1776                 focus $w.desc.name_t
1777                 return
1778         }
1779         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1780                 tk_messageBox \
1781                         -icon error \
1782                         -type ok \
1783                         -title [wm title $w] \
1784                         -parent $w \
1785                         -message "We do not like '$newbranch' as a branch name."
1786                 focus $w.desc.name_t
1787                 return
1788         }
1789
1790         set rev {}
1791         switch -- $create_branch_revtype {
1792         head {set rev $create_branch_head}
1793         tracking {set rev $create_branch_trackinghead}
1794         expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1795         }
1796         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1797                 tk_messageBox \
1798                         -icon error \
1799                         -type ok \
1800                         -title [wm title $w] \
1801                         -parent $w \
1802                         -message "Invalid starting revision: $rev"
1803                 return
1804         }
1805         set cmd [list git update-ref]
1806         lappend cmd -m
1807         lappend cmd "branch: Created from $rev"
1808         lappend cmd "refs/heads/$newbranch"
1809         lappend cmd $cmt
1810         lappend cmd $null_sha1
1811         if {[catch {eval exec $cmd} err]} {
1812                 tk_messageBox \
1813                         -icon error \
1814                         -type ok \
1815                         -title [wm title $w] \
1816                         -parent $w \
1817                         -message "Failed to create '$newbranch'.\n\n$err"
1818                 return
1819         }
1820
1821         lappend all_heads $newbranch
1822         set all_heads [lsort $all_heads]
1823         populate_branch_menu
1824         destroy $w
1825         if {$create_branch_checkout} {
1826                 switch_branch $newbranch
1827         }
1828 }
1829
1830 proc radio_selector {varname value args} {
1831         upvar #0 $varname var
1832         set var $value
1833 }
1834
1835 trace add variable create_branch_head write \
1836         [list radio_selector create_branch_revtype head]
1837 trace add variable create_branch_trackinghead write \
1838         [list radio_selector create_branch_revtype tracking]
1839
1840 trace add variable delete_branch_head write \
1841         [list radio_selector delete_branch_checktype head]
1842 trace add variable delete_branch_trackinghead write \
1843         [list radio_selector delete_branch_checktype tracking]
1844
1845 proc do_create_branch {} {
1846         global all_heads current_branch repo_config
1847         global create_branch_checkout create_branch_revtype
1848         global create_branch_head create_branch_trackinghead
1849
1850         set w .branch_editor
1851         toplevel $w
1852         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1853
1854         label $w.header -text {Create New Branch} \
1855                 -font font_uibold
1856         pack $w.header -side top -fill x
1857
1858         frame $w.buttons
1859         button $w.buttons.create -text Create \
1860                 -font font_ui \
1861                 -default active \
1862                 -command [list do_create_branch_action $w]
1863         pack $w.buttons.create -side right
1864         button $w.buttons.cancel -text {Cancel} \
1865                 -font font_ui \
1866                 -command [list destroy $w]
1867         pack $w.buttons.cancel -side right -padx 5
1868         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1869
1870         labelframe $w.desc \
1871                 -text {Branch Description} \
1872                 -font font_ui
1873         label $w.desc.name_l -text {Name:} -font font_ui
1874         text $w.desc.name_t \
1875                 -borderwidth 1 \
1876                 -relief sunken \
1877                 -height 1 \
1878                 -width 40 \
1879                 -font font_ui
1880         $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1881         grid $w.desc.name_l $w.desc.name_t -stick we -padx {0 5}
1882         bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1883         bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1884         bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1885         bind $w.desc.name_t <Key> {
1886                 if {{%K} ne {BackSpace}
1887                         && {%K} ne {Tab}
1888                         && {%K} ne {Escape}
1889                         && {%K} ne {Return}} {
1890                         if {%k <= 32} break
1891                         if {[string first %A {~^:?*[}] >= 0} break
1892                 }
1893         }
1894         grid columnconfigure $w.desc 1 -weight 1
1895         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1896
1897         labelframe $w.from \
1898                 -text {Starting Revision} \
1899                 -font font_ui
1900         radiobutton $w.from.head_r \
1901                 -text {Local Branch:} \
1902                 -value head \
1903                 -variable create_branch_revtype \
1904                 -font font_ui
1905         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1906         grid $w.from.head_r $w.from.head_m -sticky w
1907         set all_trackings [all_tracking_branches]
1908         if {$all_trackings ne {}} {
1909                 set create_branch_trackinghead [lindex $all_trackings 0]
1910                 radiobutton $w.from.tracking_r \
1911                         -text {Tracking Branch:} \
1912                         -value tracking \
1913                         -variable create_branch_revtype \
1914                         -font font_ui
1915                 eval tk_optionMenu $w.from.tracking_m \
1916                         create_branch_trackinghead \
1917                         $all_trackings
1918                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
1919         }
1920         radiobutton $w.from.exp_r \
1921                 -text {Revision Expression:} \
1922                 -value expression \
1923                 -variable create_branch_revtype \
1924                 -font font_ui
1925         text $w.from.exp_t \
1926                 -borderwidth 1 \
1927                 -relief sunken \
1928                 -height 1 \
1929                 -width 50 \
1930                 -font font_ui
1931         grid $w.from.exp_r $w.from.exp_t -stick we -padx {0 5}
1932         bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1933         bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
1934         bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
1935         bind $w.from.exp_t <Key-space> break
1936         bind $w.from.exp_t <Key> {set create_branch_revtype expression}
1937         grid columnconfigure $w.from 1 -weight 1
1938         pack $w.from -anchor nw -fill x -pady 5 -padx 5
1939
1940         labelframe $w.postActions \
1941                 -text {Post Creation Actions} \
1942                 -font font_ui
1943         checkbutton $w.postActions.checkout \
1944                 -text {Checkout after creation} \
1945                 -variable create_branch_checkout \
1946                 -font font_ui
1947         pack $w.postActions.checkout -anchor nw
1948         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1949
1950         set create_branch_checkout 1
1951         set create_branch_head $current_branch
1952         set create_branch_revtype head
1953
1954         bind $w <Visibility> "grab $w; focus $w.desc.name_t"
1955         bind $w <Key-Escape> "destroy $w"
1956         bind $w <Key-Return> "do_create_branch_action $w;break"
1957         wm title $w "[appname] ([reponame]): Create Branch"
1958         tkwait window $w
1959 }
1960
1961 proc do_delete_branch_action {w} {
1962         global all_heads
1963         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1964
1965         set check_rev {}
1966         switch -- $delete_branch_checktype {
1967         head {set check_rev $delete_branch_head}
1968         tracking {set check_rev $delete_branch_trackinghead}
1969         always {set check_rev {:none}}
1970         }
1971         if {$check_rev eq {:none}} {
1972                 set check_cmt {}
1973         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
1974                 tk_messageBox \
1975                         -icon error \
1976                         -type ok \
1977                         -title [wm title $w] \
1978                         -parent $w \
1979                         -message "Invalid check revision: $check_rev"
1980                 return
1981         }
1982
1983         set to_delete [list]
1984         set not_merged [list]
1985         foreach i [$w.list.l curselection] {
1986                 set b [$w.list.l get $i]
1987                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
1988                 if {$check_cmt ne {}} {
1989                         if {$b eq $check_rev} continue
1990                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
1991                         if {$o ne $m} {
1992                                 lappend not_merged $b
1993                                 continue
1994                         }
1995                 }
1996                 lappend to_delete [list $b $o]
1997         }
1998         if {$not_merged ne {}} {
1999                 set msg "The following branches are not completely merged into $check_rev:
2000
2001  - [join $not_merged "\n - "]"
2002                 tk_messageBox \
2003                         -icon info \
2004                         -type ok \
2005                         -title [wm title $w] \
2006                         -parent $w \
2007                         -message $msg
2008         }
2009         if {$to_delete eq {}} return
2010         if {$delete_branch_checktype eq {always}} {
2011                 set msg {Recovering deleted branches is difficult.
2012
2013 Delete the selected branches?}
2014                 if {[tk_messageBox \
2015                         -icon warning \
2016                         -type yesno \
2017                         -title [wm title $w] \
2018                         -parent $w \
2019                         -message $msg] ne yes} {
2020                         return
2021                 }
2022         }
2023
2024         set failed {}
2025         foreach i $to_delete {
2026                 set b [lindex $i 0]
2027                 set o [lindex $i 1]
2028                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2029                         append failed " - $b: $err\n"
2030                 } else {
2031                         set x [lsearch -sorted $all_heads $b]
2032                         if {$x >= 0} {
2033                                 set all_heads [lreplace $all_heads $x $x]
2034                         }
2035                 }
2036         }
2037
2038         if {$failed ne {}} {
2039                 tk_messageBox \
2040                         -icon error \
2041                         -type ok \
2042                         -title [wm title $w] \
2043                         -parent $w \
2044                         -message "Failed to delete branches:\n$failed"
2045         }
2046
2047         set all_heads [lsort $all_heads]
2048         populate_branch_menu
2049         destroy $w
2050 }
2051
2052 proc do_delete_branch {} {
2053         global all_heads tracking_branches current_branch
2054         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2055
2056         set w .branch_editor
2057         toplevel $w
2058         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2059
2060         label $w.header -text {Delete Local Branch} \
2061                 -font font_uibold
2062         pack $w.header -side top -fill x
2063
2064         frame $w.buttons
2065         button $w.buttons.create -text Delete \
2066                 -font font_ui \
2067                 -command [list do_delete_branch_action $w]
2068         pack $w.buttons.create -side right
2069         button $w.buttons.cancel -text {Cancel} \
2070                 -font font_ui \
2071                 -command [list destroy $w]
2072         pack $w.buttons.cancel -side right -padx 5
2073         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2074
2075         labelframe $w.list \
2076                 -text {Local Branches} \
2077                 -font font_ui
2078         listbox $w.list.l \
2079                 -height 10 \
2080                 -width 50 \
2081                 -selectmode extended \
2082                 -font font_ui
2083         foreach h $all_heads {
2084                 if {$h ne $current_branch} {
2085                         $w.list.l insert end $h
2086                 }
2087         }
2088         pack $w.list.l -fill both -pady 5 -padx 5
2089         pack $w.list -fill both -pady 5 -padx 5
2090
2091         labelframe $w.validate \
2092                 -text {Delete Only If} \
2093                 -font font_ui
2094         radiobutton $w.validate.head_r \
2095                 -text {Merged Into Local Branch:} \
2096                 -value head \
2097                 -variable delete_branch_checktype \
2098                 -font font_ui
2099         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2100         grid $w.validate.head_r $w.validate.head_m -sticky w
2101         set all_trackings [all_tracking_branches]
2102         if {$all_trackings ne {}} {
2103                 set delete_branch_trackinghead [lindex $all_trackings 0]
2104                 radiobutton $w.validate.tracking_r \
2105                         -text {Merged Into Tracking Branch:} \
2106                         -value tracking \
2107                         -variable delete_branch_checktype \
2108                         -font font_ui
2109                 eval tk_optionMenu $w.validate.tracking_m \
2110                         delete_branch_trackinghead \
2111                         $all_trackings
2112                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2113         }
2114         radiobutton $w.validate.always_r \
2115                 -text {Always (Do not perform merge checks)} \
2116                 -value always \
2117                 -variable delete_branch_checktype \
2118                 -font font_ui
2119         grid $w.validate.always_r -columnspan 2 -sticky w
2120         grid columnconfigure $w.validate 1 -weight 1
2121         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2122
2123         set delete_branch_head $current_branch
2124         set delete_branch_checktype head
2125
2126         bind $w <Visibility> "grab $w; focus $w"
2127         bind $w <Key-Escape> "destroy $w"
2128         wm title $w "[appname] ([reponame]): Delete Branch"
2129         tkwait window $w
2130 }
2131
2132 proc switch_branch {b} {
2133         global HEAD commit_type file_states current_branch
2134         global selected_commit_type ui_comm
2135
2136         if {![lock_index switch]} return
2137
2138         # -- Backup the selected branch (repository_state resets it)
2139         #
2140         set new_branch $current_branch
2141
2142         # -- Our in memory state should match the repository.
2143         #
2144         repository_state curType curHEAD curMERGE_HEAD
2145         if {[string match amend* $commit_type]
2146                 && $curType eq {normal}
2147                 && $curHEAD eq $HEAD} {
2148         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2149                 info_popup {Last scanned state does not match repository state.
2150
2151 Another Git program has modified this repository
2152 since the last scan.  A rescan must be performed
2153 before the current branch can be changed.
2154
2155 The rescan will be automatically started now.
2156 }
2157                 unlock_index
2158                 rescan {set ui_status_value {Ready.}}
2159                 return
2160         }
2161
2162         # -- Toss the message buffer if we are in amend mode.
2163         #
2164         if {[string match amend* $curType]} {
2165                 $ui_comm delete 0.0 end
2166                 $ui_comm edit reset
2167                 $ui_comm edit modified false
2168         }
2169
2170         set selected_commit_type new
2171         set current_branch $new_branch
2172
2173         unlock_index
2174         error "NOT FINISHED"
2175 }
2176
2177 ######################################################################
2178 ##
2179 ## remote management
2180
2181 proc load_all_remotes {} {
2182         global repo_config
2183         global all_remotes tracking_branches
2184
2185         set all_remotes [list]
2186         array unset tracking_branches
2187
2188         set rm_dir [gitdir remotes]
2189         if {[file isdirectory $rm_dir]} {
2190                 set all_remotes [glob \
2191                         -types f \
2192                         -tails \
2193                         -nocomplain \
2194                         -directory $rm_dir *]
2195
2196                 foreach name $all_remotes {
2197                         catch {
2198                                 set fd [open [file join $rm_dir $name] r]
2199                                 while {[gets $fd line] >= 0} {
2200                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2201                                                 $line line src dst]} continue
2202                                         if {![regexp ^refs/ $dst]} {
2203                                                 set dst "refs/heads/$dst"
2204                                         }
2205                                         set tracking_branches($dst) [list $name $src]
2206                                 }
2207                                 close $fd
2208                         }
2209                 }
2210         }
2211
2212         foreach line [array names repo_config remote.*.url] {
2213                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2214                 lappend all_remotes $name
2215
2216                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2217                         set fl {}
2218                 }
2219                 foreach line $fl {
2220                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2221                         if {![regexp ^refs/ $dst]} {
2222                                 set dst "refs/heads/$dst"
2223                         }
2224                         set tracking_branches($dst) [list $name $src]
2225                 }
2226         }
2227
2228         set all_remotes [lsort -unique $all_remotes]
2229 }
2230
2231 proc populate_fetch_menu {m} {
2232         global all_remotes repo_config
2233
2234         foreach r $all_remotes {
2235                 set enable 0
2236                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2237                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2238                                 set enable 1
2239                         }
2240                 } else {
2241                         catch {
2242                                 set fd [open [gitdir remotes $r] r]
2243                                 while {[gets $fd n] >= 0} {
2244                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2245                                                 set enable 1
2246                                                 break
2247                                         }
2248                                 }
2249                                 close $fd
2250                         }
2251                 }
2252
2253                 if {$enable} {
2254                         $m add command \
2255                                 -label "Fetch from $r..." \
2256                                 -command [list fetch_from $r] \
2257                                 -font font_ui
2258                 }
2259         }
2260 }
2261
2262 proc populate_push_menu {m} {
2263         global all_remotes repo_config
2264
2265         foreach r $all_remotes {
2266                 set enable 0
2267                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2268                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2269                                 set enable 1
2270                         }
2271                 } else {
2272                         catch {
2273                                 set fd [open [gitdir remotes $r] r]
2274                                 while {[gets $fd n] >= 0} {
2275                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2276                                                 set enable 1
2277                                                 break
2278                                         }
2279                                 }
2280                                 close $fd
2281                         }
2282                 }
2283
2284                 if {$enable} {
2285                         $m add command \
2286                                 -label "Push to $r..." \
2287                                 -command [list push_to $r] \
2288                                 -font font_ui
2289                 }
2290         }
2291 }
2292
2293 proc populate_pull_menu {m} {
2294         global repo_config all_remotes disable_on_lock
2295
2296         foreach remote $all_remotes {
2297                 set rb_list [list]
2298                 if {[array get repo_config remote.$remote.url] ne {}} {
2299                         if {[array get repo_config remote.$remote.fetch] ne {}} {
2300                                 foreach line $repo_config(remote.$remote.fetch) {
2301                                         if {[regexp {^([^:]+):} $line line rb]} {
2302                                                 lappend rb_list $rb
2303                                         }
2304                                 }
2305                         }
2306                 } else {
2307                         catch {
2308                                 set fd [open [gitdir remotes $remote] r]
2309                                 while {[gets $fd line] >= 0} {
2310                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2311                                                 lappend rb_list $rb
2312                                         }
2313                                 }
2314                                 close $fd
2315                         }
2316                 }
2317
2318                 foreach rb $rb_list {
2319                         regsub ^refs/heads/ $rb {} rb_short
2320                         $m add command \
2321                                 -label "Branch $rb_short from $remote..." \
2322                                 -command [list pull_remote $remote $rb] \
2323                                 -font font_ui
2324                         lappend disable_on_lock \
2325                                 [list $m entryconf [$m index last] -state]
2326                 }
2327         }
2328 }
2329
2330 ######################################################################
2331 ##
2332 ## icons
2333
2334 set filemask {
2335 #define mask_width 14
2336 #define mask_height 15
2337 static unsigned char mask_bits[] = {
2338    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2339    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2340    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2341 }
2342
2343 image create bitmap file_plain -background white -foreground black -data {
2344 #define plain_width 14
2345 #define plain_height 15
2346 static unsigned char plain_bits[] = {
2347    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2348    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2349    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2350 } -maskdata $filemask
2351
2352 image create bitmap file_mod -background white -foreground blue -data {
2353 #define mod_width 14
2354 #define mod_height 15
2355 static unsigned char mod_bits[] = {
2356    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2357    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2358    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2359 } -maskdata $filemask
2360
2361 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2362 #define file_fulltick_width 14
2363 #define file_fulltick_height 15
2364 static unsigned char file_fulltick_bits[] = {
2365    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2366    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2367    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2368 } -maskdata $filemask
2369
2370 image create bitmap file_parttick -background white -foreground "#005050" -data {
2371 #define parttick_width 14
2372 #define parttick_height 15
2373 static unsigned char parttick_bits[] = {
2374    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2375    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2376    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2377 } -maskdata $filemask
2378
2379 image create bitmap file_question -background white -foreground black -data {
2380 #define file_question_width 14
2381 #define file_question_height 15
2382 static unsigned char file_question_bits[] = {
2383    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2384    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2385    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2386 } -maskdata $filemask
2387
2388 image create bitmap file_removed -background white -foreground red -data {
2389 #define file_removed_width 14
2390 #define file_removed_height 15
2391 static unsigned char file_removed_bits[] = {
2392    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2393    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2394    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2395 } -maskdata $filemask
2396
2397 image create bitmap file_merge -background white -foreground blue -data {
2398 #define file_merge_width 14
2399 #define file_merge_height 15
2400 static unsigned char file_merge_bits[] = {
2401    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2402    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2403    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2404 } -maskdata $filemask
2405
2406 set ui_index .vpane.files.index.list
2407 set ui_workdir .vpane.files.workdir.list
2408
2409 set all_icons(_$ui_index)   file_plain
2410 set all_icons(A$ui_index)   file_fulltick
2411 set all_icons(M$ui_index)   file_fulltick
2412 set all_icons(D$ui_index)   file_removed
2413 set all_icons(U$ui_index)   file_merge
2414
2415 set all_icons(_$ui_workdir) file_plain
2416 set all_icons(M$ui_workdir) file_mod
2417 set all_icons(D$ui_workdir) file_question
2418 set all_icons(U$ui_workdir) file_merge
2419 set all_icons(O$ui_workdir) file_plain
2420
2421 set max_status_desc 0
2422 foreach i {
2423                 {__ "Unmodified"}
2424
2425                 {_M "Modified, not staged"}
2426                 {M_ "Staged for commit"}
2427                 {MM "Portions staged for commit"}
2428                 {MD "Staged for commit, missing"}
2429
2430                 {_O "Untracked, not staged"}
2431                 {A_ "Staged for commit"}
2432                 {AM "Portions staged for commit"}
2433                 {AD "Staged for commit, missing"}
2434
2435                 {_D "Missing"}
2436                 {D_ "Staged for removal"}
2437                 {DO "Staged for removal, still present"}
2438
2439                 {U_ "Requires merge resolution"}
2440                 {UU "Requires merge resolution"}
2441                 {UM "Requires merge resolution"}
2442                 {UD "Requires merge resolution"}
2443         } {
2444         if {$max_status_desc < [string length [lindex $i 1]]} {
2445                 set max_status_desc [string length [lindex $i 1]]
2446         }
2447         set all_descs([lindex $i 0]) [lindex $i 1]
2448 }
2449 unset i
2450
2451 ######################################################################
2452 ##
2453 ## util
2454
2455 proc is_MacOSX {} {
2456         global tcl_platform tk_library
2457         if {[tk windowingsystem] eq {aqua}} {
2458                 return 1
2459         }
2460         return 0
2461 }
2462
2463 proc is_Windows {} {
2464         global tcl_platform
2465         if {$tcl_platform(platform) eq {windows}} {
2466                 return 1
2467         }
2468         return 0
2469 }
2470
2471 proc bind_button3 {w cmd} {
2472         bind $w <Any-Button-3> $cmd
2473         if {[is_MacOSX]} {
2474                 bind $w <Control-Button-1> $cmd
2475         }
2476 }
2477
2478 proc incr_font_size {font {amt 1}} {
2479         set sz [font configure $font -size]
2480         incr sz $amt
2481         font configure $font -size $sz
2482         font configure ${font}bold -size $sz
2483 }
2484
2485 proc hook_failed_popup {hook msg} {
2486         set w .hookfail
2487         toplevel $w
2488
2489         frame $w.m
2490         label $w.m.l1 -text "$hook hook failed:" \
2491                 -anchor w \
2492                 -justify left \
2493                 -font font_uibold
2494         text $w.m.t \
2495                 -background white -borderwidth 1 \
2496                 -relief sunken \
2497                 -width 80 -height 10 \
2498                 -font font_diff \
2499                 -yscrollcommand [list $w.m.sby set]
2500         label $w.m.l2 \
2501                 -text {You must correct the above errors before committing.} \
2502                 -anchor w \
2503                 -justify left \
2504                 -font font_uibold
2505         scrollbar $w.m.sby -command [list $w.m.t yview]
2506         pack $w.m.l1 -side top -fill x
2507         pack $w.m.l2 -side bottom -fill x
2508         pack $w.m.sby -side right -fill y
2509         pack $w.m.t -side left -fill both -expand 1
2510         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2511
2512         $w.m.t insert 1.0 $msg
2513         $w.m.t conf -state disabled
2514
2515         button $w.ok -text OK \
2516                 -width 15 \
2517                 -font font_ui \
2518                 -command "destroy $w"
2519         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2520
2521         bind $w <Visibility> "grab $w; focus $w"
2522         bind $w <Key-Return> "destroy $w"
2523         wm title $w "[appname] ([reponame]): error"
2524         tkwait window $w
2525 }
2526
2527 set next_console_id 0
2528
2529 proc new_console {short_title long_title} {
2530         global next_console_id console_data
2531         set w .console[incr next_console_id]
2532         set console_data($w) [list $short_title $long_title]
2533         return [console_init $w]
2534 }
2535
2536 proc console_init {w} {
2537         global console_cr console_data M1B
2538
2539         set console_cr($w) 1.0
2540         toplevel $w
2541         frame $w.m
2542         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2543                 -anchor w \
2544                 -justify left \
2545                 -font font_uibold
2546         text $w.m.t \
2547                 -background white -borderwidth 1 \
2548                 -relief sunken \
2549                 -width 80 -height 10 \
2550                 -font font_diff \
2551                 -state disabled \
2552                 -yscrollcommand [list $w.m.sby set]
2553         label $w.m.s -text {Working... please wait...} \
2554                 -anchor w \
2555                 -justify left \
2556                 -font font_uibold
2557         scrollbar $w.m.sby -command [list $w.m.t yview]
2558         pack $w.m.l1 -side top -fill x
2559         pack $w.m.s -side bottom -fill x
2560         pack $w.m.sby -side right -fill y
2561         pack $w.m.t -side left -fill both -expand 1
2562         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2563
2564         menu $w.ctxm -tearoff 0
2565         $w.ctxm add command -label "Copy" \
2566                 -font font_ui \
2567                 -command "tk_textCopy $w.m.t"
2568         $w.ctxm add command -label "Select All" \
2569                 -font font_ui \
2570                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2571         $w.ctxm add command -label "Copy All" \
2572                 -font font_ui \
2573                 -command "
2574                         $w.m.t tag add sel 0.0 end
2575                         tk_textCopy $w.m.t
2576                         $w.m.t tag remove sel 0.0 end
2577                 "
2578
2579         button $w.ok -text {Close} \
2580                 -font font_ui \
2581                 -state disabled \
2582                 -command "destroy $w"
2583         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2584
2585         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2586         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2587         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2588         bind $w <Visibility> "focus $w"
2589         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2590         return $w
2591 }
2592
2593 proc console_exec {w cmd {after {}}} {
2594         # -- Windows tosses the enviroment when we exec our child.
2595         #    But most users need that so we have to relogin. :-(
2596         #
2597         if {[is_Windows]} {
2598                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2599         }
2600
2601         # -- Tcl won't let us redirect both stdout and stderr to
2602         #    the same pipe.  So pass it through cat...
2603         #
2604         set cmd [concat | $cmd |& cat]
2605
2606         set fd_f [open $cmd r]
2607         fconfigure $fd_f -blocking 0 -translation binary
2608         fileevent $fd_f readable [list console_read $w $fd_f $after]
2609 }
2610
2611 proc console_read {w fd after} {
2612         global console_cr console_data
2613
2614         set buf [read $fd]
2615         if {$buf ne {}} {
2616                 if {![winfo exists $w]} {console_init $w}
2617                 $w.m.t conf -state normal
2618                 set c 0
2619                 set n [string length $buf]
2620                 while {$c < $n} {
2621                         set cr [string first "\r" $buf $c]
2622                         set lf [string first "\n" $buf $c]
2623                         if {$cr < 0} {set cr [expr {$n + 1}]}
2624                         if {$lf < 0} {set lf [expr {$n + 1}]}
2625
2626                         if {$lf < $cr} {
2627                                 $w.m.t insert end [string range $buf $c $lf]
2628                                 set console_cr($w) [$w.m.t index {end -1c}]
2629                                 set c $lf
2630                                 incr c
2631                         } else {
2632                                 $w.m.t delete $console_cr($w) end
2633                                 $w.m.t insert end "\n"
2634                                 $w.m.t insert end [string range $buf $c $cr]
2635                                 set c $cr
2636                                 incr c
2637                         }
2638                 }
2639                 $w.m.t conf -state disabled
2640                 $w.m.t see end
2641         }
2642
2643         fconfigure $fd -blocking 1
2644         if {[eof $fd]} {
2645                 if {[catch {close $fd}]} {
2646                         if {![winfo exists $w]} {console_init $w}
2647                         $w.m.s conf -background red -text {Error: Command Failed}
2648                         $w.ok conf -state normal
2649                         set ok 0
2650                 } elseif {[winfo exists $w]} {
2651                         $w.m.s conf -background green -text {Success}
2652                         $w.ok conf -state normal
2653                         set ok 1
2654                 }
2655                 array unset console_cr $w
2656                 array unset console_data $w
2657                 if {$after ne {}} {
2658                         uplevel #0 $after $ok
2659                 }
2660                 return
2661         }
2662         fconfigure $fd -blocking 0
2663 }
2664
2665 ######################################################################
2666 ##
2667 ## ui commands
2668
2669 set starting_gitk_msg {Starting gitk... please wait...}
2670
2671 proc do_gitk {revs} {
2672         global ui_status_value starting_gitk_msg
2673
2674         set cmd gitk
2675         if {$revs ne {}} {
2676                 append cmd { }
2677                 append cmd $revs
2678         }
2679         if {[is_Windows]} {
2680                 set cmd "sh -c \"exec $cmd\""
2681         }
2682         append cmd { &}
2683
2684         if {[catch {eval exec $cmd} err]} {
2685                 error_popup "Failed to start gitk:\n\n$err"
2686         } else {
2687                 set ui_status_value $starting_gitk_msg
2688                 after 10000 {
2689                         if {$ui_status_value eq $starting_gitk_msg} {
2690                                 set ui_status_value {Ready.}
2691                         }
2692                 }
2693         }
2694 }
2695
2696 proc do_gc {} {
2697         set w [new_console {gc} {Compressing the object database}]
2698         console_exec $w {git gc}
2699 }
2700
2701 proc do_fsck_objects {} {
2702         set w [new_console {fsck-objects} \
2703                 {Verifying the object database with fsck-objects}]
2704         set cmd [list git fsck-objects]
2705         lappend cmd --full
2706         lappend cmd --cache
2707         lappend cmd --strict
2708         console_exec $w $cmd
2709 }
2710
2711 set is_quitting 0
2712
2713 proc do_quit {} {
2714         global ui_comm is_quitting repo_config commit_type
2715
2716         if {$is_quitting} return
2717         set is_quitting 1
2718
2719         # -- Stash our current commit buffer.
2720         #
2721         set save [gitdir GITGUI_MSG]
2722         set msg [string trim [$ui_comm get 0.0 end]]
2723         if {![string match amend* $commit_type]
2724                 && [$ui_comm edit modified]
2725                 && $msg ne {}} {
2726                 catch {
2727                         set fd [open $save w]
2728                         puts $fd [string trim [$ui_comm get 0.0 end]]
2729                         close $fd
2730                 }
2731         } else {
2732                 catch {file delete $save}
2733         }
2734
2735         # -- Stash our current window geometry into this repository.
2736         #
2737         set cfg_geometry [list]
2738         lappend cfg_geometry [wm geometry .]
2739         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2740         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2741         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2742                 set rc_geometry {}
2743         }
2744         if {$cfg_geometry ne $rc_geometry} {
2745                 catch {exec git repo-config gui.geometry $cfg_geometry}
2746         }
2747
2748         destroy .
2749 }
2750
2751 proc do_rescan {} {
2752         rescan {set ui_status_value {Ready.}}
2753 }
2754
2755 proc unstage_helper {txt paths} {
2756         global file_states current_diff_path
2757
2758         if {![lock_index begin-update]} return
2759
2760         set pathList [list]
2761         set after {}
2762         foreach path $paths {
2763                 switch -glob -- [lindex $file_states($path) 0] {
2764                 A? -
2765                 M? -
2766                 D? {
2767                         lappend pathList $path
2768                         if {$path eq $current_diff_path} {
2769                                 set after {reshow_diff;}
2770                         }
2771                 }
2772                 }
2773         }
2774         if {$pathList eq {}} {
2775                 unlock_index
2776         } else {
2777                 update_indexinfo \
2778                         $txt \
2779                         $pathList \
2780                         [concat $after {set ui_status_value {Ready.}}]
2781         }
2782 }
2783
2784 proc do_unstage_selection {} {
2785         global current_diff_path selected_paths
2786
2787         if {[array size selected_paths] > 0} {
2788                 unstage_helper \
2789                         {Unstaging selected files from commit} \
2790                         [array names selected_paths]
2791         } elseif {$current_diff_path ne {}} {
2792                 unstage_helper \
2793                         "Unstaging [short_path $current_diff_path] from commit" \
2794                         [list $current_diff_path]
2795         }
2796 }
2797
2798 proc add_helper {txt paths} {
2799         global file_states current_diff_path
2800
2801         if {![lock_index begin-update]} return
2802
2803         set pathList [list]
2804         set after {}
2805         foreach path $paths {
2806                 switch -glob -- [lindex $file_states($path) 0] {
2807                 _O -
2808                 ?M -
2809                 ?D -
2810                 U? {
2811                         lappend pathList $path
2812                         if {$path eq $current_diff_path} {
2813                                 set after {reshow_diff;}
2814                         }
2815                 }
2816                 }
2817         }
2818         if {$pathList eq {}} {
2819                 unlock_index
2820         } else {
2821                 update_index \
2822                         $txt \
2823                         $pathList \
2824                         [concat $after {set ui_status_value {Ready to commit.}}]
2825         }
2826 }
2827
2828 proc do_add_selection {} {
2829         global current_diff_path selected_paths
2830
2831         if {[array size selected_paths] > 0} {
2832                 add_helper \
2833                         {Adding selected files} \
2834                         [array names selected_paths]
2835         } elseif {$current_diff_path ne {}} {
2836                 add_helper \
2837                         "Adding [short_path $current_diff_path]" \
2838                         [list $current_diff_path]
2839         }
2840 }
2841
2842 proc do_add_all {} {
2843         global file_states
2844
2845         set paths [list]
2846         foreach path [array names file_states] {
2847                 switch -glob -- [lindex $file_states($path) 0] {
2848                 U? {continue}
2849                 ?M -
2850                 ?D {lappend paths $path}
2851                 }
2852         }
2853         add_helper {Adding all changed files} $paths
2854 }
2855
2856 proc revert_helper {txt paths} {
2857         global file_states current_diff_path
2858
2859         if {![lock_index begin-update]} return
2860
2861         set pathList [list]
2862         set after {}
2863         foreach path $paths {
2864                 switch -glob -- [lindex $file_states($path) 0] {
2865                 U? {continue}
2866                 ?M -
2867                 ?D {
2868                         lappend pathList $path
2869                         if {$path eq $current_diff_path} {
2870                                 set after {reshow_diff;}
2871                         }
2872                 }
2873                 }
2874         }
2875
2876         set n [llength $pathList]
2877         if {$n == 0} {
2878                 unlock_index
2879                 return
2880         } elseif {$n == 1} {
2881                 set s "[short_path [lindex $pathList]]"
2882         } else {
2883                 set s "these $n files"
2884         }
2885
2886         set reply [tk_dialog \
2887                 .confirm_revert \
2888                 "[appname] ([reponame])" \
2889                 "Revert changes in $s?
2890
2891 Any unadded changes will be permanently lost by the revert." \
2892                 question \
2893                 1 \
2894                 {Do Nothing} \
2895                 {Revert Changes} \
2896                 ]
2897         if {$reply == 1} {
2898                 checkout_index \
2899                         $txt \
2900                         $pathList \
2901                         [concat $after {set ui_status_value {Ready.}}]
2902         } else {
2903                 unlock_index
2904         }
2905 }
2906
2907 proc do_revert_selection {} {
2908         global current_diff_path selected_paths
2909
2910         if {[array size selected_paths] > 0} {
2911                 revert_helper \
2912                         {Reverting selected files} \
2913                         [array names selected_paths]
2914         } elseif {$current_diff_path ne {}} {
2915                 revert_helper \
2916                         "Reverting [short_path $current_diff_path]" \
2917                         [list $current_diff_path]
2918         }
2919 }
2920
2921 proc do_signoff {} {
2922         global ui_comm
2923
2924         set me [committer_ident]
2925         if {$me eq {}} return
2926
2927         set sob "Signed-off-by: $me"
2928         set last [$ui_comm get {end -1c linestart} {end -1c}]
2929         if {$last ne $sob} {
2930                 $ui_comm edit separator
2931                 if {$last ne {}
2932                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2933                         $ui_comm insert end "\n"
2934                 }
2935                 $ui_comm insert end "\n$sob"
2936                 $ui_comm edit separator
2937                 $ui_comm see end
2938         }
2939 }
2940
2941 proc do_select_commit_type {} {
2942         global commit_type selected_commit_type
2943
2944         if {$selected_commit_type eq {new}
2945                 && [string match amend* $commit_type]} {
2946                 create_new_commit
2947         } elseif {$selected_commit_type eq {amend}
2948                 && ![string match amend* $commit_type]} {
2949                 load_last_commit
2950
2951                 # The amend request was rejected...
2952                 #
2953                 if {![string match amend* $commit_type]} {
2954                         set selected_commit_type new
2955                 }
2956         }
2957 }
2958
2959 proc do_commit {} {
2960         commit_tree
2961 }
2962
2963 proc do_about {} {
2964         global appvers copyright
2965         global tcl_patchLevel tk_patchLevel
2966
2967         set w .about_dialog
2968         toplevel $w
2969         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2970
2971         label $w.header -text "About [appname]" \
2972                 -font font_uibold
2973         pack $w.header -side top -fill x
2974
2975         frame $w.buttons
2976         button $w.buttons.close -text {Close} \
2977                 -font font_ui \
2978                 -command [list destroy $w]
2979         pack $w.buttons.close -side right
2980         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2981
2982         label $w.desc \
2983                 -text "[appname] - a commit creation tool for Git.
2984 $copyright" \
2985                 -padx 5 -pady 5 \
2986                 -justify left \
2987                 -anchor w \
2988                 -borderwidth 1 \
2989                 -relief solid \
2990                 -font font_ui
2991         pack $w.desc -side top -fill x -padx 5 -pady 5
2992
2993         set v {}
2994         append v "[appname] version $appvers\n"
2995         append v "[exec git version]\n"
2996         append v "\n"
2997         if {$tcl_patchLevel eq $tk_patchLevel} {
2998                 append v "Tcl/Tk version $tcl_patchLevel"
2999         } else {
3000                 append v "Tcl version $tcl_patchLevel"
3001                 append v ", Tk version $tk_patchLevel"
3002         }
3003
3004         label $w.vers \
3005                 -text $v \
3006                 -padx 5 -pady 5 \
3007                 -justify left \
3008                 -anchor w \
3009                 -borderwidth 1 \
3010                 -relief solid \
3011                 -font font_ui
3012         pack $w.vers -side top -fill x -padx 5 -pady 5
3013
3014         menu $w.ctxm -tearoff 0
3015         $w.ctxm add command \
3016                 -label {Copy} \
3017                 -font font_ui \
3018                 -command "
3019                 clipboard clear
3020                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3021         "
3022
3023         bind $w <Visibility> "grab $w; focus $w"
3024         bind $w <Key-Escape> "destroy $w"
3025         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3026         wm title $w "About [appname]"
3027         tkwait window $w
3028 }
3029
3030 proc do_options {} {
3031         global repo_config global_config font_descs
3032         global repo_config_new global_config_new
3033
3034         array unset repo_config_new
3035         array unset global_config_new
3036         foreach name [array names repo_config] {
3037                 set repo_config_new($name) $repo_config($name)
3038         }
3039         load_config 1
3040         foreach name [array names repo_config] {
3041                 switch -- $name {
3042                 gui.diffcontext {continue}
3043                 }
3044                 set repo_config_new($name) $repo_config($name)
3045         }
3046         foreach name [array names global_config] {
3047                 set global_config_new($name) $global_config($name)
3048         }
3049
3050         set w .options_editor
3051         toplevel $w
3052         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3053
3054         label $w.header -text "[appname] Options" \
3055                 -font font_uibold
3056         pack $w.header -side top -fill x
3057
3058         frame $w.buttons
3059         button $w.buttons.restore -text {Restore Defaults} \
3060                 -font font_ui \
3061                 -command do_restore_defaults
3062         pack $w.buttons.restore -side left
3063         button $w.buttons.save -text Save \
3064                 -font font_ui \
3065                 -command "
3066                         catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3067                         do_save_config $w
3068                 "
3069         pack $w.buttons.save -side right
3070         button $w.buttons.cancel -text {Cancel} \
3071                 -font font_ui \
3072                 -command [list destroy $w]
3073         pack $w.buttons.cancel -side right -padx 5
3074         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3075
3076         labelframe $w.repo -text "[reponame] Repository" \
3077                 -font font_ui \
3078                 -relief raised -borderwidth 2
3079         labelframe $w.global -text {Global (All Repositories)} \
3080                 -font font_ui \
3081                 -relief raised -borderwidth 2
3082         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3083         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3084
3085         foreach option {
3086                 {b pullsummary {Show Pull Summary}}
3087                 {b trustmtime  {Trust File Modification Timestamps}}
3088                 {i diffcontext {Number of Diff Context Lines}}
3089                 {t newbranchtemplate {New Branch Name Template}}
3090                 } {
3091                 set type [lindex $option 0]
3092                 set name [lindex $option 1]
3093                 set text [lindex $option 2]
3094                 foreach f {repo global} {
3095                         switch $type {
3096                         b {
3097                                 checkbutton $w.$f.$name -text $text \
3098                                         -variable ${f}_config_new(gui.$name) \
3099                                         -onvalue true \
3100                                         -offvalue false \
3101                                         -font font_ui
3102                                 pack $w.$f.$name -side top -anchor w
3103                         }
3104                         i {
3105                                 frame $w.$f.$name
3106                                 label $w.$f.$name.l -text "$text:" -font font_ui
3107                                 pack $w.$f.$name.l -side left -anchor w -fill x
3108                                 spinbox $w.$f.$name.v \
3109                                         -textvariable ${f}_config_new(gui.$name) \
3110                                         -from 1 -to 99 -increment 1 \
3111                                         -width 3 \
3112                                         -font font_ui
3113                                 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3114                                 pack $w.$f.$name.v -side right -anchor e -padx 5
3115                                 pack $w.$f.$name -side top -anchor w -fill x
3116                         }
3117                         t {
3118                                 frame $w.$f.$name
3119                                 label $w.$f.$name.l -text "$text:" -font font_ui
3120                                 text $w.$f.$name.v \
3121                                         -borderwidth 1 \
3122                                         -relief sunken \
3123                                         -height 1 \
3124                                         -width 20 \
3125                                         -font font_ui
3126                                 $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3127                                 bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3128                                 bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3129                                 bind $w.$f.$name.v <Key-Return> break
3130                                 bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3131                                 bind $w.$f.$name.v <FocusOut> "
3132                                         set ${f}_config_new(gui.$name) \
3133                                         \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3134                                 "
3135                                 pack $w.$f.$name.l -side left -anchor w
3136                                 pack $w.$f.$name.v -side left -anchor w \
3137                                         -fill x -expand 1 \
3138                                         -padx 5
3139                                 pack $w.$f.$name -side top -anchor w -fill x
3140                         }
3141                         }
3142                 }
3143         }
3144
3145         set all_fonts [lsort [font families]]
3146         foreach option $font_descs {
3147                 set name [lindex $option 0]
3148                 set font [lindex $option 1]
3149                 set text [lindex $option 2]
3150
3151                 set global_config_new(gui.$font^^family) \
3152                         [font configure $font -family]
3153                 set global_config_new(gui.$font^^size) \
3154                         [font configure $font -size]
3155
3156                 frame $w.global.$name
3157                 label $w.global.$name.l -text "$text:" -font font_ui
3158                 pack $w.global.$name.l -side left -anchor w -fill x
3159                 eval tk_optionMenu $w.global.$name.family \
3160                         global_config_new(gui.$font^^family) \
3161                         $all_fonts
3162                 spinbox $w.global.$name.size \
3163                         -textvariable global_config_new(gui.$font^^size) \
3164                         -from 2 -to 80 -increment 1 \
3165                         -width 3 \
3166                         -font font_ui
3167                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3168                 pack $w.global.$name.size -side right -anchor e
3169                 pack $w.global.$name.family -side right -anchor e
3170                 pack $w.global.$name -side top -anchor w -fill x
3171         }
3172
3173         bind $w <Visibility> "grab $w; focus $w"
3174         bind $w <Key-Escape> "destroy $w"
3175         wm title $w "[appname] ([reponame]): Options"
3176         tkwait window $w
3177 }
3178
3179 proc do_restore_defaults {} {
3180         global font_descs default_config repo_config
3181         global repo_config_new global_config_new
3182
3183         foreach name [array names default_config] {
3184                 set repo_config_new($name) $default_config($name)
3185                 set global_config_new($name) $default_config($name)
3186         }
3187
3188         foreach option $font_descs {
3189                 set name [lindex $option 0]
3190                 set repo_config(gui.$name) $default_config(gui.$name)
3191         }
3192         apply_config
3193
3194         foreach option $font_descs {
3195                 set name [lindex $option 0]
3196                 set font [lindex $option 1]
3197                 set global_config_new(gui.$font^^family) \
3198                         [font configure $font -family]
3199                 set global_config_new(gui.$font^^size) \
3200                         [font configure $font -size]
3201         }
3202 }
3203
3204 proc do_save_config {w} {
3205         if {[catch {save_config} err]} {
3206                 error_popup "Failed to completely save options:\n\n$err"
3207         }
3208         reshow_diff
3209         destroy $w
3210 }
3211
3212 proc do_windows_shortcut {} {
3213         global argv0
3214
3215         if {[catch {
3216                 set desktop [exec cygpath \
3217                         --windows \
3218                         --absolute \
3219                         --long-name \
3220                         --desktop]
3221                 }]} {
3222                         set desktop .
3223         }
3224         set fn [tk_getSaveFile \
3225                 -parent . \
3226                 -title "[appname] ([reponame]): Create Desktop Icon" \
3227                 -initialdir $desktop \
3228                 -initialfile "Git [reponame].bat"]
3229         if {$fn != {}} {
3230                 if {[catch {
3231                                 set fd [open $fn w]
3232                                 set sh [exec cygpath \
3233                                         --windows \
3234                                         --absolute \
3235                                         /bin/sh]
3236                                 set me [exec cygpath \
3237                                         --unix \
3238                                         --absolute \
3239                                         $argv0]
3240                                 set gd [exec cygpath \
3241                                         --unix \
3242                                         --absolute \
3243                                         [gitdir]]
3244                                 set gw [exec cygpath \
3245                                         --windows \
3246                                         --absolute \
3247                                         [file dirname [gitdir]]]
3248                                 regsub -all ' $me "'\\''" me
3249                                 regsub -all ' $gd "'\\''" gd
3250                                 puts $fd "@ECHO Entering $gw"
3251                                 puts $fd "@ECHO Starting git-gui... please wait..."
3252                                 puts -nonewline $fd "@\"$sh\" --login -c \""
3253                                 puts -nonewline $fd "GIT_DIR='$gd'"
3254                                 puts -nonewline $fd " '$me'"
3255                                 puts $fd "&\""
3256                                 close $fd
3257                         } err]} {
3258                         error_popup "Cannot write script:\n\n$err"
3259                 }
3260         }
3261 }
3262
3263 proc do_macosx_app {} {
3264         global argv0 env
3265
3266         set fn [tk_getSaveFile \
3267                 -parent . \
3268                 -title "[appname] ([reponame]): Create Desktop Icon" \
3269                 -initialdir [file join $env(HOME) Desktop] \
3270                 -initialfile "Git [reponame].app"]
3271         if {$fn != {}} {
3272                 if {[catch {
3273                                 set Contents [file join $fn Contents]
3274                                 set MacOS [file join $Contents MacOS]
3275                                 set exe [file join $MacOS git-gui]
3276
3277                                 file mkdir $MacOS
3278
3279                                 set fd [open [file join $Contents Info.plist] w]
3280                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3281 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3282 <plist version="1.0">
3283 <dict>
3284         <key>CFBundleDevelopmentRegion</key>
3285         <string>English</string>
3286         <key>CFBundleExecutable</key>
3287         <string>git-gui</string>
3288         <key>CFBundleIdentifier</key>
3289         <string>org.spearce.git-gui</string>
3290         <key>CFBundleInfoDictionaryVersion</key>
3291         <string>6.0</string>
3292         <key>CFBundlePackageType</key>
3293         <string>APPL</string>
3294         <key>CFBundleSignature</key>
3295         <string>????</string>
3296         <key>CFBundleVersion</key>
3297         <string>1.0</string>
3298         <key>NSPrincipalClass</key>
3299         <string>NSApplication</string>
3300 </dict>
3301 </plist>}
3302                                 close $fd
3303
3304                                 set fd [open $exe w]
3305                                 set gd [file normalize [gitdir]]
3306                                 set ep [file normalize [exec git --exec-path]]
3307                                 regsub -all ' $gd "'\\''" gd
3308                                 regsub -all ' $ep "'\\''" ep
3309                                 puts $fd "#!/bin/sh"
3310                                 foreach name [array names env] {
3311                                         if {[string match GIT_* $name]} {
3312                                                 regsub -all ' $env($name) "'\\''" v
3313                                                 puts $fd "export $name='$v'"
3314                                         }
3315                                 }
3316                                 puts $fd "export PATH='$ep':\$PATH"
3317                                 puts $fd "export GIT_DIR='$gd'"
3318                                 puts $fd "exec [file normalize $argv0]"
3319                                 close $fd
3320
3321                                 file attributes $exe -permissions u+x,g+x,o+x
3322                         } err]} {
3323                         error_popup "Cannot write icon:\n\n$err"
3324                 }
3325         }
3326 }
3327
3328 proc toggle_or_diff {w x y} {
3329         global file_states file_lists current_diff_path ui_index ui_workdir
3330         global last_clicked selected_paths
3331
3332         set pos [split [$w index @$x,$y] .]
3333         set lno [lindex $pos 0]
3334         set col [lindex $pos 1]
3335         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3336         if {$path eq {}} {
3337                 set last_clicked {}
3338                 return
3339         }
3340
3341         set last_clicked [list $w $lno]
3342         array unset selected_paths
3343         $ui_index tag remove in_sel 0.0 end
3344         $ui_workdir tag remove in_sel 0.0 end
3345
3346         if {$col == 0} {
3347                 if {$current_diff_path eq $path} {
3348                         set after {reshow_diff;}
3349                 } else {
3350                         set after {}
3351                 }
3352                 if {$w eq $ui_index} {
3353                         update_indexinfo \
3354                                 "Unstaging [short_path $path] from commit" \
3355                                 [list $path] \
3356                                 [concat $after {set ui_status_value {Ready.}}]
3357                 } elseif {$w eq $ui_workdir} {
3358                         update_index \
3359                                 "Adding [short_path $path]" \
3360                                 [list $path] \
3361                                 [concat $after {set ui_status_value {Ready.}}]
3362                 }
3363         } else {
3364                 show_diff $path $w $lno
3365         }
3366 }
3367
3368 proc add_one_to_selection {w x y} {
3369         global file_lists last_clicked selected_paths
3370
3371         set lno [lindex [split [$w index @$x,$y] .] 0]
3372         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3373         if {$path eq {}} {
3374                 set last_clicked {}
3375                 return
3376         }
3377
3378         if {$last_clicked ne {}
3379                 && [lindex $last_clicked 0] ne $w} {
3380                 array unset selected_paths
3381                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3382         }
3383
3384         set last_clicked [list $w $lno]
3385         if {[catch {set in_sel $selected_paths($path)}]} {
3386                 set in_sel 0
3387         }
3388         if {$in_sel} {
3389                 unset selected_paths($path)
3390                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3391         } else {
3392                 set selected_paths($path) 1
3393                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3394         }
3395 }
3396
3397 proc add_range_to_selection {w x y} {
3398         global file_lists last_clicked selected_paths
3399
3400         if {[lindex $last_clicked 0] ne $w} {
3401                 toggle_or_diff $w $x $y
3402                 return
3403         }
3404
3405         set lno [lindex [split [$w index @$x,$y] .] 0]
3406         set lc [lindex $last_clicked 1]
3407         if {$lc < $lno} {
3408                 set begin $lc
3409                 set end $lno
3410         } else {
3411                 set begin $lno
3412                 set end $lc
3413         }
3414
3415         foreach path [lrange $file_lists($w) \
3416                 [expr {$begin - 1}] \
3417                 [expr {$end - 1}]] {
3418                 set selected_paths($path) 1
3419         }
3420         $w tag add in_sel $begin.0 [expr {$end + 1}].0
3421 }
3422
3423 ######################################################################
3424 ##
3425 ## config defaults
3426
3427 set cursor_ptr arrow
3428 font create font_diff -family Courier -size 10
3429 font create font_ui
3430 catch {
3431         label .dummy
3432         eval font configure font_ui [font actual [.dummy cget -font]]
3433         destroy .dummy
3434 }
3435
3436 font create font_uibold
3437 font create font_diffbold
3438
3439 if {[is_Windows]} {
3440         set M1B Control
3441         set M1T Ctrl
3442 } elseif {[is_MacOSX]} {
3443         set M1B M1
3444         set M1T Cmd
3445 } else {
3446         set M1B M1
3447         set M1T M1
3448 }
3449
3450 proc apply_config {} {
3451         global repo_config font_descs
3452
3453         foreach option $font_descs {
3454                 set name [lindex $option 0]
3455                 set font [lindex $option 1]
3456                 if {[catch {
3457                         foreach {cn cv} $repo_config(gui.$name) {
3458                                 font configure $font $cn $cv
3459                         }
3460                         } err]} {
3461                         error_popup "Invalid font specified in gui.$name:\n\n$err"
3462                 }
3463                 foreach {cn cv} [font configure $font] {
3464                         font configure ${font}bold $cn $cv
3465                 }
3466                 font configure ${font}bold -weight bold
3467         }
3468 }
3469
3470 set default_config(gui.trustmtime) false
3471 set default_config(gui.pullsummary) true
3472 set default_config(gui.diffcontext) 5
3473 set default_config(gui.newbranchtemplate) {}
3474 set default_config(gui.fontui) [font configure font_ui]
3475 set default_config(gui.fontdiff) [font configure font_diff]
3476 set font_descs {
3477         {fontui   font_ui   {Main Font}}
3478         {fontdiff font_diff {Diff/Console Font}}
3479 }
3480 load_config 0
3481 apply_config
3482
3483 ######################################################################
3484 ##
3485 ## ui construction
3486
3487 # -- Menu Bar
3488 #
3489 menu .mbar -tearoff 0
3490 .mbar add cascade -label Repository -menu .mbar.repository
3491 .mbar add cascade -label Edit -menu .mbar.edit
3492 if {!$single_commit} {
3493         .mbar add cascade -label Branch -menu .mbar.branch
3494 }
3495 .mbar add cascade -label Commit -menu .mbar.commit
3496 if {!$single_commit} {
3497         .mbar add cascade -label Fetch -menu .mbar.fetch
3498         .mbar add cascade -label Pull -menu .mbar.pull
3499         .mbar add cascade -label Push -menu .mbar.push
3500 }
3501 . configure -menu .mbar
3502
3503 # -- Repository Menu
3504 #
3505 menu .mbar.repository
3506 .mbar.repository add command \
3507         -label {Visualize Current Branch} \
3508         -command {do_gitk {}} \
3509         -font font_ui
3510 if {![is_MacOSX]} {
3511         .mbar.repository add command \
3512                 -label {Visualize All Branches} \
3513                 -command {do_gitk {--all}} \
3514                 -font font_ui
3515 }
3516 .mbar.repository add separator
3517
3518 if {!$single_commit} {
3519         .mbar.repository add command -label {Compress Database} \
3520                 -command do_gc \
3521                 -font font_ui
3522
3523         .mbar.repository add command -label {Verify Database} \
3524                 -command do_fsck_objects \
3525                 -font font_ui
3526
3527         .mbar.repository add separator
3528
3529         if {[is_Windows]} {
3530                 .mbar.repository add command \
3531                         -label {Create Desktop Icon} \
3532                         -command do_windows_shortcut \
3533                         -font font_ui
3534         } elseif {[is_MacOSX]} {
3535                 .mbar.repository add command \
3536                         -label {Create Desktop Icon} \
3537                         -command do_macosx_app \
3538                         -font font_ui
3539         }
3540 }
3541
3542 .mbar.repository add command -label Quit \
3543         -command do_quit \
3544         -accelerator $M1T-Q \
3545         -font font_ui
3546
3547 # -- Edit Menu
3548 #
3549 menu .mbar.edit
3550 .mbar.edit add command -label Undo \
3551         -command {catch {[focus] edit undo}} \
3552         -accelerator $M1T-Z \
3553         -font font_ui
3554 .mbar.edit add command -label Redo \
3555         -command {catch {[focus] edit redo}} \
3556         -accelerator $M1T-Y \
3557         -font font_ui
3558 .mbar.edit add separator
3559 .mbar.edit add command -label Cut \
3560         -command {catch {tk_textCut [focus]}} \
3561         -accelerator $M1T-X \
3562         -font font_ui
3563 .mbar.edit add command -label Copy \
3564         -command {catch {tk_textCopy [focus]}} \
3565         -accelerator $M1T-C \
3566         -font font_ui
3567 .mbar.edit add command -label Paste \
3568         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3569         -accelerator $M1T-V \
3570         -font font_ui
3571 .mbar.edit add command -label Delete \
3572         -command {catch {[focus] delete sel.first sel.last}} \
3573         -accelerator Del \
3574         -font font_ui
3575 .mbar.edit add separator
3576 .mbar.edit add command -label {Select All} \
3577         -command {catch {[focus] tag add sel 0.0 end}} \
3578         -accelerator $M1T-A \
3579         -font font_ui
3580
3581 # -- Branch Menu
3582 #
3583 if {!$single_commit} {
3584         menu .mbar.branch
3585
3586         .mbar.branch add command -label {Create...} \
3587                 -command do_create_branch \
3588                 -accelerator $M1T-N \
3589                 -font font_ui
3590         lappend disable_on_lock [list .mbar.branch entryconf \
3591                 [.mbar.branch index last] -state]
3592
3593         .mbar.branch add command -label {Delete...} \
3594                 -command do_delete_branch \
3595                 -font font_ui
3596         lappend disable_on_lock [list .mbar.branch entryconf \
3597                 [.mbar.branch index last] -state]
3598 }
3599
3600 # -- Commit Menu
3601 #
3602 menu .mbar.commit
3603
3604 .mbar.commit add radiobutton \
3605         -label {New Commit} \
3606         -command do_select_commit_type \
3607         -variable selected_commit_type \
3608         -value new \
3609         -font font_ui
3610 lappend disable_on_lock \
3611         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3612
3613 .mbar.commit add radiobutton \
3614         -label {Amend Last Commit} \
3615         -command do_select_commit_type \
3616         -variable selected_commit_type \
3617         -value amend \
3618         -font font_ui
3619 lappend disable_on_lock \
3620         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3621
3622 .mbar.commit add separator
3623
3624 .mbar.commit add command -label Rescan \
3625         -command do_rescan \
3626         -accelerator F5 \
3627         -font font_ui
3628 lappend disable_on_lock \
3629         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3630
3631 .mbar.commit add command -label {Add To Commit} \
3632         -command do_add_selection \
3633         -font font_ui
3634 lappend disable_on_lock \
3635         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3636
3637 .mbar.commit add command -label {Add All To Commit} \
3638         -command do_add_all \
3639         -accelerator $M1T-I \
3640         -font font_ui
3641 lappend disable_on_lock \
3642         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3643
3644 .mbar.commit add command -label {Unstage From Commit} \
3645         -command do_unstage_selection \
3646         -font font_ui
3647 lappend disable_on_lock \
3648         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3649
3650 .mbar.commit add command -label {Revert Changes} \
3651         -command do_revert_selection \
3652         -font font_ui
3653 lappend disable_on_lock \
3654         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3655
3656 .mbar.commit add separator
3657
3658 .mbar.commit add command -label {Sign Off} \
3659         -command do_signoff \
3660         -accelerator $M1T-S \
3661         -font font_ui
3662
3663 .mbar.commit add command -label Commit \
3664         -command do_commit \
3665         -accelerator $M1T-Return \
3666         -font font_ui
3667 lappend disable_on_lock \
3668         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3669
3670 # -- Transport menus
3671 #
3672 if {!$single_commit} {
3673         menu .mbar.fetch
3674         menu .mbar.pull
3675         menu .mbar.push
3676 }
3677
3678 if {[is_MacOSX]} {
3679         # -- Apple Menu (Mac OS X only)
3680         #
3681         .mbar add cascade -label Apple -menu .mbar.apple
3682         menu .mbar.apple
3683
3684         .mbar.apple add command -label "About [appname]" \
3685                 -command do_about \
3686                 -font font_ui
3687         .mbar.apple add command -label "[appname] Options..." \
3688                 -command do_options \
3689                 -font font_ui
3690 } else {
3691         # -- Edit Menu
3692         #
3693         .mbar.edit add separator
3694         .mbar.edit add command -label {Options...} \
3695                 -command do_options \
3696                 -font font_ui
3697
3698         # -- Tools Menu
3699         #
3700         if {[file exists /usr/local/miga/lib/gui-miga]
3701                 && [file exists .pvcsrc]} {
3702         proc do_miga {} {
3703                 global ui_status_value
3704                 if {![lock_index update]} return
3705                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3706                 set miga_fd [open "|$cmd" r]
3707                 fconfigure $miga_fd -blocking 0
3708                 fileevent $miga_fd readable [list miga_done $miga_fd]
3709                 set ui_status_value {Running miga...}
3710         }
3711         proc miga_done {fd} {
3712                 read $fd 512
3713                 if {[eof $fd]} {
3714                         close $fd
3715                         unlock_index
3716                         rescan [list set ui_status_value {Ready.}]
3717                 }
3718         }
3719         .mbar add cascade -label Tools -menu .mbar.tools
3720         menu .mbar.tools
3721         .mbar.tools add command -label "Migrate" \
3722                 -command do_miga \
3723                 -font font_ui
3724         lappend disable_on_lock \
3725                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3726         }
3727
3728         # -- Help Menu
3729         #
3730         .mbar add cascade -label Help -menu .mbar.help
3731         menu .mbar.help
3732
3733         .mbar.help add command -label "About [appname]" \
3734                 -command do_about \
3735                 -font font_ui
3736 }
3737
3738
3739 # -- Branch Control
3740 #
3741 frame .branch \
3742         -borderwidth 1 \
3743         -relief sunken
3744 label .branch.l1 \
3745         -text {Current Branch:} \
3746         -anchor w \
3747         -justify left \
3748         -font font_ui
3749 label .branch.cb \
3750         -textvariable current_branch \
3751         -anchor w \
3752         -justify left \
3753         -font font_ui
3754 pack .branch.l1 -side left
3755 pack .branch.cb -side left -fill x
3756 pack .branch -side top -fill x
3757
3758 # -- Main Window Layout
3759 #
3760 panedwindow .vpane -orient vertical
3761 panedwindow .vpane.files -orient horizontal
3762 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3763 pack .vpane -anchor n -side top -fill both -expand 1
3764
3765 # -- Index File List
3766 #
3767 frame .vpane.files.index -height 100 -width 200
3768 label .vpane.files.index.title -text {Changes To Be Committed} \
3769         -background green \
3770         -font font_ui
3771 text $ui_index -background white -borderwidth 0 \
3772         -width 20 -height 10 \
3773         -wrap none \
3774         -font font_ui \
3775         -cursor $cursor_ptr \
3776         -xscrollcommand {.vpane.files.index.sx set} \
3777         -yscrollcommand {.vpane.files.index.sy set} \
3778         -state disabled
3779 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3780 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3781 pack .vpane.files.index.title -side top -fill x
3782 pack .vpane.files.index.sx -side bottom -fill x
3783 pack .vpane.files.index.sy -side right -fill y
3784 pack $ui_index -side left -fill both -expand 1
3785 .vpane.files add .vpane.files.index -sticky nsew
3786
3787 # -- Working Directory File List
3788 #
3789 frame .vpane.files.workdir -height 100 -width 200
3790 label .vpane.files.workdir.title -text {Changed But Not Updated} \
3791         -background red \
3792         -font font_ui
3793 text $ui_workdir -background white -borderwidth 0 \
3794         -width 20 -height 10 \
3795         -wrap none \
3796         -font font_ui \
3797         -cursor $cursor_ptr \
3798         -xscrollcommand {.vpane.files.workdir.sx set} \
3799         -yscrollcommand {.vpane.files.workdir.sy set} \
3800         -state disabled
3801 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3802 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3803 pack .vpane.files.workdir.title -side top -fill x
3804 pack .vpane.files.workdir.sx -side bottom -fill x
3805 pack .vpane.files.workdir.sy -side right -fill y
3806 pack $ui_workdir -side left -fill both -expand 1
3807 .vpane.files add .vpane.files.workdir -sticky nsew
3808
3809 foreach i [list $ui_index $ui_workdir] {
3810         $i tag conf in_diff -font font_uibold
3811         $i tag conf in_sel \
3812                 -background [$i cget -foreground] \
3813                 -foreground [$i cget -background]
3814 }
3815 unset i
3816
3817 # -- Diff and Commit Area
3818 #
3819 frame .vpane.lower -height 300 -width 400
3820 frame .vpane.lower.commarea
3821 frame .vpane.lower.diff -relief sunken -borderwidth 1
3822 pack .vpane.lower.commarea -side top -fill x
3823 pack .vpane.lower.diff -side bottom -fill both -expand 1
3824 .vpane add .vpane.lower -stick nsew
3825
3826 # -- Commit Area Buttons
3827 #
3828 frame .vpane.lower.commarea.buttons
3829 label .vpane.lower.commarea.buttons.l -text {} \
3830         -anchor w \
3831         -justify left \
3832         -font font_ui
3833 pack .vpane.lower.commarea.buttons.l -side top -fill x
3834 pack .vpane.lower.commarea.buttons -side left -fill y
3835
3836 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3837         -command do_rescan \
3838         -font font_ui
3839 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3840 lappend disable_on_lock \
3841         {.vpane.lower.commarea.buttons.rescan conf -state}
3842
3843 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3844         -command do_add_all \
3845         -font font_ui
3846 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3847 lappend disable_on_lock \
3848         {.vpane.lower.commarea.buttons.incall conf -state}
3849
3850 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3851         -command do_signoff \
3852         -font font_ui
3853 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3854
3855 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3856         -command do_commit \
3857         -font font_ui
3858 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3859 lappend disable_on_lock \
3860         {.vpane.lower.commarea.buttons.commit conf -state}
3861
3862 # -- Commit Message Buffer
3863 #
3864 frame .vpane.lower.commarea.buffer
3865 frame .vpane.lower.commarea.buffer.header
3866 set ui_comm .vpane.lower.commarea.buffer.t
3867 set ui_coml .vpane.lower.commarea.buffer.header.l
3868 radiobutton .vpane.lower.commarea.buffer.header.new \
3869         -text {New Commit} \
3870         -command do_select_commit_type \
3871         -variable selected_commit_type \
3872         -value new \
3873         -font font_ui
3874 lappend disable_on_lock \
3875         [list .vpane.lower.commarea.buffer.header.new conf -state]
3876 radiobutton .vpane.lower.commarea.buffer.header.amend \
3877         -text {Amend Last Commit} \
3878         -command do_select_commit_type \
3879         -variable selected_commit_type \
3880         -value amend \
3881         -font font_ui
3882 lappend disable_on_lock \
3883         [list .vpane.lower.commarea.buffer.header.amend conf -state]
3884 label $ui_coml \
3885         -anchor w \
3886         -justify left \
3887         -font font_ui
3888 proc trace_commit_type {varname args} {
3889         global ui_coml commit_type
3890         switch -glob -- $commit_type {
3891         initial       {set txt {Initial Commit Message:}}
3892         amend         {set txt {Amended Commit Message:}}
3893         amend-initial {set txt {Amended Initial Commit Message:}}
3894         amend-merge   {set txt {Amended Merge Commit Message:}}
3895         merge         {set txt {Merge Commit Message:}}
3896         *             {set txt {Commit Message:}}
3897         }
3898         $ui_coml conf -text $txt
3899 }
3900 trace add variable commit_type write trace_commit_type
3901 pack $ui_coml -side left -fill x
3902 pack .vpane.lower.commarea.buffer.header.amend -side right
3903 pack .vpane.lower.commarea.buffer.header.new -side right
3904
3905 text $ui_comm -background white -borderwidth 1 \
3906         -undo true \
3907         -maxundo 20 \
3908         -autoseparators true \
3909         -relief sunken \
3910         -width 75 -height 9 -wrap none \
3911         -font font_diff \
3912         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3913 scrollbar .vpane.lower.commarea.buffer.sby \
3914         -command [list $ui_comm yview]
3915 pack .vpane.lower.commarea.buffer.header -side top -fill x
3916 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3917 pack $ui_comm -side left -fill y
3918 pack .vpane.lower.commarea.buffer -side left -fill y
3919
3920 # -- Commit Message Buffer Context Menu
3921 #
3922 set ctxm .vpane.lower.commarea.buffer.ctxm
3923 menu $ctxm -tearoff 0
3924 $ctxm add command \
3925         -label {Cut} \
3926         -font font_ui \
3927         -command {tk_textCut $ui_comm}
3928 $ctxm add command \
3929         -label {Copy} \
3930         -font font_ui \
3931         -command {tk_textCopy $ui_comm}
3932 $ctxm add command \
3933         -label {Paste} \
3934         -font font_ui \
3935         -command {tk_textPaste $ui_comm}
3936 $ctxm add command \
3937         -label {Delete} \
3938         -font font_ui \
3939         -command {$ui_comm delete sel.first sel.last}
3940 $ctxm add separator
3941 $ctxm add command \
3942         -label {Select All} \
3943         -font font_ui \
3944         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3945 $ctxm add command \
3946         -label {Copy All} \
3947         -font font_ui \
3948         -command {
3949                 $ui_comm tag add sel 0.0 end
3950                 tk_textCopy $ui_comm
3951                 $ui_comm tag remove sel 0.0 end
3952         }
3953 $ctxm add separator
3954 $ctxm add command \
3955         -label {Sign Off} \
3956         -font font_ui \
3957         -command do_signoff
3958 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3959
3960 # -- Diff Header
3961 #
3962 set current_diff_path {}
3963 set diff_actions [list]
3964 proc trace_current_diff_path {varname args} {
3965         global current_diff_path diff_actions file_states
3966         if {$current_diff_path eq {}} {
3967                 set s {}
3968                 set f {}
3969                 set p {}
3970                 set o disabled
3971         } else {
3972                 set p $current_diff_path
3973                 set s [mapdesc [lindex $file_states($p) 0] $p]
3974                 set f {File:}
3975                 set p [escape_path $p]
3976                 set o normal
3977         }
3978
3979         .vpane.lower.diff.header.status configure -text $s
3980         .vpane.lower.diff.header.file configure -text $f
3981         .vpane.lower.diff.header.path configure -text $p
3982         foreach w $diff_actions {
3983                 uplevel #0 $w $o
3984         }
3985 }
3986 trace add variable current_diff_path write trace_current_diff_path
3987
3988 frame .vpane.lower.diff.header -background orange
3989 label .vpane.lower.diff.header.status \
3990         -background orange \
3991         -width $max_status_desc \
3992         -anchor w \
3993         -justify left \
3994         -font font_ui
3995 label .vpane.lower.diff.header.file \
3996         -background orange \
3997         -anchor w \
3998         -justify left \
3999         -font font_ui
4000 label .vpane.lower.diff.header.path \
4001         -background orange \
4002         -anchor w \
4003         -justify left \
4004         -font font_ui
4005 pack .vpane.lower.diff.header.status -side left
4006 pack .vpane.lower.diff.header.file -side left
4007 pack .vpane.lower.diff.header.path -fill x
4008 set ctxm .vpane.lower.diff.header.ctxm
4009 menu $ctxm -tearoff 0
4010 $ctxm add command \
4011         -label {Copy} \
4012         -font font_ui \
4013         -command {
4014                 clipboard clear
4015                 clipboard append \
4016                         -format STRING \
4017                         -type STRING \
4018                         -- $current_diff_path
4019         }
4020 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4021 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4022
4023 # -- Diff Body
4024 #
4025 frame .vpane.lower.diff.body
4026 set ui_diff .vpane.lower.diff.body.t
4027 text $ui_diff -background white -borderwidth 0 \
4028         -width 80 -height 15 -wrap none \
4029         -font font_diff \
4030         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4031         -yscrollcommand {.vpane.lower.diff.body.sby set} \
4032         -state disabled
4033 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4034         -command [list $ui_diff xview]
4035 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4036         -command [list $ui_diff yview]
4037 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4038 pack .vpane.lower.diff.body.sby -side right -fill y
4039 pack $ui_diff -side left -fill both -expand 1
4040 pack .vpane.lower.diff.header -side top -fill x
4041 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4042
4043 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4044 $ui_diff tag conf d_+ -foreground {#00a000}
4045 $ui_diff tag conf d_- -foreground red
4046
4047 $ui_diff tag conf d_++ -foreground {#00a000}
4048 $ui_diff tag conf d_-- -foreground red
4049 $ui_diff tag conf d_+s \
4050         -foreground {#00a000} \
4051         -background {#e2effa}
4052 $ui_diff tag conf d_-s \
4053         -foreground red \
4054         -background {#e2effa}
4055 $ui_diff tag conf d_s+ \
4056         -foreground {#00a000} \
4057         -background ivory1
4058 $ui_diff tag conf d_s- \
4059         -foreground red \
4060         -background ivory1
4061
4062 $ui_diff tag conf d<<<<<<< \
4063         -foreground orange \
4064         -font font_diffbold
4065 $ui_diff tag conf d======= \
4066         -foreground orange \
4067         -font font_diffbold
4068 $ui_diff tag conf d>>>>>>> \
4069         -foreground orange \
4070         -font font_diffbold
4071
4072 $ui_diff tag raise sel
4073
4074 # -- Diff Body Context Menu
4075 #
4076 set ctxm .vpane.lower.diff.body.ctxm
4077 menu $ctxm -tearoff 0
4078 $ctxm add command \
4079         -label {Refresh} \
4080         -font font_ui \
4081         -command reshow_diff
4082 $ctxm add command \
4083         -label {Copy} \
4084         -font font_ui \
4085         -command {tk_textCopy $ui_diff}
4086 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4087 $ctxm add command \
4088         -label {Select All} \
4089         -font font_ui \
4090         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4091 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4092 $ctxm add command \
4093         -label {Copy All} \
4094         -font font_ui \
4095         -command {
4096                 $ui_diff tag add sel 0.0 end
4097                 tk_textCopy $ui_diff
4098                 $ui_diff tag remove sel 0.0 end
4099         }
4100 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4101 $ctxm add separator
4102 $ctxm add command \
4103         -label {Decrease Font Size} \
4104         -font font_ui \
4105         -command {incr_font_size font_diff -1}
4106 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4107 $ctxm add command \
4108         -label {Increase Font Size} \
4109         -font font_ui \
4110         -command {incr_font_size font_diff 1}
4111 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4112 $ctxm add separator
4113 $ctxm add command \
4114         -label {Show Less Context} \
4115         -font font_ui \
4116         -command {if {$repo_config(gui.diffcontext) >= 2} {
4117                 incr repo_config(gui.diffcontext) -1
4118                 reshow_diff
4119         }}
4120 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4121 $ctxm add command \
4122         -label {Show More Context} \
4123         -font font_ui \
4124         -command {
4125                 incr repo_config(gui.diffcontext)
4126                 reshow_diff
4127         }
4128 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4129 $ctxm add separator
4130 $ctxm add command -label {Options...} \
4131         -font font_ui \
4132         -command do_options
4133 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
4134
4135 # -- Status Bar
4136 #
4137 set ui_status_value {Initializing...}
4138 label .status -textvariable ui_status_value \
4139         -anchor w \
4140         -justify left \
4141         -borderwidth 1 \
4142         -relief sunken \
4143         -font font_ui
4144 pack .status -anchor w -side bottom -fill x
4145
4146 # -- Load geometry
4147 #
4148 catch {
4149 set gm $repo_config(gui.geometry)
4150 wm geometry . [lindex $gm 0]
4151 .vpane sash place 0 \
4152         [lindex [.vpane sash coord 0] 0] \
4153         [lindex $gm 1]
4154 .vpane.files sash place 0 \
4155         [lindex $gm 2] \
4156         [lindex [.vpane.files sash coord 0] 1]
4157 unset gm
4158 }
4159
4160 # -- Key Bindings
4161 #
4162 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4163 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4164 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4165 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4166 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4167 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4168 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4169 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4170 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4171 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4172 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4173
4174 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4175 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4176 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4177 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4178 bind $ui_diff <$M1B-Key-v> {break}
4179 bind $ui_diff <$M1B-Key-V> {break}
4180 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4181 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4182 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4183 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4184 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4185 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4186
4187 if {!$single_commit} {
4188         bind . <$M1B-Key-n> do_create_branch
4189         bind . <$M1B-Key-N> do_create_branch
4190 }
4191
4192 bind .   <Destroy> do_quit
4193 bind all <Key-F5> do_rescan
4194 bind all <$M1B-Key-r> do_rescan
4195 bind all <$M1B-Key-R> do_rescan
4196 bind .   <$M1B-Key-s> do_signoff
4197 bind .   <$M1B-Key-S> do_signoff
4198 bind .   <$M1B-Key-i> do_add_all
4199 bind .   <$M1B-Key-I> do_add_all
4200 bind .   <$M1B-Key-Return> do_commit
4201 bind all <$M1B-Key-q> do_quit
4202 bind all <$M1B-Key-Q> do_quit
4203 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4204 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4205 foreach i [list $ui_index $ui_workdir] {
4206         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4207         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4208         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4209 }
4210 unset i
4211
4212 set file_lists($ui_index) [list]
4213 set file_lists($ui_workdir) [list]
4214
4215 set HEAD {}
4216 set PARENT {}
4217 set MERGE_HEAD [list]
4218 set commit_type {}
4219 set empty_tree {}
4220 set current_branch {}
4221 set current_diff_path {}
4222 set selected_commit_type new
4223
4224 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4225 focus -force $ui_comm
4226
4227 # -- Warn the user about environmental problems.  Cygwin's Tcl
4228 #    does *not* pass its env array onto any processes it spawns.
4229 #    This means that git processes get none of our environment.
4230 #
4231 if {[is_Windows]} {
4232         set ignored_env 0
4233         set suggest_user {}
4234         set msg "Possible environment issues exist.
4235
4236 The following environment variables are probably
4237 going to be ignored by any Git subprocess run
4238 by [appname]:
4239
4240 "
4241         foreach name [array names env] {
4242                 switch -regexp -- $name {
4243                 {^GIT_INDEX_FILE$} -
4244                 {^GIT_OBJECT_DIRECTORY$} -
4245                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4246                 {^GIT_DIFF_OPTS$} -
4247                 {^GIT_EXTERNAL_DIFF$} -
4248                 {^GIT_PAGER$} -
4249                 {^GIT_TRACE$} -
4250                 {^GIT_CONFIG$} -
4251                 {^GIT_CONFIG_LOCAL$} -
4252                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4253                         append msg " - $name\n"
4254                         incr ignored_env
4255                 }
4256                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4257                         append msg " - $name\n"
4258                         incr ignored_env
4259                         set suggest_user $name
4260                 }
4261                 }
4262         }
4263         if {$ignored_env > 0} {
4264                 append msg "
4265 This is due to a known issue with the
4266 Tcl binary distributed by Cygwin."
4267
4268                 if {$suggest_user ne {}} {
4269                         append msg "
4270
4271 A good replacement for $suggest_user
4272 is placing values for the user.name and
4273 user.email settings into your personal
4274 ~/.gitconfig file.
4275 "
4276                 }
4277                 warn_popup $msg
4278         }
4279         unset ignored_env msg suggest_user name
4280 }
4281
4282 # -- Only initialize complex UI if we are going to stay running.
4283 #
4284 if {!$single_commit} {
4285         load_all_remotes
4286         load_all_heads
4287
4288         populate_branch_menu
4289         populate_fetch_menu .mbar.fetch
4290         populate_pull_menu .mbar.pull
4291         populate_push_menu .mbar.push
4292 }
4293
4294 # -- Only suggest a gc run if we are going to stay running.
4295 #
4296 if {!$single_commit} {
4297         set object_limit 2000
4298         if {[is_Windows]} {set object_limit 200}
4299         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4300         if {$objects_current >= $object_limit} {
4301                 if {[ask_popup \
4302                         "This repository currently has $objects_current loose objects.
4303
4304 To maintain optimal performance it is strongly
4305 recommended that you compress the database
4306 when more than $object_limit loose objects exist.
4307
4308 Compress the database now?"] eq yes} {
4309                         do_gc
4310                 }
4311         }
4312         unset object_limit _junk objects_current
4313 }
4314
4315 lock_index begin-read
4316 after 1 do_rescan