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 rescan_active
 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 in memory status
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                 _O -
1033                 _M -
1034                 _D {continue}
1035                 __ -
1036                 A_ -
1037                 M_ -
1038                 DD {
1039                         unset file_states($path)
1040                         catch {unset selected_paths($path)}
1041                 }
1042                 DO {
1043                         set file_states($path) [list _O [lindex $s 1] {} {}]
1044                 }
1045                 AM -
1046                 AD -
1047                 MM -
1048                 DM {
1049                         set file_states($path) [list \
1050                                 _[string index $m 1] \
1051                                 [lindex $s 1] \
1052                                 [lindex $s 3] \
1053                                 {}]
1054                 }
1055                 }
1056         }
1057
1058         display_all_files
1059         unlock_index
1060         reshow_diff
1061         set ui_status_value \
1062                 "Changes committed as [string range $cmt_id 0 7]."
1063 }
1064
1065 ######################################################################
1066 ##
1067 ## fetch pull push
1068
1069 proc fetch_from {remote} {
1070         set w [new_console "fetch $remote" \
1071                 "Fetching new changes from $remote"]
1072         set cmd [list git fetch]
1073         lappend cmd $remote
1074         console_exec $w $cmd
1075 }
1076
1077 proc pull_remote {remote branch} {
1078         global HEAD commit_type file_states repo_config
1079
1080         if {![lock_index update]} return
1081
1082         # -- Our in memory state should match the repository.
1083         #
1084         repository_state curHEAD cur_type
1085         if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1086                 error_popup {Last scanned state does not match repository state.
1087
1088 Its highly likely that another Git program modified the
1089 repository since our last scan.  A rescan is required
1090 before a pull can be started.
1091 }
1092                 unlock_index
1093                 rescan {set ui_status_value {Ready.}}
1094                 return
1095         }
1096
1097         # -- No differences should exist before a pull.
1098         #
1099         if {[array size file_states] != 0} {
1100                 error_popup {Uncommitted but modified files are present.
1101
1102 You should not perform a pull with unmodified files in your working
1103 directory as Git would be unable to recover from an incorrect merge.
1104
1105 Commit or throw away all changes before starting a pull operation.
1106 }
1107                 unlock_index
1108                 return
1109         }
1110
1111         set w [new_console "pull $remote $branch" \
1112                 "Pulling new changes from branch $branch in $remote"]
1113         set cmd [list git pull]
1114         if {$repo_config(gui.pullsummary) eq {false}} {
1115                 lappend cmd --no-summary
1116         }
1117         lappend cmd $remote
1118         lappend cmd $branch
1119         console_exec $w $cmd [list post_pull_remote $remote $branch]
1120 }
1121
1122 proc post_pull_remote {remote branch success} {
1123         global HEAD PARENT commit_type selected_commit_type
1124         global ui_status_value
1125
1126         unlock_index
1127         if {$success} {
1128                 repository_state HEAD commit_type
1129                 set PARENT $HEAD
1130                 set selected_commit_type new
1131                 set $ui_status_value "Pulling $branch from $remote complete."
1132         } else {
1133                 set m "Conflicts detected while pulling $branch from $remote."
1134                 rescan "set ui_status_value {$m}"
1135         }
1136 }
1137
1138 proc push_to {remote} {
1139         set w [new_console "push $remote" \
1140                 "Pushing changes to $remote"]
1141         set cmd [list git push]
1142         lappend cmd $remote
1143         console_exec $w $cmd
1144 }
1145
1146 ######################################################################
1147 ##
1148 ## ui helpers
1149
1150 proc mapcol {state path} {
1151         global all_cols ui_other
1152
1153         if {[catch {set r $all_cols($state)}]} {
1154                 puts "error: no column for state={$state} $path"
1155                 return $ui_other
1156         }
1157         return $r
1158 }
1159
1160 proc mapicon {state path} {
1161         global all_icons
1162
1163         if {[catch {set r $all_icons($state)}]} {
1164                 puts "error: no icon for state={$state} $path"
1165                 return file_plain
1166         }
1167         return $r
1168 }
1169
1170 proc mapdesc {state path} {
1171         global all_descs
1172
1173         if {[catch {set r $all_descs($state)}]} {
1174                 puts "error: no desc for state={$state} $path"
1175                 return $state
1176         }
1177         return $r
1178 }
1179
1180 proc escape_path {path} {
1181         regsub -all "\n" $path "\\n" path
1182         return $path
1183 }
1184
1185 proc short_path {path} {
1186         return [escape_path [lindex [file split $path] end]]
1187 }
1188
1189 set next_icon_id 0
1190 set null_sha1 [string repeat 0 40]
1191
1192 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1193         global file_states next_icon_id null_sha1
1194
1195         set s0 [string index $new_state 0]
1196         set s1 [string index $new_state 1]
1197
1198         if {[catch {set info $file_states($path)}]} {
1199                 set state __
1200                 set icon n[incr next_icon_id]
1201         } else {
1202                 set state [lindex $info 0]
1203                 set icon [lindex $info 1]
1204                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1205                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1206         }
1207
1208         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1209         elseif {$s0 eq {_}} {set s0 _}
1210
1211         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1212         elseif {$s1 eq {_}} {set s1 _}
1213
1214         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1215                 set head_info [list 0 $null_sha1]
1216         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1217                 && $head_info eq {}} {
1218                 set head_info $index_info
1219         }
1220
1221         set file_states($path) [list $s0$s1 $icon \
1222                 $head_info $index_info \
1223                 ]
1224         return $state
1225 }
1226
1227 proc display_file {path state} {
1228         global file_states file_lists selected_paths
1229
1230         set old_m [merge_state $path $state]
1231         set s $file_states($path)
1232         set new_m [lindex $s 0]
1233         set new_w [mapcol $new_m $path]
1234         set old_w [mapcol $old_m $path]
1235         set new_icon [mapicon $new_m $path]
1236
1237         if {$new_w ne $old_w} {
1238                 set lno [lsearch -sorted $file_lists($old_w) $path]
1239                 if {$lno >= 0} {
1240                         incr lno
1241                         $old_w conf -state normal
1242                         $old_w delete $lno.0 [expr {$lno + 1}].0
1243                         $old_w conf -state disabled
1244                 }
1245
1246                 lappend file_lists($new_w) $path
1247                 set file_lists($new_w) [lsort $file_lists($new_w)]
1248                 set lno [lsearch -sorted $file_lists($new_w) $path]
1249                 incr lno
1250                 $new_w conf -state normal
1251                 $new_w image create $lno.0 \
1252                         -align center -padx 5 -pady 1 \
1253                         -name [lindex $s 1] \
1254                         -image $new_icon
1255                 $new_w insert $lno.1 "[escape_path $path]\n"
1256                 if {[catch {set in_sel $selected_paths($path)}]} {
1257                         set in_sel 0
1258                 }
1259                 if {$in_sel} {
1260                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1261                 }
1262                 $new_w conf -state disabled
1263         } elseif {$new_icon ne [mapicon $old_m $path]} {
1264                 $new_w conf -state normal
1265                 $new_w image conf [lindex $s 1] -image $new_icon
1266                 $new_w conf -state disabled
1267         }
1268 }
1269
1270 proc display_all_files {} {
1271         global ui_index ui_other
1272         global file_states file_lists
1273         global last_clicked selected_paths
1274
1275         $ui_index conf -state normal
1276         $ui_other conf -state normal
1277
1278         $ui_index delete 0.0 end
1279         $ui_other delete 0.0 end
1280         set last_clicked {}
1281
1282         set file_lists($ui_index) [list]
1283         set file_lists($ui_other) [list]
1284
1285         foreach path [lsort [array names file_states]] {
1286                 set s $file_states($path)
1287                 set m [lindex $s 0]
1288                 set w [mapcol $m $path]
1289                 lappend file_lists($w) $path
1290                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1291                 $w image create end \
1292                         -align center -padx 5 -pady 1 \
1293                         -name [lindex $s 1] \
1294                         -image [mapicon $m $path]
1295                 $w insert end "[escape_path $path]\n"
1296                 if {[catch {set in_sel $selected_paths($path)}]} {
1297                         set in_sel 0
1298                 }
1299                 if {$in_sel} {
1300                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1301                 }
1302         }
1303
1304         $ui_index conf -state disabled
1305         $ui_other conf -state disabled
1306 }
1307
1308 proc update_indexinfo {msg pathList after} {
1309         global update_index_cp ui_status_value
1310
1311         if {![lock_index update]} return
1312
1313         set update_index_cp 0
1314         set pathList [lsort $pathList]
1315         set totalCnt [llength $pathList]
1316         set batch [expr {int($totalCnt * .01) + 1}]
1317         if {$batch > 25} {set batch 25}
1318
1319         set ui_status_value [format \
1320                 "$msg... %i/%i files (%.2f%%)" \
1321                 $update_index_cp \
1322                 $totalCnt \
1323                 0.0]
1324         set fd [open "| git update-index -z --index-info" w]
1325         fconfigure $fd \
1326                 -blocking 0 \
1327                 -buffering full \
1328                 -buffersize 512 \
1329                 -translation binary
1330         fileevent $fd writable [list \
1331                 write_update_indexinfo \
1332                 $fd \
1333                 $pathList \
1334                 $totalCnt \
1335                 $batch \
1336                 $msg \
1337                 $after \
1338                 ]
1339 }
1340
1341 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1342         global update_index_cp ui_status_value
1343         global file_states current_diff
1344
1345         if {$update_index_cp >= $totalCnt} {
1346                 close $fd
1347                 unlock_index
1348                 uplevel #0 $after
1349                 return
1350         }
1351
1352         for {set i $batch} \
1353                 {$update_index_cp < $totalCnt && $i > 0} \
1354                 {incr i -1} {
1355                 set path [lindex $pathList $update_index_cp]
1356                 incr update_index_cp
1357
1358                 set s $file_states($path)
1359                 switch -glob -- [lindex $s 0] {
1360                 A? {set new _O}
1361                 M? {set new _M}
1362                 D? {set new _?}
1363                 ?? {continue}
1364                 }
1365                 set info [lindex $s 2]
1366                 if {$info eq {}} continue
1367
1368                 puts -nonewline $fd $info
1369                 puts -nonewline $fd "\t"
1370                 puts -nonewline $fd $path
1371                 puts -nonewline $fd "\0"
1372                 display_file $path $new
1373         }
1374
1375         set ui_status_value [format \
1376                 "$msg... %i/%i files (%.2f%%)" \
1377                 $update_index_cp \
1378                 $totalCnt \
1379                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1380 }
1381
1382 proc update_index {msg pathList after} {
1383         global update_index_cp ui_status_value
1384
1385         if {![lock_index update]} return
1386
1387         set update_index_cp 0
1388         set pathList [lsort $pathList]
1389         set totalCnt [llength $pathList]
1390         set batch [expr {int($totalCnt * .01) + 1}]
1391         if {$batch > 25} {set batch 25}
1392
1393         set ui_status_value [format \
1394                 "$msg... %i/%i files (%.2f%%)" \
1395                 $update_index_cp \
1396                 $totalCnt \
1397                 0.0]
1398         set fd [open "| git update-index --add --remove -z --stdin" w]
1399         fconfigure $fd \
1400                 -blocking 0 \
1401                 -buffering full \
1402                 -buffersize 512 \
1403                 -translation binary
1404         fileevent $fd writable [list \
1405                 write_update_index \
1406                 $fd \
1407                 $pathList \
1408                 $totalCnt \
1409                 $batch \
1410                 $msg \
1411                 $after \
1412                 ]
1413 }
1414
1415 proc write_update_index {fd pathList totalCnt batch msg after} {
1416         global update_index_cp ui_status_value
1417         global file_states current_diff
1418
1419         if {$update_index_cp >= $totalCnt} {
1420                 close $fd
1421                 unlock_index
1422                 uplevel #0 $after
1423                 return
1424         }
1425
1426         for {set i $batch} \
1427                 {$update_index_cp < $totalCnt && $i > 0} \
1428                 {incr i -1} {
1429                 set path [lindex $pathList $update_index_cp]
1430                 incr update_index_cp
1431
1432                 switch -glob -- [lindex $file_states($path) 0] {
1433                 AD -
1434                 MD -
1435                 _D {set new DD}
1436
1437                 _M -
1438                 MM -
1439                 M_ {set new M_}
1440
1441                 _O -
1442                 AM -
1443                 A_ {set new A_}
1444
1445                 ?? {continue}
1446                 }
1447
1448                 puts -nonewline $fd $path
1449                 puts -nonewline $fd "\0"
1450                 display_file $path $new
1451         }
1452
1453         set ui_status_value [format \
1454                 "$msg... %i/%i files (%.2f%%)" \
1455                 $update_index_cp \
1456                 $totalCnt \
1457                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1458 }
1459
1460 ######################################################################
1461 ##
1462 ## remote management
1463
1464 proc load_all_remotes {} {
1465         global gitdir all_remotes repo_config
1466
1467         set all_remotes [list]
1468         set rm_dir [file join $gitdir remotes]
1469         if {[file isdirectory $rm_dir]} {
1470                 set all_remotes [concat $all_remotes [glob \
1471                         -types f \
1472                         -tails \
1473                         -nocomplain \
1474                         -directory $rm_dir *]]
1475         }
1476
1477         foreach line [array names repo_config remote.*.url] {
1478                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1479                         lappend all_remotes $name
1480                 }
1481         }
1482
1483         set all_remotes [lsort -unique $all_remotes]
1484 }
1485
1486 proc populate_fetch_menu {m} {
1487         global gitdir all_remotes repo_config
1488
1489         foreach r $all_remotes {
1490                 set enable 0
1491                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1492                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1493                                 set enable 1
1494                         }
1495                 } else {
1496                         catch {
1497                                 set fd [open [file join $gitdir remotes $r] r]
1498                                 while {[gets $fd n] >= 0} {
1499                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1500                                                 set enable 1
1501                                                 break
1502                                         }
1503                                 }
1504                                 close $fd
1505                         }
1506                 }
1507
1508                 if {$enable} {
1509                         $m add command \
1510                                 -label "Fetch from $r..." \
1511                                 -command [list fetch_from $r] \
1512                                 -font font_ui
1513                 }
1514         }
1515 }
1516
1517 proc populate_push_menu {m} {
1518         global gitdir all_remotes repo_config
1519
1520         foreach r $all_remotes {
1521                 set enable 0
1522                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1523                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1524                                 set enable 1
1525                         }
1526                 } else {
1527                         catch {
1528                                 set fd [open [file join $gitdir remotes $r] r]
1529                                 while {[gets $fd n] >= 0} {
1530                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1531                                                 set enable 1
1532                                                 break
1533                                         }
1534                                 }
1535                                 close $fd
1536                         }
1537                 }
1538
1539                 if {$enable} {
1540                         $m add command \
1541                                 -label "Push to $r..." \
1542                                 -command [list push_to $r] \
1543                                 -font font_ui
1544                 }
1545         }
1546 }
1547
1548 proc populate_pull_menu {m} {
1549         global gitdir repo_config all_remotes disable_on_lock
1550
1551         foreach remote $all_remotes {
1552                 set rb {}
1553                 if {[array get repo_config remote.$remote.url] ne {}} {
1554                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1555                                 regexp {^([^:]+):} \
1556                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1557                                         line rb
1558                         }
1559                 } else {
1560                         catch {
1561                                 set fd [open [file join $gitdir remotes $remote] r]
1562                                 while {[gets $fd line] >= 0} {
1563                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1564                                                 break
1565                                         }
1566                                 }
1567                                 close $fd
1568                         }
1569                 }
1570
1571                 set rb_short $rb
1572                 regsub ^refs/heads/ $rb {} rb_short
1573                 if {$rb_short ne {}} {
1574                         $m add command \
1575                                 -label "Branch $rb_short from $remote..." \
1576                                 -command [list pull_remote $remote $rb] \
1577                                 -font font_ui
1578                         lappend disable_on_lock \
1579                                 [list $m entryconf [$m index last] -state]
1580                 }
1581         }
1582 }
1583
1584 ######################################################################
1585 ##
1586 ## icons
1587
1588 set filemask {
1589 #define mask_width 14
1590 #define mask_height 15
1591 static unsigned char mask_bits[] = {
1592    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1593    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1594    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1595 }
1596
1597 image create bitmap file_plain -background white -foreground black -data {
1598 #define plain_width 14
1599 #define plain_height 15
1600 static unsigned char plain_bits[] = {
1601    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1602    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1603    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1604 } -maskdata $filemask
1605
1606 image create bitmap file_mod -background white -foreground blue -data {
1607 #define mod_width 14
1608 #define mod_height 15
1609 static unsigned char mod_bits[] = {
1610    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1611    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1612    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1613 } -maskdata $filemask
1614
1615 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1616 #define file_fulltick_width 14
1617 #define file_fulltick_height 15
1618 static unsigned char file_fulltick_bits[] = {
1619    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1620    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1621    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1622 } -maskdata $filemask
1623
1624 image create bitmap file_parttick -background white -foreground "#005050" -data {
1625 #define parttick_width 14
1626 #define parttick_height 15
1627 static unsigned char parttick_bits[] = {
1628    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1629    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1630    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1631 } -maskdata $filemask
1632
1633 image create bitmap file_question -background white -foreground black -data {
1634 #define file_question_width 14
1635 #define file_question_height 15
1636 static unsigned char file_question_bits[] = {
1637    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1638    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1639    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1640 } -maskdata $filemask
1641
1642 image create bitmap file_removed -background white -foreground red -data {
1643 #define file_removed_width 14
1644 #define file_removed_height 15
1645 static unsigned char file_removed_bits[] = {
1646    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1647    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1648    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1649 } -maskdata $filemask
1650
1651 image create bitmap file_merge -background white -foreground blue -data {
1652 #define file_merge_width 14
1653 #define file_merge_height 15
1654 static unsigned char file_merge_bits[] = {
1655    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1656    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1657    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1658 } -maskdata $filemask
1659
1660 set ui_index .vpane.files.index.list
1661 set ui_other .vpane.files.other.list
1662 set max_status_desc 0
1663 foreach i {
1664                 {__ i plain    "Unmodified"}
1665                 {_M i mod      "Modified"}
1666                 {M_ i fulltick "Included in commit"}
1667                 {MM i parttick "Partially included"}
1668
1669                 {_O o plain    "Untracked"}
1670                 {A_ o fulltick "Added by commit"}
1671                 {AM o parttick "Partially added"}
1672                 {AD o question "Added (but now gone)"}
1673
1674                 {_D i question "Missing"}
1675                 {DD i removed  "Removed by commit"}
1676                 {DO i removed  "Removed (still exists)"}
1677                 {DM i removed  "Removed (but modified)"}
1678
1679                 {UD i merge    "Merge conflicts"}
1680                 {UM i merge    "Merge conflicts"}
1681                 {U_ i merge    "Merge conflicts"}
1682         } {
1683         if {$max_status_desc < [string length [lindex $i 3]]} {
1684                 set max_status_desc [string length [lindex $i 3]]
1685         }
1686         if {[lindex $i 1] eq {i}} {
1687                 set all_cols([lindex $i 0]) $ui_index
1688         } else {
1689                 set all_cols([lindex $i 0]) $ui_other
1690         }
1691         set all_icons([lindex $i 0]) file_[lindex $i 2]
1692         set all_descs([lindex $i 0]) [lindex $i 3]
1693 }
1694 unset filemask i
1695
1696 ######################################################################
1697 ##
1698 ## util
1699
1700 proc is_MacOSX {} {
1701         global tcl_platform tk_library
1702         if {$tcl_platform(platform) eq {unix}
1703                 && $tcl_platform(os) eq {Darwin}
1704                 && [string match /Library/Frameworks/* $tk_library]} {
1705                 return 1
1706         }
1707         return 0
1708 }
1709
1710 proc bind_button3 {w cmd} {
1711         bind $w <Any-Button-3> $cmd
1712         if {[is_MacOSX]} {
1713                 bind $w <Control-Button-1> $cmd
1714         }
1715 }
1716
1717 proc incr_font_size {font {amt 1}} {
1718         set sz [font configure $font -size]
1719         incr sz $amt
1720         font configure $font -size $sz
1721         font configure ${font}bold -size $sz
1722 }
1723
1724 proc hook_failed_popup {hook msg} {
1725         global gitdir appname
1726
1727         set w .hookfail
1728         toplevel $w
1729
1730         frame $w.m
1731         label $w.m.l1 -text "$hook hook failed:" \
1732                 -anchor w \
1733                 -justify left \
1734                 -font font_uibold
1735         text $w.m.t \
1736                 -background white -borderwidth 1 \
1737                 -relief sunken \
1738                 -width 80 -height 10 \
1739                 -font font_diff \
1740                 -yscrollcommand [list $w.m.sby set]
1741         label $w.m.l2 \
1742                 -text {You must correct the above errors before committing.} \
1743                 -anchor w \
1744                 -justify left \
1745                 -font font_uibold
1746         scrollbar $w.m.sby -command [list $w.m.t yview]
1747         pack $w.m.l1 -side top -fill x
1748         pack $w.m.l2 -side bottom -fill x
1749         pack $w.m.sby -side right -fill y
1750         pack $w.m.t -side left -fill both -expand 1
1751         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1752
1753         $w.m.t insert 1.0 $msg
1754         $w.m.t conf -state disabled
1755
1756         button $w.ok -text OK \
1757                 -width 15 \
1758                 -font font_ui \
1759                 -command "destroy $w"
1760         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1761
1762         bind $w <Visibility> "grab $w; focus $w"
1763         bind $w <Key-Return> "destroy $w"
1764         wm title $w "$appname ([lindex [file split \
1765                 [file normalize [file dirname $gitdir]]] \
1766                 end]): error"
1767         tkwait window $w
1768 }
1769
1770 set next_console_id 0
1771
1772 proc new_console {short_title long_title} {
1773         global next_console_id console_data
1774         set w .console[incr next_console_id]
1775         set console_data($w) [list $short_title $long_title]
1776         return [console_init $w]
1777 }
1778
1779 proc console_init {w} {
1780         global console_cr console_data
1781         global gitdir appname M1B
1782
1783         set console_cr($w) 1.0
1784         toplevel $w
1785         frame $w.m
1786         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1787                 -anchor w \
1788                 -justify left \
1789                 -font font_uibold
1790         text $w.m.t \
1791                 -background white -borderwidth 1 \
1792                 -relief sunken \
1793                 -width 80 -height 10 \
1794                 -font font_diff \
1795                 -state disabled \
1796                 -yscrollcommand [list $w.m.sby set]
1797         label $w.m.s -text {Working... please wait...} \
1798                 -anchor w \
1799                 -justify left \
1800                 -font font_uibold
1801         scrollbar $w.m.sby -command [list $w.m.t yview]
1802         pack $w.m.l1 -side top -fill x
1803         pack $w.m.s -side bottom -fill x
1804         pack $w.m.sby -side right -fill y
1805         pack $w.m.t -side left -fill both -expand 1
1806         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1807
1808         menu $w.ctxm -tearoff 0
1809         $w.ctxm add command -label "Copy" \
1810                 -font font_ui \
1811                 -command "tk_textCopy $w.m.t"
1812         $w.ctxm add command -label "Select All" \
1813                 -font font_ui \
1814                 -command "$w.m.t tag add sel 0.0 end"
1815         $w.ctxm add command -label "Copy All" \
1816                 -font font_ui \
1817                 -command "
1818                         $w.m.t tag add sel 0.0 end
1819                         tk_textCopy $w.m.t
1820                         $w.m.t tag remove sel 0.0 end
1821                 "
1822
1823         button $w.ok -text {Close} \
1824                 -font font_ui \
1825                 -state disabled \
1826                 -command "destroy $w"
1827         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1828
1829         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1830         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1831         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1832         bind $w <Visibility> "focus $w"
1833         wm title $w "$appname ([lindex [file split \
1834                 [file normalize [file dirname $gitdir]]] \
1835                 end]): [lindex $console_data($w) 0]"
1836         return $w
1837 }
1838
1839 proc console_exec {w cmd {after {}}} {
1840         global tcl_platform
1841
1842         # -- Windows tosses the enviroment when we exec our child.
1843         #    But most users need that so we have to relogin. :-(
1844         #
1845         if {$tcl_platform(platform) eq {windows}} {
1846                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1847         }
1848
1849         # -- Tcl won't let us redirect both stdout and stderr to
1850         #    the same pipe.  So pass it through cat...
1851         #
1852         set cmd [concat | $cmd |& cat]
1853
1854         set fd_f [open $cmd r]
1855         fconfigure $fd_f -blocking 0 -translation binary
1856         fileevent $fd_f readable [list console_read $w $fd_f $after]
1857 }
1858
1859 proc console_read {w fd after} {
1860         global console_cr console_data
1861
1862         set buf [read $fd]
1863         if {$buf ne {}} {
1864                 if {![winfo exists $w]} {console_init $w}
1865                 $w.m.t conf -state normal
1866                 set c 0
1867                 set n [string length $buf]
1868                 while {$c < $n} {
1869                         set cr [string first "\r" $buf $c]
1870                         set lf [string first "\n" $buf $c]
1871                         if {$cr < 0} {set cr [expr {$n + 1}]}
1872                         if {$lf < 0} {set lf [expr {$n + 1}]}
1873
1874                         if {$lf < $cr} {
1875                                 $w.m.t insert end [string range $buf $c $lf]
1876                                 set console_cr($w) [$w.m.t index {end -1c}]
1877                                 set c $lf
1878                                 incr c
1879                         } else {
1880                                 $w.m.t delete $console_cr($w) end
1881                                 $w.m.t insert end "\n"
1882                                 $w.m.t insert end [string range $buf $c $cr]
1883                                 set c $cr
1884                                 incr c
1885                         }
1886                 }
1887                 $w.m.t conf -state disabled
1888                 $w.m.t see end
1889         }
1890
1891         fconfigure $fd -blocking 1
1892         if {[eof $fd]} {
1893                 if {[catch {close $fd}]} {
1894                         if {![winfo exists $w]} {console_init $w}
1895                         $w.m.s conf -background red -text {Error: Command Failed}
1896                         $w.ok conf -state normal
1897                         set ok 0
1898                 } elseif {[winfo exists $w]} {
1899                         $w.m.s conf -background green -text {Success}
1900                         $w.ok conf -state normal
1901                         set ok 1
1902                 }
1903                 array unset console_cr $w
1904                 array unset console_data $w
1905                 if {$after ne {}} {
1906                         uplevel #0 $after $ok
1907                 }
1908                 return
1909         }
1910         fconfigure $fd -blocking 0
1911 }
1912
1913 ######################################################################
1914 ##
1915 ## ui commands
1916
1917 set starting_gitk_msg {Please wait... Starting gitk...}
1918
1919 proc do_gitk {} {
1920         global tcl_platform ui_status_value starting_gitk_msg
1921
1922         set ui_status_value $starting_gitk_msg
1923         after 10000 {
1924                 if {$ui_status_value eq $starting_gitk_msg} {
1925                         set ui_status_value {Ready.}
1926                 }
1927         }
1928
1929         if {$tcl_platform(platform) eq {windows}} {
1930                 exec sh -c gitk &
1931         } else {
1932                 exec gitk &
1933         }
1934 }
1935
1936 proc do_repack {} {
1937         set w [new_console "repack" "Repacking the object database"]
1938         set cmd [list git repack]
1939         lappend cmd -a
1940         lappend cmd -d
1941         console_exec $w $cmd
1942 }
1943
1944 set is_quitting 0
1945
1946 proc do_quit {} {
1947         global gitdir ui_comm is_quitting repo_config
1948
1949         if {$is_quitting} return
1950         set is_quitting 1
1951
1952         # -- Stash our current commit buffer.
1953         #
1954         set save [file join $gitdir GITGUI_MSG]
1955         set msg [string trim [$ui_comm get 0.0 end]]
1956         if {[$ui_comm edit modified] && $msg ne {}} {
1957                 catch {
1958                         set fd [open $save w]
1959                         puts $fd [string trim [$ui_comm get 0.0 end]]
1960                         close $fd
1961                 }
1962         } elseif {$msg eq {} && [file exists $save]} {
1963                 file delete $save
1964         }
1965
1966         # -- Stash our current window geometry into this repository.
1967         #
1968         set cfg_geometry [list]
1969         lappend cfg_geometry [wm geometry .]
1970         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1971         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1972         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1973                 set rc_geometry {}
1974         }
1975         if {$cfg_geometry ne $rc_geometry} {
1976                 catch {exec git repo-config gui.geometry $cfg_geometry}
1977         }
1978
1979         destroy .
1980 }
1981
1982 proc do_rescan {} {
1983         rescan {set ui_status_value {Ready.}}
1984 }
1985
1986 proc remove_helper {txt paths} {
1987         global file_states current_diff
1988
1989         if {![lock_index begin-update]} return
1990
1991         set pathList [list]
1992         set after {}
1993         foreach path $paths {
1994                 switch -glob -- [lindex $file_states($path) 0] {
1995                 A? -
1996                 M? -
1997                 D? {
1998                         lappend pathList $path
1999                         if {$path eq $current_diff} {
2000                                 set after {reshow_diff;}
2001                         }
2002                 }
2003                 }
2004         }
2005         if {$pathList eq {}} {
2006                 unlock_index
2007         } else {
2008                 update_indexinfo \
2009                         $txt \
2010                         $pathList \
2011                         [concat $after {set ui_status_value {Ready.}}]
2012         }
2013 }
2014
2015 proc do_remove_selection {} {
2016         global current_diff selected_paths
2017
2018         if {[array size selected_paths] > 0} {
2019                 remove_helper \
2020                         {Removing selected files from commit} \
2021                         [array names selected_paths]
2022         } elseif {$current_diff ne {}} {
2023                 remove_helper \
2024                         "Removing [short_path $current_diff] from commit" \
2025                         [list $current_diff]
2026         }
2027 }
2028
2029 proc include_helper {txt paths} {
2030         global file_states current_diff
2031
2032         if {![lock_index begin-update]} return
2033
2034         set pathList [list]
2035         set after {}
2036         foreach path $paths {
2037                 switch -glob -- [lindex $file_states($path) 0] {
2038                 AM -
2039                 AD -
2040                 MM -
2041                 U? -
2042                 _M -
2043                 _D -
2044                 _O {
2045                         lappend pathList $path
2046                         if {$path eq $current_diff} {
2047                                 set after {reshow_diff;}
2048                         }
2049                 }
2050                 }
2051         }
2052         if {$pathList eq {}} {
2053                 unlock_index
2054         } else {
2055                 update_index \
2056                         $txt \
2057                         $pathList \
2058                         [concat $after {set ui_status_value {Ready to commit.}}]
2059         }
2060 }
2061
2062 proc do_include_selection {} {
2063         global current_diff selected_paths
2064
2065         if {[array size selected_paths] > 0} {
2066                 include_helper \
2067                         {Including selected files} \
2068                         [array names selected_paths]
2069         } elseif {$current_diff ne {}} {
2070                 include_helper \
2071                         "Including [short_path $current_diff]" \
2072                         [list $current_diff]
2073         }
2074 }
2075
2076 proc do_include_all {} {
2077         global file_states
2078
2079         set paths [list]
2080         foreach path [array names file_states] {
2081                 switch -- [lindex $file_states($path) 0] {
2082                 AM -
2083                 AD -
2084                 MM -
2085                 _M -
2086                 _D {lappend paths $path}
2087                 }
2088         }
2089         include_helper \
2090                 {Including all modified files} \
2091                 $paths
2092 }
2093
2094 proc do_signoff {} {
2095         global ui_comm
2096
2097         set me [committer_ident]
2098         if {$me eq {}} return
2099
2100         set sob "Signed-off-by: $me"
2101         set last [$ui_comm get {end -1c linestart} {end -1c}]
2102         if {$last ne $sob} {
2103                 $ui_comm edit separator
2104                 if {$last ne {}
2105                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2106                         $ui_comm insert end "\n"
2107                 }
2108                 $ui_comm insert end "\n$sob"
2109                 $ui_comm edit separator
2110                 $ui_comm see end
2111         }
2112 }
2113
2114 proc do_select_commit_type {} {
2115         global commit_type selected_commit_type
2116
2117         if {$selected_commit_type eq {new}
2118                 && [string match amend* $commit_type]} {
2119                 create_new_commit
2120         } elseif {$selected_commit_type eq {amend}
2121                 && ![string match amend* $commit_type]} {
2122                 load_last_commit
2123
2124                 # The amend request was rejected...
2125                 #
2126                 if {![string match amend* $commit_type]} {
2127                         set selected_commit_type new
2128                 }
2129         }
2130 }
2131
2132 proc do_commit {} {
2133         commit_tree
2134 }
2135
2136 proc do_options {} {
2137         global appname gitdir font_descs
2138         global repo_config global_config
2139         global repo_config_new global_config_new
2140
2141         array unset repo_config_new
2142         array unset global_config_new
2143         foreach name [array names repo_config] {
2144                 set repo_config_new($name) $repo_config($name)
2145         }
2146         load_config 1
2147         foreach name [array names repo_config] {
2148                 switch -- $name {
2149                 gui.diffcontext {continue}
2150                 }
2151                 set repo_config_new($name) $repo_config($name)
2152         }
2153         foreach name [array names global_config] {
2154                 set global_config_new($name) $global_config($name)
2155         }
2156         set reponame [lindex [file split \
2157                 [file normalize [file dirname $gitdir]]] \
2158                 end]
2159
2160         set w .options_editor
2161         toplevel $w
2162         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2163
2164         label $w.header -text "$appname Options" \
2165                 -font font_uibold
2166         pack $w.header -side top -fill x
2167
2168         frame $w.buttons
2169         button $w.buttons.restore -text {Restore Defaults} \
2170                 -font font_ui \
2171                 -command do_restore_defaults
2172         pack $w.buttons.restore -side left
2173         button $w.buttons.save -text Save \
2174                 -font font_ui \
2175                 -command [list do_save_config $w]
2176         pack $w.buttons.save -side right
2177         button $w.buttons.cancel -text {Cancel} \
2178                 -font font_ui \
2179                 -command [list destroy $w]
2180         pack $w.buttons.cancel -side right
2181         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2182
2183         labelframe $w.repo -text "$reponame Repository" \
2184                 -font font_ui \
2185                 -relief raised -borderwidth 2
2186         labelframe $w.global -text {Global (All Repositories)} \
2187                 -font font_ui \
2188                 -relief raised -borderwidth 2
2189         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2190         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2191
2192         foreach option {
2193                 {b partialinclude {Allow Partially Included Files}}
2194                 {b pullsummary {Show Pull Summary}}
2195                 {b trustmtime  {Trust File Modification Timestamps}}
2196                 {i diffcontext {Number of Diff Context Lines}}
2197                 } {
2198                 set type [lindex $option 0]
2199                 set name [lindex $option 1]
2200                 set text [lindex $option 2]
2201                 foreach f {repo global} {
2202                         switch $type {
2203                         b {
2204                                 checkbutton $w.$f.$name -text $text \
2205                                         -variable ${f}_config_new(gui.$name) \
2206                                         -onvalue true \
2207                                         -offvalue false \
2208                                         -font font_ui
2209                                 pack $w.$f.$name -side top -anchor w
2210                         }
2211                         i {
2212                                 frame $w.$f.$name
2213                                 label $w.$f.$name.l -text "$text:" -font font_ui
2214                                 pack $w.$f.$name.l -side left -anchor w -fill x
2215                                 spinbox $w.$f.$name.v \
2216                                         -textvariable ${f}_config_new(gui.$name) \
2217                                         -from 1 -to 99 -increment 1 \
2218                                         -width 3 \
2219                                         -font font_ui
2220                                 pack $w.$f.$name.v -side right -anchor e
2221                                 pack $w.$f.$name -side top -anchor w -fill x
2222                         }
2223                         }
2224                 }
2225         }
2226
2227         set all_fonts [lsort [font families]]
2228         foreach option $font_descs {
2229                 set name [lindex $option 0]
2230                 set font [lindex $option 1]
2231                 set text [lindex $option 2]
2232
2233                 set global_config_new(gui.$font^^family) \
2234                         [font configure $font -family]
2235                 set global_config_new(gui.$font^^size) \
2236                         [font configure $font -size]
2237
2238                 frame $w.global.$name
2239                 label $w.global.$name.l -text "$text:" -font font_ui
2240                 pack $w.global.$name.l -side left -anchor w -fill x
2241                 eval tk_optionMenu $w.global.$name.family \
2242                         global_config_new(gui.$font^^family) \
2243                         $all_fonts
2244                 spinbox $w.global.$name.size \
2245                         -textvariable global_config_new(gui.$font^^size) \
2246                         -from 2 -to 80 -increment 1 \
2247                         -width 3 \
2248                         -font font_ui
2249                 pack $w.global.$name.size -side right -anchor e
2250                 pack $w.global.$name.family -side right -anchor e
2251                 pack $w.global.$name -side top -anchor w -fill x
2252         }
2253
2254         bind $w <Visibility> "grab $w; focus $w"
2255         bind $w <Key-Escape> "destroy $w"
2256         wm title $w "$appname ($reponame): Options"
2257         tkwait window $w
2258 }
2259
2260 proc do_restore_defaults {} {
2261         global font_descs default_config repo_config
2262         global repo_config_new global_config_new
2263
2264         foreach name [array names default_config] {
2265                 set repo_config_new($name) $default_config($name)
2266                 set global_config_new($name) $default_config($name)
2267         }
2268
2269         foreach option $font_descs {
2270                 set name [lindex $option 0]
2271                 set repo_config(gui.$name) $default_config(gui.$name)
2272         }
2273         apply_config
2274
2275         foreach option $font_descs {
2276                 set name [lindex $option 0]
2277                 set font [lindex $option 1]
2278                 set global_config_new(gui.$font^^family) \
2279                         [font configure $font -family]
2280                 set global_config_new(gui.$font^^size) \
2281                         [font configure $font -size]
2282         }
2283 }
2284
2285 proc do_save_config {w} {
2286         if {[catch {save_config} err]} {
2287                 error_popup "Failed to completely save options:\n\n$err"
2288         }
2289         reshow_diff
2290         destroy $w
2291 }
2292
2293 proc do_windows_shortcut {} {
2294         global gitdir appname argv0
2295
2296         set reponame [lindex [file split \
2297                 [file normalize [file dirname $gitdir]]] \
2298                 end]
2299
2300         if {[catch {
2301                 set desktop [exec cygpath \
2302                         --windows \
2303                         --absolute \
2304                         --long-name \
2305                         --desktop]
2306                 }]} {
2307                         set desktop .
2308         }
2309         set fn [tk_getSaveFile \
2310                 -parent . \
2311                 -title "$appname ($reponame): Create Desktop Icon" \
2312                 -initialdir $desktop \
2313                 -initialfile "Git $reponame.bat"]
2314         if {$fn != {}} {
2315                 if {[catch {
2316                                 set fd [open $fn w]
2317                                 set sh [exec cygpath \
2318                                         --windows \
2319                                         --absolute \
2320                                         --long-name \
2321                                         /bin/sh]
2322                                 set me [exec cygpath \
2323                                         --unix \
2324                                         --absolute \
2325                                         $argv0]
2326                                 set gd [exec cygpath \
2327                                         --unix \
2328                                         --absolute \
2329                                         $gitdir]
2330                                 regsub -all ' $me "'\\''" me
2331                                 regsub -all ' $gd "'\\''" gd
2332                                 puts -nonewline $fd "\"$sh\" --login -c \""
2333                                 puts -nonewline $fd "GIT_DIR='$gd'"
2334                                 puts -nonewline $fd " '$me'"
2335                                 puts $fd "&\""
2336                                 close $fd
2337                         } err]} {
2338                         error_popup "Cannot write script:\n\n$err"
2339                 }
2340         }
2341 }
2342
2343 proc do_macosx_app {} {
2344         global gitdir appname argv0 env
2345
2346         set reponame [lindex [file split \
2347                 [file normalize [file dirname $gitdir]]] \
2348                 end]
2349
2350         set fn [tk_getSaveFile \
2351                 -parent . \
2352                 -title "$appname ($reponame): Create Desktop Icon" \
2353                 -initialdir [file join $env(HOME) Desktop] \
2354                 -initialfile "Git $reponame.app"]
2355         if {$fn != {}} {
2356                 if {[catch {
2357                                 set Contents [file join $fn Contents]
2358                                 set MacOS [file join $Contents MacOS]
2359                                 set exe [file join $MacOS git-gui]
2360
2361                                 file mkdir $MacOS
2362
2363                                 set fd [open [file join $Contents Info.plist] w]
2364                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2365 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2366 <plist version="1.0">
2367 <dict>
2368         <key>CFBundleDevelopmentRegion</key>
2369         <string>English</string>
2370         <key>CFBundleExecutable</key>
2371         <string>git-gui</string>
2372         <key>CFBundleIdentifier</key>
2373         <string>org.spearce.git-gui</string>
2374         <key>CFBundleInfoDictionaryVersion</key>
2375         <string>6.0</string>
2376         <key>CFBundlePackageType</key>
2377         <string>APPL</string>
2378         <key>CFBundleSignature</key>
2379         <string>????</string>
2380         <key>CFBundleVersion</key>
2381         <string>1.0</string>
2382         <key>NSPrincipalClass</key>
2383         <string>NSApplication</string>
2384 </dict>
2385 </plist>}
2386                                 close $fd
2387
2388                                 set fd [open $exe w]
2389                                 set gd [file normalize $gitdir]
2390                                 set ep [file normalize [exec git --exec-path]]
2391                                 regsub -all ' $gd "'\\''" gd
2392                                 regsub -all ' $ep "'\\''" ep
2393                                 puts $fd "#!/bin/sh"
2394                                 foreach name [array names env] {
2395                                         if {[string match GIT_* $name]} {
2396                                                 regsub -all ' $env($name) "'\\''" v
2397                                                 puts $fd "export $name='$v'"
2398                                         }
2399                                 }
2400                                 puts $fd "export PATH='$ep':\$PATH"
2401                                 puts $fd "export GIT_DIR='$gd'"
2402                                 puts $fd "exec [file normalize $argv0]"
2403                                 close $fd
2404
2405                                 file attributes $exe -permissions u+x,g+x,o+x
2406                         } err]} {
2407                         error_popup "Cannot write icon:\n\n$err"
2408                 }
2409         }
2410 }
2411
2412 proc toggle_or_diff {w x y} {
2413         global file_states file_lists current_diff ui_index ui_other
2414         global last_clicked selected_paths
2415
2416         set pos [split [$w index @$x,$y] .]
2417         set lno [lindex $pos 0]
2418         set col [lindex $pos 1]
2419         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2420         if {$path eq {}} {
2421                 set last_clicked {}
2422                 return
2423         }
2424
2425         set last_clicked [list $w $lno]
2426         array unset selected_paths
2427         $ui_index tag remove in_sel 0.0 end
2428         $ui_other tag remove in_sel 0.0 end
2429
2430         if {$col == 0} {
2431                 if {$current_diff eq $path} {
2432                         set after {reshow_diff;}
2433                 } else {
2434                         set after {}
2435                 }
2436                 switch -glob -- [lindex $file_states($path) 0] {
2437                 A_ -
2438                 M_ -
2439                 DD -
2440                 DO -
2441                 DM {
2442                         update_indexinfo \
2443                                 "Removing [short_path $path] from commit" \
2444                                 [list $path] \
2445                                 [concat $after {set ui_status_value {Ready.}}]
2446                 }
2447                 ?? {
2448                         update_index \
2449                                 "Including [short_path $path]" \
2450                                 [list $path] \
2451                                 [concat $after {set ui_status_value {Ready.}}]
2452                 }
2453                 }
2454         } else {
2455                 show_diff $path $w $lno
2456         }
2457 }
2458
2459 proc add_one_to_selection {w x y} {
2460         global file_lists
2461         global last_clicked selected_paths
2462
2463         set pos [split [$w index @$x,$y] .]
2464         set lno [lindex $pos 0]
2465         set col [lindex $pos 1]
2466         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2467         if {$path eq {}} {
2468                 set last_clicked {}
2469                 return
2470         }
2471
2472         set last_clicked [list $w $lno]
2473         if {[catch {set in_sel $selected_paths($path)}]} {
2474                 set in_sel 0
2475         }
2476         if {$in_sel} {
2477                 unset selected_paths($path)
2478                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2479         } else {
2480                 set selected_paths($path) 1
2481                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2482         }
2483 }
2484
2485 proc add_range_to_selection {w x y} {
2486         global file_lists
2487         global last_clicked selected_paths
2488
2489         if {[lindex $last_clicked 0] ne $w} {
2490                 toggle_or_diff $w $x $y
2491                 return
2492         }
2493
2494         set pos [split [$w index @$x,$y] .]
2495         set lno [lindex $pos 0]
2496         set lc [lindex $last_clicked 1]
2497         if {$lc < $lno} {
2498                 set begin $lc
2499                 set end $lno
2500         } else {
2501                 set begin $lno
2502                 set end $lc
2503         }
2504
2505         foreach path [lrange $file_lists($w) \
2506                 [expr {$begin - 1}] \
2507                 [expr {$end - 1}]] {
2508                 set selected_paths($path) 1
2509         }
2510         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2511 }
2512
2513 ######################################################################
2514 ##
2515 ## config defaults
2516
2517 set cursor_ptr arrow
2518 font create font_diff -family Courier -size 10
2519 font create font_ui
2520 catch {
2521         label .dummy
2522         eval font configure font_ui [font actual [.dummy cget -font]]
2523         destroy .dummy
2524 }
2525
2526 font create font_uibold
2527 font create font_diffbold
2528
2529 set M1B M1
2530 set M1T M1
2531 if {$tcl_platform(platform) eq {windows}} {
2532         set M1B Control
2533         set M1T Ctrl
2534 } elseif {[is_MacOSX]} {
2535         set M1B M1
2536         set M1T Cmd
2537 }
2538
2539 proc apply_config {} {
2540         global repo_config font_descs
2541
2542         foreach option $font_descs {
2543                 set name [lindex $option 0]
2544                 set font [lindex $option 1]
2545                 if {[catch {
2546                         foreach {cn cv} $repo_config(gui.$name) {
2547                                 font configure $font $cn $cv
2548                         }
2549                         } err]} {
2550                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2551                 }
2552                 foreach {cn cv} [font configure $font] {
2553                         font configure ${font}bold $cn $cv
2554                 }
2555                 font configure ${font}bold -weight bold
2556         }
2557 }
2558
2559 set default_config(gui.trustmtime) false
2560 set default_config(gui.pullsummary) true
2561 set default_config(gui.partialinclude) false
2562 set default_config(gui.diffcontext) 5
2563 set default_config(gui.fontui) [font configure font_ui]
2564 set default_config(gui.fontdiff) [font configure font_diff]
2565 set font_descs {
2566         {fontui   font_ui   {Main Font}}
2567         {fontdiff font_diff {Diff/Console Font}}
2568 }
2569 load_config 0
2570 apply_config
2571
2572 ######################################################################
2573 ##
2574 ## ui construction
2575
2576 # -- Menu Bar
2577 #
2578 menu .mbar -tearoff 0
2579 .mbar add cascade -label Project -menu .mbar.project
2580 .mbar add cascade -label Edit -menu .mbar.edit
2581 .mbar add cascade -label Commit -menu .mbar.commit
2582 if {!$single_commit} {
2583         .mbar add cascade -label Fetch -menu .mbar.fetch
2584         .mbar add cascade -label Pull -menu .mbar.pull
2585         .mbar add cascade -label Push -menu .mbar.push
2586 }
2587 . configure -menu .mbar
2588
2589 # -- Project Menu
2590 #
2591 menu .mbar.project
2592 .mbar.project add command -label Visualize \
2593         -command do_gitk \
2594         -font font_ui
2595 if {!$single_commit} {
2596         .mbar.project add command -label {Repack Database} \
2597                 -command do_repack \
2598                 -font font_ui
2599
2600         if {$tcl_platform(platform) eq {windows}} {
2601                 .mbar.project add command \
2602                         -label {Create Desktop Icon} \
2603                         -command do_windows_shortcut \
2604                         -font font_ui
2605         } elseif {[is_MacOSX]} {
2606                 .mbar.project add command \
2607                         -label {Create Desktop Icon} \
2608                         -command do_macosx_app \
2609                         -font font_ui
2610         }
2611 }
2612 .mbar.project add command -label Quit \
2613         -command do_quit \
2614         -accelerator $M1T-Q \
2615         -font font_ui
2616
2617 # -- Edit Menu
2618 #
2619 menu .mbar.edit
2620 .mbar.edit add command -label Undo \
2621         -command {catch {[focus] edit undo}} \
2622         -accelerator $M1T-Z \
2623         -font font_ui
2624 .mbar.edit add command -label Redo \
2625         -command {catch {[focus] edit redo}} \
2626         -accelerator $M1T-Y \
2627         -font font_ui
2628 .mbar.edit add separator
2629 .mbar.edit add command -label Cut \
2630         -command {catch {tk_textCut [focus]}} \
2631         -accelerator $M1T-X \
2632         -font font_ui
2633 .mbar.edit add command -label Copy \
2634         -command {catch {tk_textCopy [focus]}} \
2635         -accelerator $M1T-C \
2636         -font font_ui
2637 .mbar.edit add command -label Paste \
2638         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2639         -accelerator $M1T-V \
2640         -font font_ui
2641 .mbar.edit add command -label Delete \
2642         -command {catch {[focus] delete sel.first sel.last}} \
2643         -accelerator Del \
2644         -font font_ui
2645 .mbar.edit add separator
2646 .mbar.edit add command -label {Select All} \
2647         -command {catch {[focus] tag add sel 0.0 end}} \
2648         -accelerator $M1T-A \
2649         -font font_ui
2650 .mbar.edit add separator
2651 .mbar.edit add command -label {Options...} \
2652         -command do_options \
2653         -font font_ui
2654
2655 # -- Commit Menu
2656 #
2657 menu .mbar.commit
2658
2659 .mbar.commit add radiobutton \
2660         -label {New Commit} \
2661         -command do_select_commit_type \
2662         -variable selected_commit_type \
2663         -value new \
2664         -font font_ui
2665 lappend disable_on_lock \
2666         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2667
2668 .mbar.commit add radiobutton \
2669         -label {Amend Last Commit} \
2670         -command do_select_commit_type \
2671         -variable selected_commit_type \
2672         -value amend \
2673         -font font_ui
2674 lappend disable_on_lock \
2675         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2676
2677 .mbar.commit add separator
2678
2679 .mbar.commit add command -label Rescan \
2680         -command do_rescan \
2681         -accelerator F5 \
2682         -font font_ui
2683 lappend disable_on_lock \
2684         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2685
2686 .mbar.commit add command -label {Remove From Commit} \
2687         -command do_remove_selection \
2688         -font font_ui
2689 lappend disable_on_lock \
2690         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2691
2692 .mbar.commit add command -label {Include In Commit} \
2693         -command do_include_selection \
2694         -font font_ui
2695 lappend disable_on_lock \
2696         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2697
2698 .mbar.commit add command -label {Include All} \
2699         -command do_include_all \
2700         -accelerator $M1T-I \
2701         -font font_ui
2702 lappend disable_on_lock \
2703         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2704
2705 .mbar.commit add separator
2706
2707 .mbar.commit add command -label {Sign Off} \
2708         -command do_signoff \
2709         -accelerator $M1T-S \
2710         -font font_ui
2711
2712 .mbar.commit add command -label Commit \
2713         -command do_commit \
2714         -accelerator $M1T-Return \
2715         -font font_ui
2716 lappend disable_on_lock \
2717         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2718
2719 # -- Transport menus
2720 #
2721 if {!$single_commit} {
2722         menu .mbar.fetch
2723         menu .mbar.pull
2724         menu .mbar.push
2725 }
2726
2727 # -- Main Window Layout
2728 #
2729 panedwindow .vpane -orient vertical
2730 panedwindow .vpane.files -orient horizontal
2731 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2732 pack .vpane -anchor n -side top -fill both -expand 1
2733
2734 # -- Index File List
2735 #
2736 frame .vpane.files.index -height 100 -width 400
2737 label .vpane.files.index.title -text {Modified Files} \
2738         -background green \
2739         -font font_ui
2740 text $ui_index -background white -borderwidth 0 \
2741         -width 40 -height 10 \
2742         -font font_ui \
2743         -cursor $cursor_ptr \
2744         -yscrollcommand {.vpane.files.index.sb set} \
2745         -state disabled
2746 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2747 pack .vpane.files.index.title -side top -fill x
2748 pack .vpane.files.index.sb -side right -fill y
2749 pack $ui_index -side left -fill both -expand 1
2750 .vpane.files add .vpane.files.index -sticky nsew
2751
2752 # -- Other (Add) File List
2753 #
2754 frame .vpane.files.other -height 100 -width 100
2755 label .vpane.files.other.title -text {Untracked Files} \
2756         -background red \
2757         -font font_ui
2758 text $ui_other -background white -borderwidth 0 \
2759         -width 40 -height 10 \
2760         -font font_ui \
2761         -cursor $cursor_ptr \
2762         -yscrollcommand {.vpane.files.other.sb set} \
2763         -state disabled
2764 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2765 pack .vpane.files.other.title -side top -fill x
2766 pack .vpane.files.other.sb -side right -fill y
2767 pack $ui_other -side left -fill both -expand 1
2768 .vpane.files add .vpane.files.other -sticky nsew
2769
2770 foreach i [list $ui_index $ui_other] {
2771         $i tag conf in_diff -font font_uibold
2772         $i tag conf in_sel \
2773                 -background [$i cget -foreground] \
2774                 -foreground [$i cget -background]
2775 }
2776 unset i
2777
2778 # -- Diff and Commit Area
2779 #
2780 frame .vpane.lower -height 300 -width 400
2781 frame .vpane.lower.commarea
2782 frame .vpane.lower.diff -relief sunken -borderwidth 1
2783 pack .vpane.lower.commarea -side top -fill x
2784 pack .vpane.lower.diff -side bottom -fill both -expand 1
2785 .vpane add .vpane.lower -stick nsew
2786
2787 # -- Commit Area Buttons
2788 #
2789 frame .vpane.lower.commarea.buttons
2790 label .vpane.lower.commarea.buttons.l -text {} \
2791         -anchor w \
2792         -justify left \
2793         -font font_ui
2794 pack .vpane.lower.commarea.buttons.l -side top -fill x
2795 pack .vpane.lower.commarea.buttons -side left -fill y
2796
2797 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2798         -command do_rescan \
2799         -font font_ui
2800 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2801 lappend disable_on_lock \
2802         {.vpane.lower.commarea.buttons.rescan conf -state}
2803
2804 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2805         -command do_include_all \
2806         -font font_ui
2807 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2808 lappend disable_on_lock \
2809         {.vpane.lower.commarea.buttons.incall conf -state}
2810
2811 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2812         -command do_signoff \
2813         -font font_ui
2814 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2815
2816 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2817         -command do_commit \
2818         -font font_ui
2819 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2820 lappend disable_on_lock \
2821         {.vpane.lower.commarea.buttons.commit conf -state}
2822
2823 # -- Commit Message Buffer
2824 #
2825 frame .vpane.lower.commarea.buffer
2826 frame .vpane.lower.commarea.buffer.header
2827 set ui_comm .vpane.lower.commarea.buffer.t
2828 set ui_coml .vpane.lower.commarea.buffer.header.l
2829 radiobutton .vpane.lower.commarea.buffer.header.new \
2830         -text {New Commit} \
2831         -command do_select_commit_type \
2832         -variable selected_commit_type \
2833         -value new \
2834         -font font_ui
2835 lappend disable_on_lock \
2836         [list .vpane.lower.commarea.buffer.header.new conf -state]
2837 radiobutton .vpane.lower.commarea.buffer.header.amend \
2838         -text {Amend Last Commit} \
2839         -command do_select_commit_type \
2840         -variable selected_commit_type \
2841         -value amend \
2842         -font font_ui
2843 lappend disable_on_lock \
2844         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2845 label $ui_coml \
2846         -anchor w \
2847         -justify left \
2848         -font font_ui
2849 proc trace_commit_type {varname args} {
2850         global ui_coml commit_type
2851         switch -glob -- $commit_type {
2852         initial       {set txt {Initial Commit Message:}}
2853         amend         {set txt {Amended Commit Message:}}
2854         amend-initial {set txt {Amended Initial Commit Message:}}
2855         merge         {set txt {Merge Commit Message:}}
2856         *             {set txt {Commit Message:}}
2857         }
2858         $ui_coml conf -text $txt
2859 }
2860 trace add variable commit_type write trace_commit_type
2861 pack $ui_coml -side left -fill x
2862 pack .vpane.lower.commarea.buffer.header.amend -side right
2863 pack .vpane.lower.commarea.buffer.header.new -side right
2864
2865 text $ui_comm -background white -borderwidth 1 \
2866         -undo true \
2867         -maxundo 20 \
2868         -autoseparators true \
2869         -relief sunken \
2870         -width 75 -height 9 -wrap none \
2871         -font font_diff \
2872         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2873 scrollbar .vpane.lower.commarea.buffer.sby \
2874         -command [list $ui_comm yview]
2875 pack .vpane.lower.commarea.buffer.header -side top -fill x
2876 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2877 pack $ui_comm -side left -fill y
2878 pack .vpane.lower.commarea.buffer -side left -fill y
2879
2880 # -- Commit Message Buffer Context Menu
2881 #
2882 set ctxm .vpane.lower.commarea.buffer.ctxm
2883 menu $ctxm -tearoff 0
2884 $ctxm add command \
2885         -label {Cut} \
2886         -font font_ui \
2887         -command {tk_textCut $ui_comm}
2888 $ctxm add command \
2889         -label {Copy} \
2890         -font font_ui \
2891         -command {tk_textCopy $ui_comm}
2892 $ctxm add command \
2893         -label {Paste} \
2894         -font font_ui \
2895         -command {tk_textPaste $ui_comm}
2896 $ctxm add command \
2897         -label {Delete} \
2898         -font font_ui \
2899         -command {$ui_comm delete sel.first sel.last}
2900 $ctxm add separator
2901 $ctxm add command \
2902         -label {Select All} \
2903         -font font_ui \
2904         -command {$ui_comm tag add sel 0.0 end}
2905 $ctxm add command \
2906         -label {Copy All} \
2907         -font font_ui \
2908         -command {
2909                 $ui_comm tag add sel 0.0 end
2910                 tk_textCopy $ui_comm
2911                 $ui_comm tag remove sel 0.0 end
2912         }
2913 $ctxm add separator
2914 $ctxm add command \
2915         -label {Sign Off} \
2916         -font font_ui \
2917         -command do_signoff
2918 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2919
2920 # -- Diff Header
2921 #
2922 set current_diff {}
2923 set diff_actions [list]
2924 proc trace_current_diff {varname args} {
2925         global current_diff diff_actions file_states
2926         if {$current_diff eq {}} {
2927                 set s {}
2928                 set f {}
2929                 set p {}
2930                 set o disabled
2931         } else {
2932                 set p $current_diff
2933                 set s [mapdesc [lindex $file_states($p) 0] $p]
2934                 set f {File:}
2935                 set p [escape_path $p]
2936                 set o normal
2937         }
2938
2939         .vpane.lower.diff.header.status configure -text $s
2940         .vpane.lower.diff.header.file configure -text $f
2941         .vpane.lower.diff.header.path configure -text $p
2942         foreach w $diff_actions {
2943                 uplevel #0 $w $o
2944         }
2945 }
2946 trace add variable current_diff write trace_current_diff
2947
2948 frame .vpane.lower.diff.header -background orange
2949 label .vpane.lower.diff.header.status \
2950         -background orange \
2951         -width $max_status_desc \
2952         -anchor w \
2953         -justify left \
2954         -font font_ui
2955 label .vpane.lower.diff.header.file \
2956         -background orange \
2957         -anchor w \
2958         -justify left \
2959         -font font_ui
2960 label .vpane.lower.diff.header.path \
2961         -background orange \
2962         -anchor w \
2963         -justify left \
2964         -font font_ui
2965 pack .vpane.lower.diff.header.status -side left
2966 pack .vpane.lower.diff.header.file -side left
2967 pack .vpane.lower.diff.header.path -fill x
2968 set ctxm .vpane.lower.diff.header.ctxm
2969 menu $ctxm -tearoff 0
2970 $ctxm add command \
2971         -label {Copy} \
2972         -font font_ui \
2973         -command {
2974                 clipboard clear
2975                 clipboard append \
2976                         -format STRING \
2977                         -type STRING \
2978                         -- $current_diff
2979         }
2980 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2981 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2982
2983 # -- Diff Body
2984 #
2985 frame .vpane.lower.diff.body
2986 set ui_diff .vpane.lower.diff.body.t
2987 text $ui_diff -background white -borderwidth 0 \
2988         -width 80 -height 15 -wrap none \
2989         -font font_diff \
2990         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2991         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2992         -state disabled
2993 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2994         -command [list $ui_diff xview]
2995 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2996         -command [list $ui_diff yview]
2997 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2998 pack .vpane.lower.diff.body.sby -side right -fill y
2999 pack $ui_diff -side left -fill both -expand 1
3000 pack .vpane.lower.diff.header -side top -fill x
3001 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3002
3003 $ui_diff tag conf d_@ -font font_diffbold
3004 $ui_diff tag conf d_+  -foreground blue
3005 $ui_diff tag conf d_-  -foreground red
3006 $ui_diff tag conf d_++ -foreground {#00a000}
3007 $ui_diff tag conf d_-- -foreground {#a000a0}
3008 $ui_diff tag conf d_+- \
3009         -foreground red \
3010         -background {light goldenrod yellow}
3011 $ui_diff tag conf d_-+ \
3012         -foreground blue \
3013         -background azure2
3014
3015 # -- Diff Body Context Menu
3016 #
3017 set ctxm .vpane.lower.diff.body.ctxm
3018 menu $ctxm -tearoff 0
3019 $ctxm add command \
3020         -label {Copy} \
3021         -font font_ui \
3022         -command {tk_textCopy $ui_diff}
3023 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3024 $ctxm add command \
3025         -label {Select All} \
3026         -font font_ui \
3027         -command {$ui_diff tag add sel 0.0 end}
3028 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3029 $ctxm add command \
3030         -label {Copy All} \
3031         -font font_ui \
3032         -command {
3033                 $ui_diff tag add sel 0.0 end
3034                 tk_textCopy $ui_diff
3035                 $ui_diff tag remove sel 0.0 end
3036         }
3037 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3038 $ctxm add separator
3039 $ctxm add command \
3040         -label {Decrease Font Size} \
3041         -font font_ui \
3042         -command {incr_font_size font_diff -1}
3043 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3044 $ctxm add command \
3045         -label {Increase Font Size} \
3046         -font font_ui \
3047         -command {incr_font_size font_diff 1}
3048 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3049 $ctxm add separator
3050 $ctxm add command \
3051         -label {Show Less Context} \
3052         -font font_ui \
3053         -command {if {$repo_config(gui.diffcontext) >= 2} {
3054                 incr repo_config(gui.diffcontext) -1
3055                 reshow_diff
3056         }}
3057 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3058 $ctxm add command \
3059         -label {Show More Context} \
3060         -font font_ui \
3061         -command {
3062                 incr repo_config(gui.diffcontext)
3063                 reshow_diff
3064         }
3065 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3066 $ctxm add separator
3067 $ctxm add command -label {Options...} \
3068         -font font_ui \
3069         -command do_options
3070 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3071
3072 # -- Status Bar
3073 #
3074 set ui_status_value {Initializing...}
3075 label .status -textvariable ui_status_value \
3076         -anchor w \
3077         -justify left \
3078         -borderwidth 1 \
3079         -relief sunken \
3080         -font font_ui
3081 pack .status -anchor w -side bottom -fill x
3082
3083 # -- Load geometry
3084 #
3085 catch {
3086 set gm $repo_config(gui.geometry)
3087 wm geometry . [lindex $gm 0]
3088 .vpane sash place 0 \
3089         [lindex [.vpane sash coord 0] 0] \
3090         [lindex $gm 1]
3091 .vpane.files sash place 0 \
3092         [lindex $gm 2] \
3093         [lindex [.vpane.files sash coord 0] 1]
3094 unset gm
3095 }
3096
3097 # -- Key Bindings
3098 #
3099 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3100 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3101 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3102 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3103 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3104 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3105 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3106 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3107 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3108 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3109 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3110
3111 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3112 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3113 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3114 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3115 bind $ui_diff <$M1B-Key-v> {break}
3116 bind $ui_diff <$M1B-Key-V> {break}
3117 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3118 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3119 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3120 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3121 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3122 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3123
3124 bind .   <Destroy> do_quit
3125 bind all <Key-F5> do_rescan
3126 bind all <$M1B-Key-r> do_rescan
3127 bind all <$M1B-Key-R> do_rescan
3128 bind .   <$M1B-Key-s> do_signoff
3129 bind .   <$M1B-Key-S> do_signoff
3130 bind .   <$M1B-Key-i> do_include_all
3131 bind .   <$M1B-Key-I> do_include_all
3132 bind .   <$M1B-Key-Return> do_commit
3133 bind all <$M1B-Key-q> do_quit
3134 bind all <$M1B-Key-Q> do_quit
3135 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3136 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3137 foreach i [list $ui_index $ui_other] {
3138         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3139         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3140         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3141 }
3142 unset i
3143
3144 set file_lists($ui_index) [list]
3145 set file_lists($ui_other) [list]
3146
3147 set HEAD {}
3148 set PARENT {}
3149 set commit_type {}
3150 set empty_tree {}
3151 set current_diff {}
3152 set selected_commit_type new
3153
3154 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3155 focus -force $ui_comm
3156 if {!$single_commit} {
3157         load_all_remotes
3158         populate_fetch_menu .mbar.fetch
3159         populate_pull_menu .mbar.pull
3160         populate_push_menu .mbar.push
3161 }
3162 lock_index begin-read
3163 after 1 do_rescan