git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 set appname [lindex [file split $argv0] end]
  11 set gitdir {}
  12
  13 ######################################################################
  14 ##
  15 ## config
  16
  17 proc is_many_config {name} {
  18         switch -glob -- $name {
  19         remote.*.fetch -
  20         remote.*.push
  21                 {return 1}
  22         *
  23                 {return 0}
  24         }
  25 }
  26
  27 proc load_config {include_global} {
  28         global repo_config global_config default_config
  29
  30         array unset global_config
  31         if {$include_global} {
  32                 catch {
  33                         set fd_rc [open "| git repo-config --global --list" r]
  34                         while {[gets $fd_rc line] >= 0} {
  35                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                         if {[is_many_config $name]} {
  37                                                 lappend global_config($name) $value
  38                                         } else {
  39                                                 set global_config($name) $value
  40                                         }
  41                                 }
  42                         }
  43                         close $fd_rc
  44                 }
  45         }
  46
  47         array unset repo_config
  48         catch {
  49                 set fd_rc [open "| git repo-config --list" r]
  50                 while {[gets $fd_rc line] >= 0} {
  51                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                 if {[is_many_config $name]} {
  53                                         lappend repo_config($name) $value
  54                                 } else {
  55                                         set repo_config($name) $value
  56                                 }
  57                         }
  58                 }
  59                 close $fd_rc
  60         }
  61
  62         foreach name [array names default_config] {
  63                 if {[catch {set v $global_config($name)}]} {
  64                         set global_config($name) $default_config($name)
  65                 }
  66                 if {[catch {set v $repo_config($name)}]} {
  67                         set repo_config($name) $default_config($name)
  68                 }
  69         }
  70 }
  71
  72 proc save_config {} {
  73         global default_config font_descs
  74         global repo_config global_config
  75         global repo_config_new global_config_new
  76
  77         foreach option $font_descs {
  78                 set name [lindex $option 0]
  79                 set font [lindex $option 1]
  80                 font configure $font \
  81                         -family $global_config_new(gui.$font^^family) \
  82                         -size $global_config_new(gui.$font^^size)
  83                 font configure ${font}bold \
  84                         -family $global_config_new(gui.$font^^family) \
  85                         -size $global_config_new(gui.$font^^size)
  86                 set global_config_new(gui.$name) [font configure $font]
  87                 unset global_config_new(gui.$font^^family)
  88                 unset global_config_new(gui.$font^^size)
  89         }
  90
  91         foreach name [array names default_config] {
  92                 set value $global_config_new($name)
  93                 if {$value ne $global_config($name)} {
  94                         if {$value eq $default_config($name)} {
  95                                 catch {exec git repo-config --global --unset $name}
  96                         } else {
  97                                 regsub -all "\[{}\]" $value {"} value
  98                                 exec git repo-config --global $name $value
  99                         }
 100                         set global_config($name) $value
 101                         if {$value eq $repo_config($name)} {
 102                                 catch {exec git repo-config --unset $name}
 103                                 set repo_config($name) $value
 104                         }
 105                 }
 106         }
 107
 108         foreach name [array names default_config] {
 109                 set value $repo_config_new($name)
 110                 if {$value ne $repo_config($name)} {
 111                         if {$value eq $global_config($name)} {
 112                                 catch {exec git repo-config --unset $name}
 113                         } else {
 114                                 regsub -all "\[{}\]" $value {"} value
 115                                 exec git repo-config $name $value
 116                         }
 117                         set repo_config($name) $value
 118                 }
 119         }
 120 }
 121
 122 proc error_popup {msg} {
 123         global gitdir appname
 124
 125         set title $appname
 126         if {$gitdir ne {}} {
 127                 append title { (}
 128                 append title [lindex \
 129                         [file split [file normalize [file dirname $gitdir]]] \
 130                         end]
 131                 append title {)}
 132         }
 133         set cmd [list tk_messageBox \
 134                 -icon error \
 135                 -type ok \
 136                 -title "$title: error" \
 137                 -message $msg]
 138         if {[winfo ismapped .]} {
 139                 lappend cmd -parent .
 140         }
 141         eval $cmd
 142 }
 143
 144 proc info_popup {msg} {
 145         global gitdir appname
 146
 147         set title $appname
 148         if {$gitdir ne {}} {
 149                 append title { (}
 150                 append title [lindex \
 151                         [file split [file normalize [file dirname $gitdir]]] \
 152                         end]
 153                 append title {)}
 154         }
 155         tk_messageBox \
 156                 -parent . \
 157                 -icon error \
 158                 -type ok \
 159                 -title $title \
 160                 -message $msg
 161 }
 162
 163 ######################################################################
 164 ##
 165 ## repository setup
 166
 167 if {   [catch {set gitdir $env(GIT_DIR)}]
 168         && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 169         catch {wm withdraw .}
 170         error_popup "Cannot find the git directory:\n\n$err"
 171         exit 1
 172 }
 173 if {![file isdirectory $gitdir]} {
 174         catch {wm withdraw .}
 175         error_popup "Git directory not found:\n\n$gitdir"
 176         exit 1
 177 }
 178 if {[lindex [file split $gitdir] end] ne {.git}} {
 179         catch {wm withdraw .}
 180         error_popup "Cannot use funny .git directory:\n\n$gitdir"
 181         exit 1
 182 }
 183 if {[catch {cd [file dirname $gitdir]} err]} {
 184         catch {wm withdraw .}
 185         error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 186         exit 1
 187 }
 188
 189 set single_commit 0
 190 if {$appname eq {git-citool}} {
 191         set single_commit 1
 192 }
 193
 194 ######################################################################
 195 ##
 196 ## task management
 197
 198 set rescan_active 0
 199 set diff_active 0
 200 set last_clicked {}
 201
 202 set disable_on_lock [list]
 203 set index_lock_type none
 204
 205 proc lock_index {type} {
 206         global index_lock_type disable_on_lock
 207
 208         if {$index_lock_type eq {none}} {
 209                 set index_lock_type $type
 210                 foreach w $disable_on_lock {
 211                         uplevel #0 $w disabled
 212                 }
 213                 return 1
 214         } elseif {$index_lock_type eq "begin-$type"} {
 215                 set index_lock_type $type
 216                 return 1
 217         }
 218         return 0
 219 }
 220
 221 proc unlock_index {} {
 222         global index_lock_type disable_on_lock
 223
 224         set index_lock_type none
 225         foreach w $disable_on_lock {
 226                 uplevel #0 $w normal
 227         }
 228 }
 229
 230 ######################################################################
 231 ##
 232 ## status
 233
 234 proc repository_state {hdvar ctvar} {
 235         global gitdir
 236         upvar $hdvar hd $ctvar ct
 237
 238         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 239                 set hd {}
 240                 set ct initial
 241         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 242                 set ct merge
 243         } else {
 244                 set ct normal
 245         }
 246 }
 247
 248 proc PARENT {} {
 249         global PARENT empty_tree
 250
 251         if {$PARENT ne {}} {
 252                 return $PARENT
 253         }
 254         if {$empty_tree eq {}} {
 255                 set empty_tree [exec git mktree << {}]
 256         }
 257         return $empty_tree
 258 }
 259
 260 proc rescan {after} {
 261         global HEAD PARENT commit_type
 262         global ui_index ui_other ui_status_value ui_comm
 263         global rescan_active file_states
 264         global repo_config
 265
 266         if {$rescan_active > 0 || ![lock_index read]} return
 267
 268         repository_state new_HEAD new_type
 269         if {[string match amend* $commit_type]
 270                 && $new_type eq {normal}
 271                 && $new_HEAD eq $HEAD} {
 272         } else {
 273                 set HEAD $new_HEAD
 274                 set PARENT $new_HEAD
 275                 set commit_type $new_type
 276         }
 277
 278         array unset file_states
 279
 280         if {![$ui_comm edit modified]
 281                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 282                 if {[load_message GITGUI_MSG]} {
 283                 } elseif {[load_message MERGE_MSG]} {
 284                 } elseif {[load_message SQUASH_MSG]} {
 285                 }
 286                 $ui_comm edit modified false
 287                 $ui_comm edit reset
 288         }
 289
 290         if {$repo_config(gui.trustmtime) eq {true}} {
 291                 rescan_stage2 {} $after
 292         } else {
 293                 set rescan_active 1
 294                 set ui_status_value {Refreshing file status...}
 295                 set cmd [list git update-index]
 296                 lappend cmd -q
 297                 lappend cmd --unmerged
 298                 lappend cmd --ignore-missing
 299                 lappend cmd --refresh
 300                 set fd_rf [open "| $cmd" r]
 301                 fconfigure $fd_rf -blocking 0 -translation binary
 302                 fileevent $fd_rf readable \
 303                         [list rescan_stage2 $fd_rf $after]
 304         }
 305 }
 306
 307 proc rescan_stage2 {fd after} {
 308         global gitdir ui_status_value
 309         global rescan_active buf_rdi buf_rdf buf_rlo
 310
 311         if {$fd ne {}} {
 312                 read $fd
 313                 if {![eof $fd]} return
 314                 close $fd
 315         }
 316
 317         set ls_others [list | git ls-files --others -z \
 318                 --exclude-per-directory=.gitignore]
 319         set info_exclude [file join $gitdir info exclude]
 320         if {[file readable $info_exclude]} {
 321                 lappend ls_others "--exclude-from=$info_exclude"
 322         }
 323
 324         set buf_rdi {}
 325         set buf_rdf {}
 326         set buf_rlo {}
 327
 328         set rescan_active 3
 329         set ui_status_value {Scanning for modified files ...}
 330         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 331         set fd_df [open "| git diff-files -z" r]
 332         set fd_lo [open $ls_others r]
 333
 334         fconfigure $fd_di -blocking 0 -translation binary
 335         fconfigure $fd_df -blocking 0 -translation binary
 336         fconfigure $fd_lo -blocking 0 -translation binary
 337         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 338         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 339         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 340 }
 341
 342 proc load_message {file} {
 343         global gitdir ui_comm
 344
 345         set f [file join $gitdir $file]
 346         if {[file isfile $f]} {
 347                 if {[catch {set fd [open $f r]}]} {
 348                         return 0
 349                 }
 350                 set content [string trim [read $fd]]
 351                 close $fd
 352                 $ui_comm delete 0.0 end
 353                 $ui_comm insert end $content
 354                 return 1
 355         }
 356         return 0
 357 }
 358
 359 proc read_diff_index {fd after} {
 360         global buf_rdi
 361
 362         append buf_rdi [read $fd]
 363         set c 0
 364         set n [string length $buf_rdi]
 365         while {$c < $n} {
 366                 set z1 [string first "\0" $buf_rdi $c]
 367                 if {$z1 == -1} break
 368                 incr z1
 369                 set z2 [string first "\0" $buf_rdi $z1]
 370                 if {$z2 == -1} break
 371
 372                 incr c
 373                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 374                 merge_state \
 375                         [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 376                         [lindex $i 4]? \
 377                         [list [lindex $i 0] [lindex $i 2]] \
 378                         [list]
 379                 set c $z2
 380                 incr c
 381         }
 382         if {$c < $n} {
 383                 set buf_rdi [string range $buf_rdi $c end]
 384         } else {
 385                 set buf_rdi {}
 386         }
 387
 388         rescan_done $fd buf_rdi $after
 389 }
 390
 391 proc read_diff_files {fd after} {
 392         global buf_rdf
 393
 394         append buf_rdf [read $fd]
 395         set c 0
 396         set n [string length $buf_rdf]
 397         while {$c < $n} {
 398                 set z1 [string first "\0" $buf_rdf $c]
 399                 if {$z1 == -1} break
 400                 incr z1
 401                 set z2 [string first "\0" $buf_rdf $z1]
 402                 if {$z2 == -1} break
 403
 404                 incr c
 405                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 406                 merge_state \
 407                         [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 408                         ?[lindex $i 4] \
 409                         [list] \
 410                         [list [lindex $i 0] [lindex $i 2]]
 411                 set c $z2
 412                 incr c
 413         }
 414         if {$c < $n} {
 415                 set buf_rdf [string range $buf_rdf $c end]
 416         } else {
 417                 set buf_rdf {}
 418         }
 419
 420         rescan_done $fd buf_rdf $after
 421 }
 422
 423 proc read_ls_others {fd after} {
 424         global buf_rlo
 425
 426         append buf_rlo [read $fd]
 427         set pck [split $buf_rlo "\0"]
 428         set buf_rlo [lindex $pck end]
 429         foreach p [lrange $pck 0 end-1] {
 430                 merge_state $p ?O
 431         }
 432         rescan_done $fd buf_rlo $after
 433 }
 434
 435 proc rescan_done {fd buf after} {
 436         global rescan_active
 437         global file_states repo_config
 438         upvar $buf to_clear
 439
 440         if {![eof $fd]} return
 441         set to_clear {}
 442         close $fd
 443         if {[incr rescan_active -1] > 0} return
 444
 445         prune_selection
 446         unlock_index
 447         display_all_files
 448
 449         if {$repo_config(gui.partialinclude) ne {true}} {
 450                 set pathList [list]
 451                 foreach path [array names file_states] {
 452                         switch -- [lindex $file_states($path) 0] {
 453                         AM -
 454                         MM {lappend pathList $path}
 455                         }
 456                 }
 457                 if {$pathList ne {}} {
 458                         update_index \
 459                                 "Updating included files" \
 460                                 $pathList \
 461                                 [concat {reshow_diff;} $after]
 462                         return
 463                 }
 464         }
 465
 466         reshow_diff
 467         uplevel #0 $after
 468 }
 469
 470 proc prune_selection {} {
 471         global file_states selected_paths
 472
 473         foreach path [array names selected_paths] {
 474                 if {[catch {set still_here $file_states($path)}]} {
 475                         unset selected_paths($path)
 476                 }
 477         }
 478 }
 479
 480 ######################################################################
 481 ##
 482 ## diff
 483
 484 proc clear_diff {} {
 485         global ui_diff current_diff ui_index ui_other
 486
 487         $ui_diff conf -state normal
 488         $ui_diff delete 0.0 end
 489         $ui_diff conf -state disabled
 490
 491         set current_diff {}
 492
 493         $ui_index tag remove in_diff 0.0 end
 494         $ui_other tag remove in_diff 0.0 end
 495 }
 496
 497 proc reshow_diff {} {
 498         global current_diff ui_status_value file_states
 499
 500         if {$current_diff eq {}
 501                 || [catch {set s $file_states($current_diff)}]} {
 502                 clear_diff
 503         } else {
 504                 show_diff $current_diff
 505         }
 506 }
 507
 508 proc handle_empty_diff {} {
 509         global current_diff file_states file_lists
 510
 511         set path $current_diff
 512         set s $file_states($path)
 513         if {[lindex $s 0] ne {_M}} return
 514
 515         info_popup "No differences detected.
 516
 517 [short_path $path] has no changes.
 518
 519 The modification date of this file was updated
 520 by another application and you currently have
 521 the Trust File Modification Timestamps option
 522 enabled, so Git did not automatically detect
 523 that there are no content differences in this
 524 file.
 525
 526 This file will now be removed from the modified
 527 files list, to prevent possible confusion.
 528 "
 529         if {[catch {exec git update-index -- $path} err]} {
 530                 error_popup "Failed to refresh index:\n\n$err"
 531         }
 532
 533         clear_diff
 534         set old_w [mapcol [lindex $file_states($path) 0] $path]
 535         set lno [lsearch -sorted $file_lists($old_w) $path]
 536         if {$lno >= 0} {
 537                 set file_lists($old_w) \
 538                         [lreplace $file_lists($old_w) $lno $lno]
 539                 incr lno
 540                 $old_w conf -state normal
 541                 $old_w delete $lno.0 [expr {$lno + 1}].0
 542                 $old_w conf -state disabled
 543         }
 544 }
 545
 546 proc show_diff {path {w {}} {lno {}}} {
 547         global file_states file_lists
 548         global is_3way_diff diff_active repo_config
 549         global ui_diff current_diff ui_status_value
 550
 551         if {$diff_active || ![lock_index read]} return
 552
 553         clear_diff
 554         if {$w eq {} || $lno == {}} {
 555                 foreach w [array names file_lists] {
 556                         set lno [lsearch -sorted $file_lists($w) $path]
 557                         if {$lno >= 0} {
 558                                 incr lno
 559                                 break
 560                         }
 561                 }
 562         }
 563         if {$w ne {} && $lno >= 1} {
 564                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 565         }
 566
 567         set s $file_states($path)
 568         set m [lindex $s 0]
 569         set is_3way_diff 0
 570         set diff_active 1
 571         set current_diff $path
 572         set ui_status_value "Loading diff of [escape_path $path]..."
 573
 574         set cmd [list | git diff-index]
 575         lappend cmd --no-color
 576         if {$repo_config(gui.diffcontext) > 0} {
 577                 lappend cmd "-U$repo_config(gui.diffcontext)"
 578         }
 579         lappend cmd -p
 580
 581         switch $m {
 582         MM {
 583                 lappend cmd -c
 584         }
 585         _O {
 586                 if {[catch {
 587                                 set fd [open $path r]
 588                                 set content [read $fd]
 589                                 close $fd
 590                         } err ]} {
 591                         set diff_active 0
 592                         unlock_index
 593                         set ui_status_value "Unable to display [escape_path $path]"
 594                         error_popup "Error loading file:\n\n$err"
 595                         return
 596                 }
 597                 $ui_diff conf -state normal
 598                 $ui_diff insert end $content
 599                 $ui_diff conf -state disabled
 600                 set diff_active 0
 601                 unlock_index
 602                 set ui_status_value {Ready.}
 603                 return
 604         }
 605         }
 606
 607         lappend cmd [PARENT]
 608         lappend cmd --
 609         lappend cmd $path
 610
 611         if {[catch {set fd [open $cmd r]} err]} {
 612                 set diff_active 0
 613                 unlock_index
 614                 set ui_status_value "Unable to display [escape_path $path]"
 615                 error_popup "Error loading diff:\n\n$err"
 616                 return
 617         }
 618
 619         fconfigure $fd -blocking 0 -translation auto
 620         fileevent $fd readable [list read_diff $fd]
 621 }
 622
 623 proc read_diff {fd} {
 624         global ui_diff ui_status_value is_3way_diff diff_active
 625         global repo_config
 626
 627         $ui_diff conf -state normal
 628         while {[gets $fd line] >= 0} {
 629                 # -- Cleanup uninteresting diff header lines.
 630                 #
 631                 if {[string match {diff --git *}      $line]} continue
 632                 if {[string match {diff --combined *} $line]} continue
 633                 if {[string match {--- *}             $line]} continue
 634                 if {[string match {+++ *}             $line]} continue
 635                 if {$line eq {deleted file mode 120000}} {
 636                         set line "deleted symlink"
 637                 }
 638
 639                 # -- Automatically detect if this is a 3 way diff.
 640                 #
 641                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 642
 643                 # -- Reformat a 3 way diff, 'cause its too weird.
 644                 #
 645                 if {$is_3way_diff} {
 646                         set op [string range $line 0 1]
 647                         switch -- $op {
 648                         {@@} {set tags d_@}
 649                         {++} {set tags d_+ ; set op { +}}
 650                         {--} {set tags d_- ; set op { -}}
 651                         { +} {set tags d_++; set op {++}}
 652                         { -} {set tags d_--; set op {--}}
 653                         {+ } {set tags d_-+; set op {-+}}
 654                         {- } {set tags d_+-; set op {+-}}
 655                         default {set tags {}}
 656                         }
 657                         set line [string replace $line 0 1 $op]
 658                 } else {
 659                         switch -- [string index $line 0] {
 660                         @ {set tags d_@}
 661                         + {set tags d_+}
 662                         - {set tags d_-}
 663                         default {set tags {}}
 664                         }
 665                 }
 666                 $ui_diff insert end $line $tags
 667                 $ui_diff insert end "\n" $tags
 668         }
 669         $ui_diff conf -state disabled
 670
 671         if {[eof $fd]} {
 672                 close $fd
 673                 set diff_active 0
 674                 unlock_index
 675                 set ui_status_value {Ready.}
 676
 677                 if {$repo_config(gui.trustmtime) eq {true}
 678                         && [$ui_diff index end] eq {2.0}} {
 679                         handle_empty_diff
 680                 }
 681         }
 682 }
 683
 684 ######################################################################
 685 ##
 686 ## commit
 687
 688 proc load_last_commit {} {
 689         global HEAD PARENT commit_type ui_comm
 690
 691         if {[string match amend* $commit_type]} return
 692         if {$commit_type ne {normal}} {
 693                 error_popup "Can't amend a $commit_type commit."
 694                 return
 695         }
 696
 697         set msg {}
 698         set parent {}
 699         set parent_count 0
 700         if {[catch {
 701                         set fd [open "| git cat-file commit $HEAD" r]
 702                         while {[gets $fd line] > 0} {
 703                                 if {[string match {parent *} $line]} {
 704                                         set parent [string range $line 7 end]
 705                                         incr parent_count
 706                                 }
 707                         }
 708                         set msg [string trim [read $fd]]
 709                         close $fd
 710                 } err]} {
 711                 error_popup "Error loading commit data for amend:\n\n$err"
 712                 return
 713         }
 714
 715         if {$parent_count > 1} {
 716                 error_popup {Can't amend a merge commit.}
 717                 return
 718         }
 719
 720         if {$parent_count == 0} {
 721                 set commit_type amend-initial
 722                 set PARENT {}
 723         } elseif {$parent_count == 1} {
 724                 set commit_type amend
 725                 set PARENT $parent
 726         }
 727
 728         $ui_comm delete 0.0 end
 729         $ui_comm insert end $msg
 730         $ui_comm edit modified false
 731         $ui_comm edit reset
 732         rescan {set ui_status_value {Ready.}}
 733 }
 734
 735 proc create_new_commit {} {
 736         global commit_type ui_comm
 737
 738         set commit_type normal
 739         $ui_comm delete 0.0 end
 740         $ui_comm edit modified false
 741         $ui_comm edit reset
 742         rescan {set ui_status_value {Ready.}}
 743 }
 744
 745 set GIT_COMMITTER_IDENT {}
 746
 747 proc committer_ident {} {
 748         global GIT_COMMITTER_IDENT
 749
 750         if {$GIT_COMMITTER_IDENT eq {}} {
 751                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 752                         error_popup "Unable to obtain your identity:\n\n$err"
 753                         return {}
 754                 }
 755                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 756                         $me me GIT_COMMITTER_IDENT]} {
 757                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 758                         return {}
 759                 }
 760         }
 761
 762         return $GIT_COMMITTER_IDENT
 763 }
 764
 765 proc commit_tree {} {
 766         global HEAD commit_type file_states ui_comm repo_config
 767
 768         if {![lock_index update]} return
 769         if {[committer_ident] eq {}} return
 770
 771         # -- Our in memory state should match the repository.
 772         #
 773         repository_state curHEAD cur_type
 774         if {[string match amend* $commit_type]
 775                 && $cur_type eq {normal}
 776                 && $curHEAD eq $HEAD} {
 777         } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 778                 info_popup {Last scanned state does not match repository state.
 779
 780 Another Git program has modified this repository
 781 since the last scan.  A rescan must be performed
 782 before another commit can be created.
 783
 784 The rescan will be automatically started now.
 785 }
 786                 unlock_index
 787                 rescan {set ui_status_value {Ready.}}
 788                 return
 789         }
 790
 791         # -- At least one file should differ in the index.
 792         #
 793         set files_ready 0
 794         foreach path [array names file_states] {
 795                 switch -glob -- [lindex $file_states($path) 0] {
 796                 _? {continue}
 797                 A? -
 798                 D? -
 799                 M? {set files_ready 1; break}
 800                 U? {
 801                         error_popup "Unmerged files cannot be committed.
 802
 803 File [short_path $path] has merge conflicts.
 804 You must resolve them and include the file before committing.
 805 "
 806                         unlock_index
 807                         return
 808                 }
 809                 default {
 810                         error_popup "Unknown file state [lindex $s 0] detected.
 811
 812 File [short_path $path] cannot be committed by this program.
 813 "
 814                 }
 815                 }
 816         }
 817         if {!$files_ready} {
 818                 error_popup {No included files to commit.
 819
 820 You must include at least 1 file before you can commit.
 821 }
 822                 unlock_index
 823                 return
 824         }
 825
 826         # -- A message is required.
 827         #
 828         set msg [string trim [$ui_comm get 1.0 end]]
 829         if {$msg eq {}} {
 830                 error_popup {Please supply a commit message.
 831
 832 A good commit message has the following format:
 833
 834 - First line: Describe in one sentance what you did.
 835 - Second line: Blank
 836 - Remaining lines: Describe why this change is good.
 837 }
 838                 unlock_index
 839                 return
 840         }
 841
 842         # -- Update included files if partialincludes are off.
 843         #
 844         if {$repo_config(gui.partialinclude) ne {true}} {
 845                 set pathList [list]
 846                 foreach path [array names file_states] {
 847                         switch -glob -- [lindex $file_states($path) 0] {
 848                         A? -
 849                         M? {lappend pathList $path}
 850                         }
 851                 }
 852                 if {$pathList ne {}} {
 853                         unlock_index
 854                         update_index \
 855                                 "Updating included files" \
 856                                 $pathList \
 857                                 [concat {lock_index update;} \
 858                                         [list commit_prehook $curHEAD $msg]]
 859                         return
 860                 }
 861         }
 862
 863         commit_prehook $curHEAD $msg
 864 }
 865
 866 proc commit_prehook {curHEAD msg} {
 867         global tcl_platform gitdir ui_status_value pch_error
 868
 869         # On Cygwin [file executable] might lie so we need to ask
 870         # the shell if the hook is executable.  Yes that's annoying.
 871
 872         set pchook [file join $gitdir hooks pre-commit]
 873         if {$tcl_platform(platform) eq {windows}
 874                 && [file isfile $pchook]} {
 875                 set pchook [list sh -c [concat \
 876                         "if test -x \"$pchook\";" \
 877                         "then exec \"$pchook\" 2>&1;" \
 878                         "fi"]]
 879         } elseif {[file executable $pchook]} {
 880                 set pchook [list $pchook |& cat]
 881         } else {
 882                 commit_writetree $curHEAD $msg
 883                 return
 884         }
 885
 886         set ui_status_value {Calling pre-commit hook...}
 887         set pch_error {}
 888         set fd_ph [open "| $pchook" r]
 889         fconfigure $fd_ph -blocking 0 -translation binary
 890         fileevent $fd_ph readable \
 891                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 892 }
 893
 894 proc commit_prehook_wait {fd_ph curHEAD msg} {
 895         global pch_error ui_status_value
 896
 897         append pch_error [read $fd_ph]
 898         fconfigure $fd_ph -blocking 1
 899         if {[eof $fd_ph]} {
 900                 if {[catch {close $fd_ph}]} {
 901                         set ui_status_value {Commit declined by pre-commit hook.}
 902                         hook_failed_popup pre-commit $pch_error
 903                         unlock_index
 904                 } else {
 905                         commit_writetree $curHEAD $msg
 906                 }
 907                 set pch_error {}
 908                 return
 909         }
 910         fconfigure $fd_ph -blocking 0
 911 }
 912
 913 proc commit_writetree {curHEAD msg} {
 914         global ui_status_value
 915
 916         set ui_status_value {Committing changes...}
 917         set fd_wt [open "| git write-tree" r]
 918         fileevent $fd_wt readable \
 919                 [list commit_committree $fd_wt $curHEAD $msg]
 920 }
 921
 922 proc commit_committree {fd_wt curHEAD msg} {
 923         global single_commit gitdir HEAD PARENT commit_type tcl_platform
 924         global ui_status_value ui_comm selected_commit_type
 925         global file_states selected_paths
 926
 927         gets $fd_wt tree_id
 928         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 929                 error_popup "write-tree failed:\n\n$err"
 930                 set ui_status_value {Commit failed.}
 931                 unlock_index
 932                 return
 933         }
 934
 935         # -- Create the commit.
 936         #
 937         set cmd [list git commit-tree $tree_id]
 938         if {$PARENT ne {}} {
 939                 lappend cmd -p $PARENT
 940         }
 941         if {$commit_type eq {merge}} {
 942                 if {[catch {
 943                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 944                                 while {[gets $fd_mh merge_head] >= 0} {
 945                                         lappend cmd -p $merge_head
 946                                 }
 947                                 close $fd_mh
 948                         } err]} {
 949                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 950                         set ui_status_value {Commit failed.}
 951                         unlock_index
 952                         return
 953                 }
 954         }
 955         if {$PARENT eq {}} {
 956                 # git commit-tree writes to stderr during initial commit.
 957                 lappend cmd 2>/dev/null
 958         }
 959         lappend cmd << $msg
 960         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 961                 error_popup "commit-tree failed:\n\n$err"
 962                 set ui_status_value {Commit failed.}
 963                 unlock_index
 964                 return
 965         }
 966
 967         # -- Update the HEAD ref.
 968         #
 969         set reflogm commit
 970         if {$commit_type ne {normal}} {
 971                 append reflogm " ($commit_type)"
 972         }
 973         set i [string first "\n" $msg]
 974         if {$i >= 0} {
 975                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 976         } else {
 977                 append reflogm {: } $msg
 978         }
 979         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 980         if {[catch {eval exec $cmd} err]} {
 981                 error_popup "update-ref failed:\n\n$err"
 982                 set ui_status_value {Commit failed.}
 983                 unlock_index
 984                 return
 985         }
 986
 987         # -- Cleanup after ourselves.
 988         #
 989         catch {file delete [file join $gitdir MERGE_HEAD]}
 990         catch {file delete [file join $gitdir MERGE_MSG]}
 991         catch {file delete [file join $gitdir SQUASH_MSG]}
 992         catch {file delete [file join $gitdir GITGUI_MSG]}
 993
 994         # -- Let rerere do its thing.
 995         #
 996         if {[file isdirectory [file join $gitdir rr-cache]]} {
 997                 catch {exec git rerere}
 998         }
 999
1000         # -- Run the post-commit hook.
1001         #
1002         set pchook [file join $gitdir hooks post-commit]
1003         if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
1004                 set pchook [list sh -c [concat \
1005                         "if test -x \"$pchook\";" \
1006                         "then exec \"$pchook\";" \
1007                         "fi"]]
1008         } elseif {![file executable $pchook]} {
1009                 set pchook {}
1010         }
1011         if {$pchook ne {}} {
1012                 catch {exec $pchook &}
1013         }
1014
1015         $ui_comm delete 0.0 end
1016         $ui_comm edit modified false
1017         $ui_comm edit reset
1018
1019         if {$single_commit} do_quit
1020
1021         # -- Update status without invoking any git commands.
1022         #
1023         set commit_type normal
1024         set selected_commit_type new
1025         set HEAD $cmt_id
1026         set PARENT $cmt_id
1027
1028         foreach path [array names file_states] {
1029                 set s $file_states($path)
1030                 set m [lindex $s 0]
1031                 switch -glob -- $m {
1032                 DD -
1033                 AO {set m __}
1034                 A? -
1035                 M? -
1036                 D? {set m _[string index $m 1]}
1037                 }
1038
1039                 if {$m eq {__}} {
1040                         unset file_states($path)
1041                         catch {unset selected_paths($path)}
1042                 } else {
1043                         lset file_states($path) 0 $m
1044                 }
1045         }
1046
1047         display_all_files
1048         unlock_index
1049         reshow_diff
1050         set ui_status_value \
1051                 "Changes committed as [string range $cmt_id 0 7]."
1052 }
1053
1054 ######################################################################
1055 ##
1056 ## fetch pull push
1057
1058 proc fetch_from {remote} {
1059         set w [new_console "fetch $remote" \
1060                 "Fetching new changes from $remote"]
1061         set cmd [list git fetch]
1062         lappend cmd $remote
1063         console_exec $w $cmd
1064 }
1065
1066 proc pull_remote {remote branch} {
1067         global HEAD commit_type file_states repo_config
1068
1069         if {![lock_index update]} return
1070
1071         # -- Our in memory state should match the repository.
1072         #
1073         repository_state curHEAD cur_type
1074         if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1075                 error_popup {Last scanned state does not match repository state.
1076
1077 Its highly likely that another Git program modified the
1078 repository since our last scan.  A rescan is required
1079 before a pull can be started.
1080 }
1081                 unlock_index
1082                 rescan {set ui_status_value {Ready.}}
1083                 return
1084         }
1085
1086         # -- No differences should exist before a pull.
1087         #
1088         if {[array size file_states] != 0} {
1089                 error_popup {Uncommitted but modified files are present.
1090
1091 You should not perform a pull with unmodified files in your working
1092 directory as Git would be unable to recover from an incorrect merge.
1093
1094 Commit or throw away all changes before starting a pull operation.
1095 }
1096                 unlock_index
1097                 return
1098         }
1099
1100         set w [new_console "pull $remote $branch" \
1101                 "Pulling new changes from branch $branch in $remote"]
1102         set cmd [list git pull]
1103         if {$repo_config(gui.pullsummary) eq {false}} {
1104                 lappend cmd --no-summary
1105         }
1106         lappend cmd $remote
1107         lappend cmd $branch
1108         console_exec $w $cmd [list post_pull_remote $remote $branch]
1109 }
1110
1111 proc post_pull_remote {remote branch success} {
1112         global HEAD PARENT commit_type selected_commit_type
1113         global ui_status_value
1114
1115         unlock_index
1116         if {$success} {
1117                 repository_state HEAD commit_type
1118                 set PARENT $HEAD
1119                 set selected_commit_type new
1120                 set $ui_status_value "Pulling $branch from $remote complete."
1121         } else {
1122                 set m "Conflicts detected while pulling $branch from $remote."
1123                 rescan "set ui_status_value {$m}"
1124         }
1125 }
1126
1127 proc push_to {remote} {
1128         set w [new_console "push $remote" \
1129                 "Pushing changes to $remote"]
1130         set cmd [list git push]
1131         lappend cmd $remote
1132         console_exec $w $cmd
1133 }
1134
1135 ######################################################################
1136 ##
1137 ## ui helpers
1138
1139 proc mapcol {state path} {
1140         global all_cols ui_other
1141
1142         if {[catch {set r $all_cols($state)}]} {
1143                 puts "error: no column for state={$state} $path"
1144                 return $ui_other
1145         }
1146         return $r
1147 }
1148
1149 proc mapicon {state path} {
1150         global all_icons
1151
1152         if {[catch {set r $all_icons($state)}]} {
1153                 puts "error: no icon for state={$state} $path"
1154                 return file_plain
1155         }
1156         return $r
1157 }
1158
1159 proc mapdesc {state path} {
1160         global all_descs
1161
1162         if {[catch {set r $all_descs($state)}]} {
1163                 puts "error: no desc for state={$state} $path"
1164                 return $state
1165         }
1166         return $r
1167 }
1168
1169 proc escape_path {path} {
1170         regsub -all "\n" $path "\\n" path
1171         return $path
1172 }
1173
1174 proc short_path {path} {
1175         return [escape_path [lindex [file split $path] end]]
1176 }
1177
1178 set next_icon_id 0
1179 set null_sha1 [string repeat 0 40]
1180
1181 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1182         global file_states next_icon_id null_sha1
1183
1184         set s0 [string index $new_state 0]
1185         set s1 [string index $new_state 1]
1186
1187         if {[catch {set info $file_states($path)}]} {
1188                 set state __
1189                 set icon n[incr next_icon_id]
1190         } else {
1191                 set state [lindex $info 0]
1192                 set icon [lindex $info 1]
1193                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1194                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1195         }
1196
1197         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1198         elseif {$s0 eq {_}} {set s0 _}
1199
1200         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1201         elseif {$s1 eq {_}} {set s1 _}
1202
1203         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1204                 set head_info [list 0 $null_sha1]
1205         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1206                 && $head_info eq {}} {
1207                 set head_info $index_info
1208         }
1209
1210         set file_states($path) [list $s0$s1 $icon \
1211                 $head_info $index_info \
1212                 ]
1213         return $state
1214 }
1215
1216 proc display_file {path state} {
1217         global file_states file_lists selected_paths
1218
1219         set old_m [merge_state $path $state]
1220         set s $file_states($path)
1221         set new_m [lindex $s 0]
1222         set new_w [mapcol $new_m $path]
1223         set old_w [mapcol $old_m $path]
1224         set new_icon [mapicon $new_m $path]
1225
1226         if {$new_w ne $old_w} {
1227                 set lno [lsearch -sorted $file_lists($old_w) $path]
1228                 if {$lno >= 0} {
1229                         incr lno
1230                         $old_w conf -state normal
1231                         $old_w delete $lno.0 [expr {$lno + 1}].0
1232                         $old_w conf -state disabled
1233                 }
1234
1235                 lappend file_lists($new_w) $path
1236                 set file_lists($new_w) [lsort $file_lists($new_w)]
1237                 set lno [lsearch -sorted $file_lists($new_w) $path]
1238                 incr lno
1239                 $new_w conf -state normal
1240                 $new_w image create $lno.0 \
1241                         -align center -padx 5 -pady 1 \
1242                         -name [lindex $s 1] \
1243                         -image $new_icon
1244                 $new_w insert $lno.1 "[escape_path $path]\n"
1245                 if {[catch {set in_sel $selected_paths($path)}]} {
1246                         set in_sel 0
1247                 }
1248                 if {$in_sel} {
1249                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1250                 }
1251                 $new_w conf -state disabled
1252         } elseif {$new_icon ne [mapicon $old_m $path]} {
1253                 $new_w conf -state normal
1254                 $new_w image conf [lindex $s 1] -image $new_icon
1255                 $new_w conf -state disabled
1256         }
1257 }
1258
1259 proc display_all_files {} {
1260         global ui_index ui_other
1261         global file_states file_lists
1262         global last_clicked selected_paths
1263
1264         $ui_index conf -state normal
1265         $ui_other conf -state normal
1266
1267         $ui_index delete 0.0 end
1268         $ui_other delete 0.0 end
1269         set last_clicked {}
1270
1271         set file_lists($ui_index) [list]
1272         set file_lists($ui_other) [list]
1273
1274         foreach path [lsort [array names file_states]] {
1275                 set s $file_states($path)
1276                 set m [lindex $s 0]
1277                 set w [mapcol $m $path]
1278                 lappend file_lists($w) $path
1279                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1280                 $w image create end \
1281                         -align center -padx 5 -pady 1 \
1282                         -name [lindex $s 1] \
1283                         -image [mapicon $m $path]
1284                 $w insert end "[escape_path $path]\n"
1285                 if {[catch {set in_sel $selected_paths($path)}]} {
1286                         set in_sel 0
1287                 }
1288                 if {$in_sel} {
1289                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1290                 }
1291         }
1292
1293         $ui_index conf -state disabled
1294         $ui_other conf -state disabled
1295 }
1296
1297 proc update_indexinfo {msg pathList after} {
1298         global update_index_cp ui_status_value
1299
1300         if {![lock_index update]} return
1301
1302         set update_index_cp 0
1303         set pathList [lsort $pathList]
1304         set totalCnt [llength $pathList]
1305         set batch [expr {int($totalCnt * .01) + 1}]
1306         if {$batch > 25} {set batch 25}
1307
1308         set ui_status_value [format \
1309                 "$msg... %i/%i files (%.2f%%)" \
1310                 $update_index_cp \
1311                 $totalCnt \
1312                 0.0]
1313         set fd [open "| git update-index -z --index-info" w]
1314         fconfigure $fd \
1315                 -blocking 0 \
1316                 -buffering full \
1317                 -buffersize 512 \
1318                 -translation binary
1319         fileevent $fd writable [list \
1320                 write_update_indexinfo \
1321                 $fd \
1322                 $pathList \
1323                 $totalCnt \
1324                 $batch \
1325                 $msg \
1326                 $after \
1327                 ]
1328 }
1329
1330 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1331         global update_index_cp ui_status_value
1332         global file_states current_diff
1333
1334         if {$update_index_cp >= $totalCnt} {
1335                 close $fd
1336                 unlock_index
1337                 uplevel #0 $after
1338                 return
1339         }
1340
1341         for {set i $batch} \
1342                 {$update_index_cp < $totalCnt && $i > 0} \
1343                 {incr i -1} {
1344                 set path [lindex $pathList $update_index_cp]
1345                 incr update_index_cp
1346
1347                 set s $file_states($path)
1348                 switch -glob -- [lindex $s 0] {
1349                 A? {set new _O}
1350                 M? {set new _M}
1351                 D? {set new _?}
1352                 ?? {continue}
1353                 }
1354                 set info [lindex $s 2]
1355                 if {$info eq {}} continue
1356
1357                 puts -nonewline $fd $info
1358                 puts -nonewline $fd "\t"
1359                 puts -nonewline $fd $path
1360                 puts -nonewline $fd "\0"
1361                 display_file $path $new
1362         }
1363
1364         set ui_status_value [format \
1365                 "$msg... %i/%i files (%.2f%%)" \
1366                 $update_index_cp \
1367                 $totalCnt \
1368                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1369 }
1370
1371 proc update_index {msg pathList after} {
1372         global update_index_cp ui_status_value
1373
1374         if {![lock_index update]} return
1375
1376         set update_index_cp 0
1377         set pathList [lsort $pathList]
1378         set totalCnt [llength $pathList]
1379         set batch [expr {int($totalCnt * .01) + 1}]
1380         if {$batch > 25} {set batch 25}
1381
1382         set ui_status_value [format \
1383                 "$msg... %i/%i files (%.2f%%)" \
1384                 $update_index_cp \
1385                 $totalCnt \
1386                 0.0]
1387         set fd [open "| git update-index --add --remove -z --stdin" w]
1388         fconfigure $fd \
1389                 -blocking 0 \
1390                 -buffering full \
1391                 -buffersize 512 \
1392                 -translation binary
1393         fileevent $fd writable [list \
1394                 write_update_index \
1395                 $fd \
1396                 $pathList \
1397                 $totalCnt \
1398                 $batch \
1399                 $msg \
1400                 $after \
1401                 ]
1402 }
1403
1404 proc write_update_index {fd pathList totalCnt batch msg after} {
1405         global update_index_cp ui_status_value
1406         global file_states current_diff
1407
1408         if {$update_index_cp >= $totalCnt} {
1409                 close $fd
1410                 unlock_index
1411                 uplevel #0 $after
1412                 return
1413         }
1414
1415         for {set i $batch} \
1416                 {$update_index_cp < $totalCnt && $i > 0} \
1417                 {incr i -1} {
1418                 set path [lindex $pathList $update_index_cp]
1419                 incr update_index_cp
1420
1421                 switch -glob -- [lindex $file_states($path) 0] {
1422                 AD -
1423                 MD -
1424                 _D {set new DD}
1425
1426                 _M -
1427                 MM -
1428                 M_ {set new M_}
1429
1430                 _O -
1431                 AM -
1432                 A_ {set new A_}
1433
1434                 ?? {continue}
1435                 }
1436
1437                 puts -nonewline $fd $path
1438                 puts -nonewline $fd "\0"
1439                 display_file $path $new
1440         }
1441
1442         set ui_status_value [format \
1443                 "$msg... %i/%i files (%.2f%%)" \
1444                 $update_index_cp \
1445                 $totalCnt \
1446                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1447 }
1448
1449 ######################################################################
1450 ##
1451 ## remote management
1452
1453 proc load_all_remotes {} {
1454         global gitdir all_remotes repo_config
1455
1456         set all_remotes [list]
1457         set rm_dir [file join $gitdir remotes]
1458         if {[file isdirectory $rm_dir]} {
1459                 set all_remotes [concat $all_remotes [glob \
1460                         -types f \
1461                         -tails \
1462                         -nocomplain \
1463                         -directory $rm_dir *]]
1464         }
1465
1466         foreach line [array names repo_config remote.*.url] {
1467                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1468                         lappend all_remotes $name
1469                 }
1470         }
1471
1472         set all_remotes [lsort -unique $all_remotes]
1473 }
1474
1475 proc populate_fetch_menu {m} {
1476         global gitdir all_remotes repo_config
1477
1478         foreach r $all_remotes {
1479                 set enable 0
1480                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1481                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1482                                 set enable 1
1483                         }
1484                 } else {
1485                         catch {
1486                                 set fd [open [file join $gitdir remotes $r] r]
1487                                 while {[gets $fd n] >= 0} {
1488                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1489                                                 set enable 1
1490                                                 break
1491                                         }
1492                                 }
1493                                 close $fd
1494                         }
1495                 }
1496
1497                 if {$enable} {
1498                         $m add command \
1499                                 -label "Fetch from $r..." \
1500                                 -command [list fetch_from $r] \
1501                                 -font font_ui
1502                 }
1503         }
1504 }
1505
1506 proc populate_push_menu {m} {
1507         global gitdir all_remotes repo_config
1508
1509         foreach r $all_remotes {
1510                 set enable 0
1511                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1512                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1513                                 set enable 1
1514                         }
1515                 } else {
1516                         catch {
1517                                 set fd [open [file join $gitdir remotes $r] r]
1518                                 while {[gets $fd n] >= 0} {
1519                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1520                                                 set enable 1
1521                                                 break
1522                                         }
1523                                 }
1524                                 close $fd
1525                         }
1526                 }
1527
1528                 if {$enable} {
1529                         $m add command \
1530                                 -label "Push to $r..." \
1531                                 -command [list push_to $r] \
1532                                 -font font_ui
1533                 }
1534         }
1535 }
1536
1537 proc populate_pull_menu {m} {
1538         global gitdir repo_config all_remotes disable_on_lock
1539
1540         foreach remote $all_remotes {
1541                 set rb {}
1542                 if {[array get repo_config remote.$remote.url] ne {}} {
1543                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1544                                 regexp {^([^:]+):} \
1545                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1546                                         line rb
1547                         }
1548                 } else {
1549                         catch {
1550                                 set fd [open [file join $gitdir remotes $remote] r]
1551                                 while {[gets $fd line] >= 0} {
1552                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1553                                                 break
1554                                         }
1555                                 }
1556                                 close $fd
1557                         }
1558                 }
1559
1560                 set rb_short $rb
1561                 regsub ^refs/heads/ $rb {} rb_short
1562                 if {$rb_short ne {}} {
1563                         $m add command \
1564                                 -label "Branch $rb_short from $remote..." \
1565                                 -command [list pull_remote $remote $rb] \
1566                                 -font font_ui
1567                         lappend disable_on_lock \
1568                                 [list $m entryconf [$m index last] -state]
1569                 }
1570         }
1571 }
1572
1573 ######################################################################
1574 ##
1575 ## icons
1576
1577 set filemask {
1578 #define mask_width 14
1579 #define mask_height 15
1580 static unsigned char mask_bits[] = {
1581    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1582    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1583    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1584 }
1585
1586 image create bitmap file_plain -background white -foreground black -data {
1587 #define plain_width 14
1588 #define plain_height 15
1589 static unsigned char plain_bits[] = {
1590    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1591    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1592    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1593 } -maskdata $filemask
1594
1595 image create bitmap file_mod -background white -foreground blue -data {
1596 #define mod_width 14
1597 #define mod_height 15
1598 static unsigned char mod_bits[] = {
1599    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1600    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1601    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1602 } -maskdata $filemask
1603
1604 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1605 #define file_fulltick_width 14
1606 #define file_fulltick_height 15
1607 static unsigned char file_fulltick_bits[] = {
1608    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1609    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1610    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1611 } -maskdata $filemask
1612
1613 image create bitmap file_parttick -background white -foreground "#005050" -data {
1614 #define parttick_width 14
1615 #define parttick_height 15
1616 static unsigned char parttick_bits[] = {
1617    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1618    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1619    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1620 } -maskdata $filemask
1621
1622 image create bitmap file_question -background white -foreground black -data {
1623 #define file_question_width 14
1624 #define file_question_height 15
1625 static unsigned char file_question_bits[] = {
1626    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1627    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1628    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1629 } -maskdata $filemask
1630
1631 image create bitmap file_removed -background white -foreground red -data {
1632 #define file_removed_width 14
1633 #define file_removed_height 15
1634 static unsigned char file_removed_bits[] = {
1635    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1636    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1637    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1638 } -maskdata $filemask
1639
1640 image create bitmap file_merge -background white -foreground blue -data {
1641 #define file_merge_width 14
1642 #define file_merge_height 15
1643 static unsigned char file_merge_bits[] = {
1644    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1645    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1646    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1647 } -maskdata $filemask
1648
1649 set ui_index .vpane.files.index.list
1650 set ui_other .vpane.files.other.list
1651 set max_status_desc 0
1652 foreach i {
1653                 {__ i plain    "Unmodified"}
1654                 {_M i mod      "Modified"}
1655                 {M_ i fulltick "Included in commit"}
1656                 {MM i parttick "Partially included"}
1657
1658                 {_O o plain    "Untracked"}
1659                 {A_ o fulltick "Added by commit"}
1660                 {AM o parttick "Partially added"}
1661                 {AD o question "Added (but now gone)"}
1662
1663                 {_D i question "Missing"}
1664                 {D_ i removed  "Removed by commit"}
1665                 {DD i removed  "Removed by commit"}
1666                 {DO i removed  "Removed (still exists)"}
1667
1668                 {UM i merge    "Merge conflicts"}
1669                 {U_ i merge    "Merge conflicts"}
1670         } {
1671         if {$max_status_desc < [string length [lindex $i 3]]} {
1672                 set max_status_desc [string length [lindex $i 3]]
1673         }
1674         if {[lindex $i 1] eq {i}} {
1675                 set all_cols([lindex $i 0]) $ui_index
1676         } else {
1677                 set all_cols([lindex $i 0]) $ui_other
1678         }
1679         set all_icons([lindex $i 0]) file_[lindex $i 2]
1680         set all_descs([lindex $i 0]) [lindex $i 3]
1681 }
1682 unset filemask i
1683
1684 ######################################################################
1685 ##
1686 ## util
1687
1688 proc is_MacOSX {} {
1689         global tcl_platform tk_library
1690         if {$tcl_platform(platform) eq {unix}
1691                 && $tcl_platform(os) eq {Darwin}
1692                 && [string match /Library/Frameworks/* $tk_library]} {
1693                 return 1
1694         }
1695         return 0
1696 }
1697
1698 proc bind_button3 {w cmd} {
1699         bind $w <Any-Button-3> $cmd
1700         if {[is_MacOSX]} {
1701                 bind $w <Control-Button-1> $cmd
1702         }
1703 }
1704
1705 proc incr_font_size {font {amt 1}} {
1706         set sz [font configure $font -size]
1707         incr sz $amt
1708         font configure $font -size $sz
1709         font configure ${font}bold -size $sz
1710 }
1711
1712 proc hook_failed_popup {hook msg} {
1713         global gitdir appname
1714
1715         set w .hookfail
1716         toplevel $w
1717
1718         frame $w.m
1719         label $w.m.l1 -text "$hook hook failed:" \
1720                 -anchor w \
1721                 -justify left \
1722                 -font font_uibold
1723         text $w.m.t \
1724                 -background white -borderwidth 1 \
1725                 -relief sunken \
1726                 -width 80 -height 10 \
1727                 -font font_diff \
1728                 -yscrollcommand [list $w.m.sby set]
1729         label $w.m.l2 \
1730                 -text {You must correct the above errors before committing.} \
1731                 -anchor w \
1732                 -justify left \
1733                 -font font_uibold
1734         scrollbar $w.m.sby -command [list $w.m.t yview]
1735         pack $w.m.l1 -side top -fill x
1736         pack $w.m.l2 -side bottom -fill x
1737         pack $w.m.sby -side right -fill y
1738         pack $w.m.t -side left -fill both -expand 1
1739         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1740
1741         $w.m.t insert 1.0 $msg
1742         $w.m.t conf -state disabled
1743
1744         button $w.ok -text OK \
1745                 -width 15 \
1746                 -font font_ui \
1747                 -command "destroy $w"
1748         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1749
1750         bind $w <Visibility> "grab $w; focus $w"
1751         bind $w <Key-Return> "destroy $w"
1752         wm title $w "$appname ([lindex [file split \
1753                 [file normalize [file dirname $gitdir]]] \
1754                 end]): error"
1755         tkwait window $w
1756 }
1757
1758 set next_console_id 0
1759
1760 proc new_console {short_title long_title} {
1761         global next_console_id console_data
1762         set w .console[incr next_console_id]
1763         set console_data($w) [list $short_title $long_title]
1764         return [console_init $w]
1765 }
1766
1767 proc console_init {w} {
1768         global console_cr console_data
1769         global gitdir appname M1B
1770
1771         set console_cr($w) 1.0
1772         toplevel $w
1773         frame $w.m
1774         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1775                 -anchor w \
1776                 -justify left \
1777                 -font font_uibold
1778         text $w.m.t \
1779                 -background white -borderwidth 1 \
1780                 -relief sunken \
1781                 -width 80 -height 10 \
1782                 -font font_diff \
1783                 -state disabled \
1784                 -yscrollcommand [list $w.m.sby set]
1785         label $w.m.s -text {Working... please wait...} \
1786                 -anchor w \
1787                 -justify left \
1788                 -font font_uibold
1789         scrollbar $w.m.sby -command [list $w.m.t yview]
1790         pack $w.m.l1 -side top -fill x
1791         pack $w.m.s -side bottom -fill x
1792         pack $w.m.sby -side right -fill y
1793         pack $w.m.t -side left -fill both -expand 1
1794         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1795
1796         menu $w.ctxm -tearoff 0
1797         $w.ctxm add command -label "Copy" \
1798                 -font font_ui \
1799                 -command "tk_textCopy $w.m.t"
1800         $w.ctxm add command -label "Select All" \
1801                 -font font_ui \
1802                 -command "$w.m.t tag add sel 0.0 end"
1803         $w.ctxm add command -label "Copy All" \
1804                 -font font_ui \
1805                 -command "
1806                         $w.m.t tag add sel 0.0 end
1807                         tk_textCopy $w.m.t
1808                         $w.m.t tag remove sel 0.0 end
1809                 "
1810
1811         button $w.ok -text {Close} \
1812                 -font font_ui \
1813                 -state disabled \
1814                 -command "destroy $w"
1815         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1816
1817         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1818         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1819         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1820         bind $w <Visibility> "focus $w"
1821         wm title $w "$appname ([lindex [file split \
1822                 [file normalize [file dirname $gitdir]]] \
1823                 end]): [lindex $console_data($w) 0]"
1824         return $w
1825 }
1826
1827 proc console_exec {w cmd {after {}}} {
1828         global tcl_platform
1829
1830         # -- Windows tosses the enviroment when we exec our child.
1831         #    But most users need that so we have to relogin. :-(
1832         #
1833         if {$tcl_platform(platform) eq {windows}} {
1834                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1835         }
1836
1837         # -- Tcl won't let us redirect both stdout and stderr to
1838         #    the same pipe.  So pass it through cat...
1839         #
1840         set cmd [concat | $cmd |& cat]
1841
1842         set fd_f [open $cmd r]
1843         fconfigure $fd_f -blocking 0 -translation binary
1844         fileevent $fd_f readable [list console_read $w $fd_f $after]
1845 }
1846
1847 proc console_read {w fd after} {
1848         global console_cr console_data
1849
1850         set buf [read $fd]
1851         if {$buf ne {}} {
1852                 if {![winfo exists $w]} {console_init $w}
1853                 $w.m.t conf -state normal
1854                 set c 0
1855                 set n [string length $buf]
1856                 while {$c < $n} {
1857                         set cr [string first "\r" $buf $c]
1858                         set lf [string first "\n" $buf $c]
1859                         if {$cr < 0} {set cr [expr {$n + 1}]}
1860                         if {$lf < 0} {set lf [expr {$n + 1}]}
1861
1862                         if {$lf < $cr} {
1863                                 $w.m.t insert end [string range $buf $c $lf]
1864                                 set console_cr($w) [$w.m.t index {end -1c}]
1865                                 set c $lf
1866                                 incr c
1867                         } else {
1868                                 $w.m.t delete $console_cr($w) end
1869                                 $w.m.t insert end "\n"
1870                                 $w.m.t insert end [string range $buf $c $cr]
1871                                 set c $cr
1872                                 incr c
1873                         }
1874                 }
1875                 $w.m.t conf -state disabled
1876                 $w.m.t see end
1877         }
1878
1879         fconfigure $fd -blocking 1
1880         if {[eof $fd]} {
1881                 if {[catch {close $fd}]} {
1882                         if {![winfo exists $w]} {console_init $w}
1883                         $w.m.s conf -background red -text {Error: Command Failed}
1884                         $w.ok conf -state normal
1885                         set ok 0
1886                 } elseif {[winfo exists $w]} {
1887                         $w.m.s conf -background green -text {Success}
1888                         $w.ok conf -state normal
1889                         set ok 1
1890                 }
1891                 array unset console_cr $w
1892                 array unset console_data $w
1893                 if {$after ne {}} {
1894                         uplevel #0 $after $ok
1895                 }
1896                 return
1897         }
1898         fconfigure $fd -blocking 0
1899 }
1900
1901 ######################################################################
1902 ##
1903 ## ui commands
1904
1905 set starting_gitk_msg {Please wait... Starting gitk...}
1906
1907 proc do_gitk {} {
1908         global tcl_platform ui_status_value starting_gitk_msg
1909
1910         set ui_status_value $starting_gitk_msg
1911         after 10000 {
1912                 if {$ui_status_value eq $starting_gitk_msg} {
1913                         set ui_status_value {Ready.}
1914                 }
1915         }
1916
1917         if {$tcl_platform(platform) eq {windows}} {
1918                 exec sh -c gitk &
1919         } else {
1920                 exec gitk &
1921         }
1922 }
1923
1924 proc do_repack {} {
1925         set w [new_console "repack" "Repacking the object database"]
1926         set cmd [list git repack]
1927         lappend cmd -a
1928         lappend cmd -d
1929         console_exec $w $cmd
1930 }
1931
1932 set is_quitting 0
1933
1934 proc do_quit {} {
1935         global gitdir ui_comm is_quitting repo_config
1936
1937         if {$is_quitting} return
1938         set is_quitting 1
1939
1940         # -- Stash our current commit buffer.
1941         #
1942         set save [file join $gitdir GITGUI_MSG]
1943         set msg [string trim [$ui_comm get 0.0 end]]
1944         if {[$ui_comm edit modified] && $msg ne {}} {
1945                 catch {
1946                         set fd [open $save w]
1947                         puts $fd [string trim [$ui_comm get 0.0 end]]
1948                         close $fd
1949                 }
1950         } elseif {$msg eq {} && [file exists $save]} {
1951                 file delete $save
1952         }
1953
1954         # -- Stash our current window geometry into this repository.
1955         #
1956         set cfg_geometry [list]
1957         lappend cfg_geometry [wm geometry .]
1958         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1959         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1960         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1961                 set rc_geometry {}
1962         }
1963         if {$cfg_geometry ne $rc_geometry} {
1964                 catch {exec git repo-config gui.geometry $cfg_geometry}
1965         }
1966
1967         destroy .
1968 }
1969
1970 proc do_rescan {} {
1971         rescan {set ui_status_value {Ready.}}
1972 }
1973
1974 proc remove_helper {txt paths} {
1975         global file_states current_diff
1976
1977         if {![lock_index begin-update]} return
1978
1979         set pathList [list]
1980         set after {}
1981         foreach path $paths {
1982                 switch -glob -- [lindex $file_states($path) 0] {
1983                 A? -
1984                 M? -
1985                 D? {
1986                         lappend pathList $path
1987                         if {$path eq $current_diff} {
1988                                 set after {reshow_diff;}
1989                         }
1990                 }
1991                 }
1992         }
1993         if {$pathList eq {}} {
1994                 unlock_index
1995         } else {
1996                 update_indexinfo \
1997                         $txt \
1998                         $pathList \
1999                         [concat $after {set ui_status_value {Ready.}}]
2000         }
2001 }
2002
2003 proc do_remove_selection {} {
2004         global current_diff selected_paths
2005
2006         if {[array size selected_paths] > 0} {
2007                 remove_helper \
2008                         {Removing selected files from commit} \
2009                         [array names selected_paths]
2010         } elseif {$current_diff ne {}} {
2011                 remove_helper \
2012                         "Removing [short_path $current_diff] from commit" \
2013                         [list $current_diff]
2014         }
2015 }
2016
2017 proc include_helper {txt paths} {
2018         global file_states current_diff
2019
2020         if {![lock_index begin-update]} return
2021
2022         set pathList [list]
2023         set after {}
2024         foreach path $paths {
2025                 switch -- [lindex $file_states($path) 0] {
2026                 AM -
2027                 AD -
2028                 MM -
2029                 UM -
2030                 U_ -
2031                 _M -
2032                 _D -
2033                 _O {
2034                         lappend pathList $path
2035                         if {$path eq $current_diff} {
2036                                 set after {reshow_diff;}
2037                         }
2038                 }
2039                 }
2040         }
2041         if {$pathList eq {}} {
2042                 unlock_index
2043         } else {
2044                 update_index \
2045                         $txt \
2046                         $pathList \
2047                         [concat $after {set ui_status_value {Ready to commit.}}]
2048         }
2049 }
2050
2051 proc do_include_selection {} {
2052         global current_diff selected_paths
2053
2054         if {[array size selected_paths] > 0} {
2055                 include_helper \
2056                         {Including selected files} \
2057                         [array names selected_paths]
2058         } elseif {$current_diff ne {}} {
2059                 include_helper \
2060                         "Including [short_path $current_diff]" \
2061                         [list $current_diff]
2062         }
2063 }
2064
2065 proc do_include_all {} {
2066         global file_states
2067
2068         set paths [list]
2069         foreach path [array names file_states] {
2070                 switch -- [lindex $file_states($path) 0] {
2071                 AM -
2072                 AD -
2073                 MM -
2074                 _M -
2075                 _D {lappend paths $path}
2076                 }
2077         }
2078         include_helper \
2079                 {Including all modified files} \
2080                 $paths
2081 }
2082
2083 proc do_signoff {} {
2084         global ui_comm
2085
2086         set me [committer_ident]
2087         if {$me eq {}} return
2088
2089         set sob "Signed-off-by: $me"
2090         set last [$ui_comm get {end -1c linestart} {end -1c}]
2091         if {$last ne $sob} {
2092                 $ui_comm edit separator
2093                 if {$last ne {}
2094                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2095                         $ui_comm insert end "\n"
2096                 }
2097                 $ui_comm insert end "\n$sob"
2098                 $ui_comm edit separator
2099                 $ui_comm see end
2100         }
2101 }
2102
2103 proc do_select_commit_type {} {
2104         global commit_type selected_commit_type
2105
2106         if {$selected_commit_type eq {new}
2107                 && [string match amend* $commit_type]} {
2108                 create_new_commit
2109         } elseif {$selected_commit_type eq {amend}
2110                 && ![string match amend* $commit_type]} {
2111                 load_last_commit
2112
2113                 # The amend request was rejected...
2114                 #
2115                 if {![string match amend* $commit_type]} {
2116                         set selected_commit_type new
2117                 }
2118         }
2119 }
2120
2121 proc do_commit {} {
2122         commit_tree
2123 }
2124
2125 proc do_options {} {
2126         global appname gitdir font_descs
2127         global repo_config global_config
2128         global repo_config_new global_config_new
2129
2130         array unset repo_config_new
2131         array unset global_config_new
2132         foreach name [array names repo_config] {
2133                 set repo_config_new($name) $repo_config($name)
2134         }
2135         load_config 1
2136         foreach name [array names repo_config] {
2137                 switch -- $name {
2138                 gui.diffcontext {continue}
2139                 }
2140                 set repo_config_new($name) $repo_config($name)
2141         }
2142         foreach name [array names global_config] {
2143                 set global_config_new($name) $global_config($name)
2144         }
2145         set reponame [lindex [file split \
2146                 [file normalize [file dirname $gitdir]]] \
2147                 end]
2148
2149         set w .options_editor
2150         toplevel $w
2151         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2152
2153         label $w.header -text "$appname Options" \
2154                 -font font_uibold
2155         pack $w.header -side top -fill x
2156
2157         frame $w.buttons
2158         button $w.buttons.restore -text {Restore Defaults} \
2159                 -font font_ui \
2160                 -command do_restore_defaults
2161         pack $w.buttons.restore -side left
2162         button $w.buttons.save -text Save \
2163                 -font font_ui \
2164                 -command [list do_save_config $w]
2165         pack $w.buttons.save -side right
2166         button $w.buttons.cancel -text {Cancel} \
2167                 -font font_ui \
2168                 -command [list destroy $w]
2169         pack $w.buttons.cancel -side right
2170         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2171
2172         labelframe $w.repo -text "$reponame Repository" \
2173                 -font font_ui \
2174                 -relief raised -borderwidth 2
2175         labelframe $w.global -text {Global (All Repositories)} \
2176                 -font font_ui \
2177                 -relief raised -borderwidth 2
2178         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2179         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2180
2181         foreach option {
2182                 {b partialinclude {Allow Partially Included Files}}
2183                 {b pullsummary {Show Pull Summary}}
2184                 {b trustmtime  {Trust File Modification Timestamps}}
2185                 {i diffcontext {Number of Diff Context Lines}}
2186                 } {
2187                 set type [lindex $option 0]
2188                 set name [lindex $option 1]
2189                 set text [lindex $option 2]
2190                 foreach f {repo global} {
2191                         switch $type {
2192                         b {
2193                                 checkbutton $w.$f.$name -text $text \
2194                                         -variable ${f}_config_new(gui.$name) \
2195                                         -onvalue true \
2196                                         -offvalue false \
2197                                         -font font_ui
2198                                 pack $w.$f.$name -side top -anchor w
2199                         }
2200                         i {
2201                                 frame $w.$f.$name
2202                                 label $w.$f.$name.l -text "$text:" -font font_ui
2203                                 pack $w.$f.$name.l -side left -anchor w -fill x
2204                                 spinbox $w.$f.$name.v \
2205                                         -textvariable ${f}_config_new(gui.$name) \
2206                                         -from 1 -to 99 -increment 1 \
2207                                         -width 3 \
2208                                         -font font_ui
2209                                 pack $w.$f.$name.v -side right -anchor e
2210                                 pack $w.$f.$name -side top -anchor w -fill x
2211                         }
2212                         }
2213                 }
2214         }
2215
2216         set all_fonts [lsort [font families]]
2217         foreach option $font_descs {
2218                 set name [lindex $option 0]
2219                 set font [lindex $option 1]
2220                 set text [lindex $option 2]
2221
2222                 set global_config_new(gui.$font^^family) \
2223                         [font configure $font -family]
2224                 set global_config_new(gui.$font^^size) \
2225                         [font configure $font -size]
2226
2227                 frame $w.global.$name
2228                 label $w.global.$name.l -text "$text:" -font font_ui
2229                 pack $w.global.$name.l -side left -anchor w -fill x
2230                 eval tk_optionMenu $w.global.$name.family \
2231                         global_config_new(gui.$font^^family) \
2232                         $all_fonts
2233                 spinbox $w.global.$name.size \
2234                         -textvariable global_config_new(gui.$font^^size) \
2235                         -from 2 -to 80 -increment 1 \
2236                         -width 3 \
2237                         -font font_ui
2238                 pack $w.global.$name.size -side right -anchor e
2239                 pack $w.global.$name.family -side right -anchor e
2240                 pack $w.global.$name -side top -anchor w -fill x
2241         }
2242
2243         bind $w <Visibility> "grab $w; focus $w"
2244         bind $w <Key-Escape> "destroy $w"
2245         wm title $w "$appname ($reponame): Options"
2246         tkwait window $w
2247 }
2248
2249 proc do_restore_defaults {} {
2250         global font_descs default_config repo_config
2251         global repo_config_new global_config_new
2252
2253         foreach name [array names default_config] {
2254                 set repo_config_new($name) $default_config($name)
2255                 set global_config_new($name) $default_config($name)
2256         }
2257
2258         foreach option $font_descs {
2259                 set name [lindex $option 0]
2260                 set repo_config(gui.$name) $default_config(gui.$name)
2261         }
2262         apply_config
2263
2264         foreach option $font_descs {
2265                 set name [lindex $option 0]
2266                 set font [lindex $option 1]
2267                 set global_config_new(gui.$font^^family) \
2268                         [font configure $font -family]
2269                 set global_config_new(gui.$font^^size) \
2270                         [font configure $font -size]
2271         }
2272 }
2273
2274 proc do_save_config {w} {
2275         if {[catch {save_config} err]} {
2276                 error_popup "Failed to completely save options:\n\n$err"
2277         }
2278         reshow_diff
2279         destroy $w
2280 }
2281
2282 proc do_windows_shortcut {} {
2283         global gitdir appname argv0
2284
2285         set reponame [lindex [file split \
2286                 [file normalize [file dirname $gitdir]]] \
2287                 end]
2288
2289         if {[catch {
2290                 set desktop [exec cygpath \
2291                         --windows \
2292                         --absolute \
2293                         --long-name \
2294                         --desktop]
2295                 }]} {
2296                         set desktop .
2297         }
2298         set fn [tk_getSaveFile \
2299                 -parent . \
2300                 -title "$appname ($reponame): Create Desktop Icon" \
2301                 -initialdir $desktop \
2302                 -initialfile "Git $reponame.bat"]
2303         if {$fn != {}} {
2304                 if {[catch {
2305                                 set fd [open $fn w]
2306                                 set sh [exec cygpath \
2307                                         --windows \
2308                                         --absolute \
2309                                         --long-name \
2310                                         /bin/sh]
2311                                 set me [exec cygpath \
2312                                         --unix \
2313                                         --absolute \
2314                                         $argv0]
2315                                 set gd [exec cygpath \
2316                                         --unix \
2317                                         --absolute \
2318                                         $gitdir]
2319                                 regsub -all ' $me "'\\''" me
2320                                 regsub -all ' $gd "'\\''" gd
2321                                 puts -nonewline $fd "\"$sh\" --login -c \""
2322                                 puts -nonewline $fd "GIT_DIR='$gd'"
2323                                 puts -nonewline $fd " '$me'"
2324                                 puts $fd "&\""
2325                                 close $fd
2326                         } err]} {
2327                         error_popup "Cannot write script:\n\n$err"
2328                 }
2329         }
2330 }
2331
2332 proc do_macosx_app {} {
2333         global gitdir appname argv0 env
2334
2335         set reponame [lindex [file split \
2336                 [file normalize [file dirname $gitdir]]] \
2337                 end]
2338
2339         set fn [tk_getSaveFile \
2340                 -parent . \
2341                 -title "$appname ($reponame): Create Desktop Icon" \
2342                 -initialdir [file join $env(HOME) Desktop] \
2343                 -initialfile "Git $reponame.app"]
2344         if {$fn != {}} {
2345                 if {[catch {
2346                                 set Contents [file join $fn Contents]
2347                                 set MacOS [file join $Contents MacOS]
2348                                 set exe [file join $MacOS git-gui]
2349
2350                                 file mkdir $MacOS
2351
2352                                 set fd [open [file join $Contents Info.plist] w]
2353                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2354 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2355 <plist version="1.0">
2356 <dict>
2357         <key>CFBundleDevelopmentRegion</key>
2358         <string>English</string>
2359         <key>CFBundleExecutable</key>
2360         <string>git-gui</string>
2361         <key>CFBundleIdentifier</key>
2362         <string>org.spearce.git-gui</string>
2363         <key>CFBundleInfoDictionaryVersion</key>
2364         <string>6.0</string>
2365         <key>CFBundlePackageType</key>
2366         <string>APPL</string>
2367         <key>CFBundleSignature</key>
2368         <string>????</string>
2369         <key>CFBundleVersion</key>
2370         <string>1.0</string>
2371         <key>NSPrincipalClass</key>
2372         <string>NSApplication</string>
2373 </dict>
2374 </plist>}
2375                                 close $fd
2376
2377                                 set fd [open $exe w]
2378                                 set gd [file normalize $gitdir]
2379                                 set ep [file normalize [exec git --exec-path]]
2380                                 regsub -all ' $gd "'\\''" gd
2381                                 regsub -all ' $ep "'\\''" ep
2382                                 puts $fd "#!/bin/sh"
2383                                 foreach name [array names env] {
2384                                         if {[string match GIT_* $name]} {
2385                                                 regsub -all ' $env($name) "'\\''" v
2386                                                 puts $fd "export $name='$v'"
2387                                         }
2388                                 }
2389                                 puts $fd "export PATH='$ep':\$PATH"
2390                                 puts $fd "export GIT_DIR='$gd'"
2391                                 puts $fd "exec [file normalize $argv0]"
2392                                 close $fd
2393
2394                                 file attributes $exe -permissions u+x,g+x,o+x
2395                         } err]} {
2396                         error_popup "Cannot write icon:\n\n$err"
2397                 }
2398         }
2399 }
2400
2401 proc toggle_or_diff {w x y} {
2402         global file_states file_lists current_diff ui_index ui_other
2403         global last_clicked selected_paths
2404
2405         set pos [split [$w index @$x,$y] .]
2406         set lno [lindex $pos 0]
2407         set col [lindex $pos 1]
2408         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2409         if {$path eq {}} {
2410                 set last_clicked {}
2411                 return
2412         }
2413
2414         set last_clicked [list $w $lno]
2415         array unset selected_paths
2416         $ui_index tag remove in_sel 0.0 end
2417         $ui_other tag remove in_sel 0.0 end
2418
2419         if {$col == 0} {
2420                 if {$current_diff eq $path} {
2421                         set after {reshow_diff;}
2422                 } else {
2423                         set after {}
2424                 }
2425                 switch -glob -- [lindex $file_states($path) 0] {
2426                 A_ -
2427                 AO -
2428                 M_ -
2429                 DD -
2430                 D_ {
2431                         update_indexinfo \
2432                                 "Removing [short_path $path] from commit" \
2433                                 [list $path] \
2434                                 [concat $after {set ui_status_value {Ready.}}]
2435                 }
2436                 ?? {
2437                         update_index \
2438                                 "Including [short_path $path]" \
2439                                 [list $path] \
2440                                 [concat $after {set ui_status_value {Ready.}}]
2441                 }
2442                 }
2443         } else {
2444                 show_diff $path $w $lno
2445         }
2446 }
2447
2448 proc add_one_to_selection {w x y} {
2449         global file_lists
2450         global last_clicked selected_paths
2451
2452         set pos [split [$w index @$x,$y] .]
2453         set lno [lindex $pos 0]
2454         set col [lindex $pos 1]
2455         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2456         if {$path eq {}} {
2457                 set last_clicked {}
2458                 return
2459         }
2460
2461         set last_clicked [list $w $lno]
2462         if {[catch {set in_sel $selected_paths($path)}]} {
2463                 set in_sel 0
2464         }
2465         if {$in_sel} {
2466                 unset selected_paths($path)
2467                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2468         } else {
2469                 set selected_paths($path) 1
2470                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2471         }
2472 }
2473
2474 proc add_range_to_selection {w x y} {
2475         global file_lists
2476         global last_clicked selected_paths
2477
2478         if {[lindex $last_clicked 0] ne $w} {
2479                 toggle_or_diff $w $x $y
2480                 return
2481         }
2482
2483         set pos [split [$w index @$x,$y] .]
2484         set lno [lindex $pos 0]
2485         set lc [lindex $last_clicked 1]
2486         if {$lc < $lno} {
2487                 set begin $lc
2488                 set end $lno
2489         } else {
2490                 set begin $lno
2491                 set end $lc
2492         }
2493
2494         foreach path [lrange $file_lists($w) \
2495                 [expr {$begin - 1}] \
2496                 [expr {$end - 1}]] {
2497                 set selected_paths($path) 1
2498         }
2499         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2500 }
2501
2502 ######################################################################
2503 ##
2504 ## config defaults
2505
2506 set cursor_ptr arrow
2507 font create font_diff -family Courier -size 10
2508 font create font_ui
2509 catch {
2510         label .dummy
2511         eval font configure font_ui [font actual [.dummy cget -font]]
2512         destroy .dummy
2513 }
2514
2515 font create font_uibold
2516 font create font_diffbold
2517
2518 set M1B M1
2519 set M1T M1
2520 if {$tcl_platform(platform) eq {windows}} {
2521         set M1B Control
2522         set M1T Ctrl
2523 } elseif {[is_MacOSX]} {
2524         set M1B M1
2525         set M1T Cmd
2526 }
2527
2528 proc apply_config {} {
2529         global repo_config font_descs
2530
2531         foreach option $font_descs {
2532                 set name [lindex $option 0]
2533                 set font [lindex $option 1]
2534                 if {[catch {
2535                         foreach {cn cv} $repo_config(gui.$name) {
2536                                 font configure $font $cn $cv
2537                         }
2538                         } err]} {
2539                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2540                 }
2541                 foreach {cn cv} [font configure $font] {
2542                         font configure ${font}bold $cn $cv
2543                 }
2544                 font configure ${font}bold -weight bold
2545         }
2546 }
2547
2548 set default_config(gui.trustmtime) false
2549 set default_config(gui.pullsummary) true
2550 set default_config(gui.partialinclude) false
2551 set default_config(gui.diffcontext) 5
2552 set default_config(gui.fontui) [font configure font_ui]
2553 set default_config(gui.fontdiff) [font configure font_diff]
2554 set font_descs {
2555         {fontui   font_ui   {Main Font}}
2556         {fontdiff font_diff {Diff/Console Font}}
2557 }
2558 load_config 0
2559 apply_config
2560
2561 ######################################################################
2562 ##
2563 ## ui construction
2564
2565 # -- Menu Bar
2566 #
2567 menu .mbar -tearoff 0
2568 .mbar add cascade -label Project -menu .mbar.project
2569 .mbar add cascade -label Edit -menu .mbar.edit
2570 .mbar add cascade -label Commit -menu .mbar.commit
2571 if {!$single_commit} {
2572         .mbar add cascade -label Fetch -menu .mbar.fetch
2573         .mbar add cascade -label Pull -menu .mbar.pull
2574         .mbar add cascade -label Push -menu .mbar.push
2575 }
2576 . configure -menu .mbar
2577
2578 # -- Project Menu
2579 #
2580 menu .mbar.project
2581 .mbar.project add command -label Visualize \
2582         -command do_gitk \
2583         -font font_ui
2584 if {!$single_commit} {
2585         .mbar.project add command -label {Repack Database} \
2586                 -command do_repack \
2587                 -font font_ui
2588
2589         if {$tcl_platform(platform) eq {windows}} {
2590                 .mbar.project add command \
2591                         -label {Create Desktop Icon} \
2592                         -command do_windows_shortcut \
2593                         -font font_ui
2594         } elseif {[is_MacOSX]} {
2595                 .mbar.project add command \
2596                         -label {Create Desktop Icon} \
2597                         -command do_macosx_app \
2598                         -font font_ui
2599         }
2600 }
2601 .mbar.project add command -label Quit \
2602         -command do_quit \
2603         -accelerator $M1T-Q \
2604         -font font_ui
2605
2606 # -- Edit Menu
2607 #
2608 menu .mbar.edit
2609 .mbar.edit add command -label Undo \
2610         -command {catch {[focus] edit undo}} \
2611         -accelerator $M1T-Z \
2612         -font font_ui
2613 .mbar.edit add command -label Redo \
2614         -command {catch {[focus] edit redo}} \
2615         -accelerator $M1T-Y \
2616         -font font_ui
2617 .mbar.edit add separator
2618 .mbar.edit add command -label Cut \
2619         -command {catch {tk_textCut [focus]}} \
2620         -accelerator $M1T-X \
2621         -font font_ui
2622 .mbar.edit add command -label Copy \
2623         -command {catch {tk_textCopy [focus]}} \
2624         -accelerator $M1T-C \
2625         -font font_ui
2626 .mbar.edit add command -label Paste \
2627         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2628         -accelerator $M1T-V \
2629         -font font_ui
2630 .mbar.edit add command -label Delete \
2631         -command {catch {[focus] delete sel.first sel.last}} \
2632         -accelerator Del \
2633         -font font_ui
2634 .mbar.edit add separator
2635 .mbar.edit add command -label {Select All} \
2636         -command {catch {[focus] tag add sel 0.0 end}} \
2637         -accelerator $M1T-A \
2638         -font font_ui
2639 .mbar.edit add separator
2640 .mbar.edit add command -label {Options...} \
2641         -command do_options \
2642         -font font_ui
2643
2644 # -- Commit Menu
2645 #
2646 menu .mbar.commit
2647
2648 .mbar.commit add radiobutton \
2649         -label {New Commit} \
2650         -command do_select_commit_type \
2651         -variable selected_commit_type \
2652         -value new \
2653         -font font_ui
2654 lappend disable_on_lock \
2655         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2656
2657 .mbar.commit add radiobutton \
2658         -label {Amend Last Commit} \
2659         -command do_select_commit_type \
2660         -variable selected_commit_type \
2661         -value amend \
2662         -font font_ui
2663 lappend disable_on_lock \
2664         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2665
2666 .mbar.commit add separator
2667
2668 .mbar.commit add command -label Rescan \
2669         -command do_rescan \
2670         -accelerator F5 \
2671         -font font_ui
2672 lappend disable_on_lock \
2673         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2674
2675 .mbar.commit add command -label {Remove From Commit} \
2676         -command do_remove_selection \
2677         -font font_ui
2678 lappend disable_on_lock \
2679         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2680
2681 .mbar.commit add command -label {Include In Commit} \
2682         -command do_include_selection \
2683         -font font_ui
2684 lappend disable_on_lock \
2685         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2686
2687 .mbar.commit add command -label {Include All} \
2688         -command do_include_all \
2689         -accelerator $M1T-I \
2690         -font font_ui
2691 lappend disable_on_lock \
2692         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2693
2694 .mbar.commit add separator
2695
2696 .mbar.commit add command -label {Sign Off} \
2697         -command do_signoff \
2698         -accelerator $M1T-S \
2699         -font font_ui
2700
2701 .mbar.commit add command -label Commit \
2702         -command do_commit \
2703         -accelerator $M1T-Return \
2704         -font font_ui
2705 lappend disable_on_lock \
2706         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2707
2708 # -- Transport menus
2709 #
2710 if {!$single_commit} {
2711         menu .mbar.fetch
2712         menu .mbar.pull
2713         menu .mbar.push
2714 }
2715
2716 # -- Main Window Layout
2717 #
2718 panedwindow .vpane -orient vertical
2719 panedwindow .vpane.files -orient horizontal
2720 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2721 pack .vpane -anchor n -side top -fill both -expand 1
2722
2723 # -- Index File List
2724 #
2725 frame .vpane.files.index -height 100 -width 400
2726 label .vpane.files.index.title -text {Modified Files} \
2727         -background green \
2728         -font font_ui
2729 text $ui_index -background white -borderwidth 0 \
2730         -width 40 -height 10 \
2731         -font font_ui \
2732         -cursor $cursor_ptr \
2733         -yscrollcommand {.vpane.files.index.sb set} \
2734         -state disabled
2735 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2736 pack .vpane.files.index.title -side top -fill x
2737 pack .vpane.files.index.sb -side right -fill y
2738 pack $ui_index -side left -fill both -expand 1
2739 .vpane.files add .vpane.files.index -sticky nsew
2740
2741 # -- Other (Add) File List
2742 #
2743 frame .vpane.files.other -height 100 -width 100
2744 label .vpane.files.other.title -text {Untracked Files} \
2745         -background red \
2746         -font font_ui
2747 text $ui_other -background white -borderwidth 0 \
2748         -width 40 -height 10 \
2749         -font font_ui \
2750         -cursor $cursor_ptr \
2751         -yscrollcommand {.vpane.files.other.sb set} \
2752         -state disabled
2753 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2754 pack .vpane.files.other.title -side top -fill x
2755 pack .vpane.files.other.sb -side right -fill y
2756 pack $ui_other -side left -fill both -expand 1
2757 .vpane.files add .vpane.files.other -sticky nsew
2758
2759 foreach i [list $ui_index $ui_other] {
2760         $i tag conf in_diff -font font_uibold
2761         $i tag conf in_sel \
2762                 -background [$i cget -foreground] \
2763                 -foreground [$i cget -background]
2764 }
2765 unset i
2766
2767 # -- Diff and Commit Area
2768 #
2769 frame .vpane.lower -height 300 -width 400
2770 frame .vpane.lower.commarea
2771 frame .vpane.lower.diff -relief sunken -borderwidth 1
2772 pack .vpane.lower.commarea -side top -fill x
2773 pack .vpane.lower.diff -side bottom -fill both -expand 1
2774 .vpane add .vpane.lower -stick nsew
2775
2776 # -- Commit Area Buttons
2777 #
2778 frame .vpane.lower.commarea.buttons
2779 label .vpane.lower.commarea.buttons.l -text {} \
2780         -anchor w \
2781         -justify left \
2782         -font font_ui
2783 pack .vpane.lower.commarea.buttons.l -side top -fill x
2784 pack .vpane.lower.commarea.buttons -side left -fill y
2785
2786 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2787         -command do_rescan \
2788         -font font_ui
2789 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2790 lappend disable_on_lock \
2791         {.vpane.lower.commarea.buttons.rescan conf -state}
2792
2793 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2794         -command do_include_all \
2795         -font font_ui
2796 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2797 lappend disable_on_lock \
2798         {.vpane.lower.commarea.buttons.incall conf -state}
2799
2800 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2801         -command do_signoff \
2802         -font font_ui
2803 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2804
2805 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2806         -command do_commit \
2807         -font font_ui
2808 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2809 lappend disable_on_lock \
2810         {.vpane.lower.commarea.buttons.commit conf -state}
2811
2812 # -- Commit Message Buffer
2813 #
2814 frame .vpane.lower.commarea.buffer
2815 frame .vpane.lower.commarea.buffer.header
2816 set ui_comm .vpane.lower.commarea.buffer.t
2817 set ui_coml .vpane.lower.commarea.buffer.header.l
2818 radiobutton .vpane.lower.commarea.buffer.header.new \
2819         -text {New Commit} \
2820         -command do_select_commit_type \
2821         -variable selected_commit_type \
2822         -value new \
2823         -font font_ui
2824 lappend disable_on_lock \
2825         [list .vpane.lower.commarea.buffer.header.new conf -state]
2826 radiobutton .vpane.lower.commarea.buffer.header.amend \
2827         -text {Amend Last Commit} \
2828         -command do_select_commit_type \
2829         -variable selected_commit_type \
2830         -value amend \
2831         -font font_ui
2832 lappend disable_on_lock \
2833         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2834 label $ui_coml \
2835         -anchor w \
2836         -justify left \
2837         -font font_ui
2838 proc trace_commit_type {varname args} {
2839         global ui_coml commit_type
2840         switch -glob -- $commit_type {
2841         initial       {set txt {Initial Commit Message:}}
2842         amend         {set txt {Amended Commit Message:}}
2843         amend-initial {set txt {Amended Initial Commit Message:}}
2844         merge         {set txt {Merge Commit Message:}}
2845         *             {set txt {Commit Message:}}
2846         }
2847         $ui_coml conf -text $txt
2848 }
2849 trace add variable commit_type write trace_commit_type
2850 pack $ui_coml -side left -fill x
2851 pack .vpane.lower.commarea.buffer.header.amend -side right
2852 pack .vpane.lower.commarea.buffer.header.new -side right
2853
2854 text $ui_comm -background white -borderwidth 1 \
2855         -undo true \
2856         -maxundo 20 \
2857         -autoseparators true \
2858         -relief sunken \
2859         -width 75 -height 9 -wrap none \
2860         -font font_diff \
2861         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2862 scrollbar .vpane.lower.commarea.buffer.sby \
2863         -command [list $ui_comm yview]
2864 pack .vpane.lower.commarea.buffer.header -side top -fill x
2865 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2866 pack $ui_comm -side left -fill y
2867 pack .vpane.lower.commarea.buffer -side left -fill y
2868
2869 # -- Commit Message Buffer Context Menu
2870 #
2871 set ctxm .vpane.lower.commarea.buffer.ctxm
2872 menu $ctxm -tearoff 0
2873 $ctxm add command \
2874         -label {Cut} \
2875         -font font_ui \
2876         -command {tk_textCut $ui_comm}
2877 $ctxm add command \
2878         -label {Copy} \
2879         -font font_ui \
2880         -command {tk_textCopy $ui_comm}
2881 $ctxm add command \
2882         -label {Paste} \
2883         -font font_ui \
2884         -command {tk_textPaste $ui_comm}
2885 $ctxm add command \
2886         -label {Delete} \
2887         -font font_ui \
2888         -command {$ui_comm delete sel.first sel.last}
2889 $ctxm add separator
2890 $ctxm add command \
2891         -label {Select All} \
2892         -font font_ui \
2893         -command {$ui_comm tag add sel 0.0 end}
2894 $ctxm add command \
2895         -label {Copy All} \
2896         -font font_ui \
2897         -command {
2898                 $ui_comm tag add sel 0.0 end
2899                 tk_textCopy $ui_comm
2900                 $ui_comm tag remove sel 0.0 end
2901         }
2902 $ctxm add separator
2903 $ctxm add command \
2904         -label {Sign Off} \
2905         -font font_ui \
2906         -command do_signoff
2907 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2908
2909 # -- Diff Header
2910 #
2911 set current_diff {}
2912 set diff_actions [list]
2913 proc trace_current_diff {varname args} {
2914         global current_diff diff_actions file_states
2915         if {$current_diff eq {}} {
2916                 set s {}
2917                 set f {}
2918                 set p {}
2919                 set o disabled
2920         } else {
2921                 set p $current_diff
2922                 set s [mapdesc [lindex $file_states($p) 0] $p]
2923                 set f {File:}
2924                 set p [escape_path $p]
2925                 set o normal
2926         }
2927
2928         .vpane.lower.diff.header.status configure -text $s
2929         .vpane.lower.diff.header.file configure -text $f
2930         .vpane.lower.diff.header.path configure -text $p
2931         foreach w $diff_actions {
2932                 uplevel #0 $w $o
2933         }
2934 }
2935 trace add variable current_diff write trace_current_diff
2936
2937 frame .vpane.lower.diff.header -background orange
2938 label .vpane.lower.diff.header.status \
2939         -background orange \
2940         -width $max_status_desc \
2941         -anchor w \
2942         -justify left \
2943         -font font_ui
2944 label .vpane.lower.diff.header.file \
2945         -background orange \
2946         -anchor w \
2947         -justify left \
2948         -font font_ui
2949 label .vpane.lower.diff.header.path \
2950         -background orange \
2951         -anchor w \
2952         -justify left \
2953         -font font_ui
2954 pack .vpane.lower.diff.header.status -side left
2955 pack .vpane.lower.diff.header.file -side left
2956 pack .vpane.lower.diff.header.path -fill x
2957 set ctxm .vpane.lower.diff.header.ctxm
2958 menu $ctxm -tearoff 0
2959 $ctxm add command \
2960         -label {Copy} \
2961         -font font_ui \
2962         -command {
2963                 clipboard clear
2964                 clipboard append \
2965                         -format STRING \
2966                         -type STRING \
2967                         -- $current_diff
2968         }
2969 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2970 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2971
2972 # -- Diff Body
2973 #
2974 frame .vpane.lower.diff.body
2975 set ui_diff .vpane.lower.diff.body.t
2976 text $ui_diff -background white -borderwidth 0 \
2977         -width 80 -height 15 -wrap none \
2978         -font font_diff \
2979         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2980         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2981         -state disabled
2982 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2983         -command [list $ui_diff xview]
2984 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2985         -command [list $ui_diff yview]
2986 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2987 pack .vpane.lower.diff.body.sby -side right -fill y
2988 pack $ui_diff -side left -fill both -expand 1
2989 pack .vpane.lower.diff.header -side top -fill x
2990 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2991
2992 $ui_diff tag conf d_@ -font font_diffbold
2993 $ui_diff tag conf d_+  -foreground blue
2994 $ui_diff tag conf d_-  -foreground red
2995 $ui_diff tag conf d_++ -foreground {#00a000}
2996 $ui_diff tag conf d_-- -foreground {#a000a0}
2997 $ui_diff tag conf d_+- \
2998         -foreground red \
2999         -background {light goldenrod yellow}
3000 $ui_diff tag conf d_-+ \
3001         -foreground blue \
3002         -background azure2
3003
3004 # -- Diff Body Context Menu
3005 #
3006 set ctxm .vpane.lower.diff.body.ctxm
3007 menu $ctxm -tearoff 0
3008 $ctxm add command \
3009         -label {Copy} \
3010         -font font_ui \
3011         -command {tk_textCopy $ui_diff}
3012 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3013 $ctxm add command \
3014         -label {Select All} \
3015         -font font_ui \
3016         -command {$ui_diff tag add sel 0.0 end}
3017 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3018 $ctxm add command \
3019         -label {Copy All} \
3020         -font font_ui \
3021         -command {
3022                 $ui_diff tag add sel 0.0 end
3023                 tk_textCopy $ui_diff
3024                 $ui_diff tag remove sel 0.0 end
3025         }
3026 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3027 $ctxm add separator
3028 $ctxm add command \
3029         -label {Decrease Font Size} \
3030         -font font_ui \
3031         -command {incr_font_size font_diff -1}
3032 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3033 $ctxm add command \
3034         -label {Increase Font Size} \
3035         -font font_ui \
3036         -command {incr_font_size font_diff 1}
3037 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3038 $ctxm add separator
3039 $ctxm add command \
3040         -label {Show Less Context} \
3041         -font font_ui \
3042         -command {if {$repo_config(gui.diffcontext) >= 2} {
3043                 incr repo_config(gui.diffcontext) -1
3044                 reshow_diff
3045         }}
3046 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3047 $ctxm add command \
3048         -label {Show More Context} \
3049         -font font_ui \
3050         -command {
3051                 incr repo_config(gui.diffcontext)
3052                 reshow_diff
3053         }
3054 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3055 $ctxm add separator
3056 $ctxm add command -label {Options...} \
3057         -font font_ui \
3058         -command do_options
3059 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3060
3061 # -- Status Bar
3062 #
3063 set ui_status_value {Initializing...}
3064 label .status -textvariable ui_status_value \
3065         -anchor w \
3066         -justify left \
3067         -borderwidth 1 \
3068         -relief sunken \
3069         -font font_ui
3070 pack .status -anchor w -side bottom -fill x
3071
3072 # -- Load geometry
3073 #
3074 catch {
3075 set gm $repo_config(gui.geometry)
3076 wm geometry . [lindex $gm 0]
3077 .vpane sash place 0 \
3078         [lindex [.vpane sash coord 0] 0] \
3079         [lindex $gm 1]
3080 .vpane.files sash place 0 \
3081         [lindex $gm 2] \
3082         [lindex [.vpane.files sash coord 0] 1]
3083 unset gm
3084 }
3085
3086 # -- Key Bindings
3087 #
3088 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3089 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3090 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3091 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3092 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3093 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3094 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3095 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3096 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3097 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3098 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3099
3100 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3101 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3102 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3103 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3104 bind $ui_diff <$M1B-Key-v> {break}
3105 bind $ui_diff <$M1B-Key-V> {break}
3106 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3107 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3108 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3109 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3110 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3111 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3112
3113 bind .   <Destroy> do_quit
3114 bind all <Key-F5> do_rescan
3115 bind all <$M1B-Key-r> do_rescan
3116 bind all <$M1B-Key-R> do_rescan
3117 bind .   <$M1B-Key-s> do_signoff
3118 bind .   <$M1B-Key-S> do_signoff
3119 bind .   <$M1B-Key-i> do_include_all
3120 bind .   <$M1B-Key-I> do_include_all
3121 bind .   <$M1B-Key-Return> do_commit
3122 bind all <$M1B-Key-q> do_quit
3123 bind all <$M1B-Key-Q> do_quit
3124 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3125 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3126 foreach i [list $ui_index $ui_other] {
3127         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3128         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3129         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3130 }
3131 unset i
3132
3133 set file_lists($ui_index) [list]
3134 set file_lists($ui_other) [list]
3135
3136 set HEAD {}
3137 set PARENT {}
3138 set commit_type {}
3139 set empty_tree {}
3140 set current_diff {}
3141 set selected_commit_type new
3142
3143 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3144 focus -force $ui_comm
3145 if {!$single_commit} {
3146         load_all_remotes
3147         populate_fetch_menu .mbar.fetch
3148         populate_pull_menu .mbar.pull
3149         populate_push_menu .mbar.push
3150 }
3151 lock_index begin-read
3152 after 1 do_rescan