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