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