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                 {UM i merge    "Merge conflicts"}
1680                 {U_ i merge    "Merge conflicts"}
1681         } {
1682         if {$max_status_desc < [string length [lindex $i 3]]} {
1683                 set max_status_desc [string length [lindex $i 3]]
1684         }
1685         if {[lindex $i 1] eq {i}} {
1686                 set all_cols([lindex $i 0]) $ui_index
1687         } else {
1688                 set all_cols([lindex $i 0]) $ui_other
1689         }
1690         set all_icons([lindex $i 0]) file_[lindex $i 2]
1691         set all_descs([lindex $i 0]) [lindex $i 3]
1692 }
1693 unset filemask i
1694
1695 ######################################################################
1696 ##
1697 ## util
1698
1699 proc is_MacOSX {} {
1700         global tcl_platform tk_library
1701         if {$tcl_platform(platform) eq {unix}
1702                 && $tcl_platform(os) eq {Darwin}
1703                 && [string match /Library/Frameworks/* $tk_library]} {
1704                 return 1
1705         }
1706         return 0
1707 }
1708
1709 proc bind_button3 {w cmd} {
1710         bind $w <Any-Button-3> $cmd
1711         if {[is_MacOSX]} {
1712                 bind $w <Control-Button-1> $cmd
1713         }
1714 }
1715
1716 proc incr_font_size {font {amt 1}} {
1717         set sz [font configure $font -size]
1718         incr sz $amt
1719         font configure $font -size $sz
1720         font configure ${font}bold -size $sz
1721 }
1722
1723 proc hook_failed_popup {hook msg} {
1724         global gitdir appname
1725
1726         set w .hookfail
1727         toplevel $w
1728
1729         frame $w.m
1730         label $w.m.l1 -text "$hook hook failed:" \
1731                 -anchor w \
1732                 -justify left \
1733                 -font font_uibold
1734         text $w.m.t \
1735                 -background white -borderwidth 1 \
1736                 -relief sunken \
1737                 -width 80 -height 10 \
1738                 -font font_diff \
1739                 -yscrollcommand [list $w.m.sby set]
1740         label $w.m.l2 \
1741                 -text {You must correct the above errors before committing.} \
1742                 -anchor w \
1743                 -justify left \
1744                 -font font_uibold
1745         scrollbar $w.m.sby -command [list $w.m.t yview]
1746         pack $w.m.l1 -side top -fill x
1747         pack $w.m.l2 -side bottom -fill x
1748         pack $w.m.sby -side right -fill y
1749         pack $w.m.t -side left -fill both -expand 1
1750         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1751
1752         $w.m.t insert 1.0 $msg
1753         $w.m.t conf -state disabled
1754
1755         button $w.ok -text OK \
1756                 -width 15 \
1757                 -font font_ui \
1758                 -command "destroy $w"
1759         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1760
1761         bind $w <Visibility> "grab $w; focus $w"
1762         bind $w <Key-Return> "destroy $w"
1763         wm title $w "$appname ([lindex [file split \
1764                 [file normalize [file dirname $gitdir]]] \
1765                 end]): error"
1766         tkwait window $w
1767 }
1768
1769 set next_console_id 0
1770
1771 proc new_console {short_title long_title} {
1772         global next_console_id console_data
1773         set w .console[incr next_console_id]
1774         set console_data($w) [list $short_title $long_title]
1775         return [console_init $w]
1776 }
1777
1778 proc console_init {w} {
1779         global console_cr console_data
1780         global gitdir appname M1B
1781
1782         set console_cr($w) 1.0
1783         toplevel $w
1784         frame $w.m
1785         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1786                 -anchor w \
1787                 -justify left \
1788                 -font font_uibold
1789         text $w.m.t \
1790                 -background white -borderwidth 1 \
1791                 -relief sunken \
1792                 -width 80 -height 10 \
1793                 -font font_diff \
1794                 -state disabled \
1795                 -yscrollcommand [list $w.m.sby set]
1796         label $w.m.s -text {Working... please wait...} \
1797                 -anchor w \
1798                 -justify left \
1799                 -font font_uibold
1800         scrollbar $w.m.sby -command [list $w.m.t yview]
1801         pack $w.m.l1 -side top -fill x
1802         pack $w.m.s -side bottom -fill x
1803         pack $w.m.sby -side right -fill y
1804         pack $w.m.t -side left -fill both -expand 1
1805         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1806
1807         menu $w.ctxm -tearoff 0
1808         $w.ctxm add command -label "Copy" \
1809                 -font font_ui \
1810                 -command "tk_textCopy $w.m.t"
1811         $w.ctxm add command -label "Select All" \
1812                 -font font_ui \
1813                 -command "$w.m.t tag add sel 0.0 end"
1814         $w.ctxm add command -label "Copy All" \
1815                 -font font_ui \
1816                 -command "
1817                         $w.m.t tag add sel 0.0 end
1818                         tk_textCopy $w.m.t
1819                         $w.m.t tag remove sel 0.0 end
1820                 "
1821
1822         button $w.ok -text {Close} \
1823                 -font font_ui \
1824                 -state disabled \
1825                 -command "destroy $w"
1826         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1827
1828         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1829         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1830         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1831         bind $w <Visibility> "focus $w"
1832         wm title $w "$appname ([lindex [file split \
1833                 [file normalize [file dirname $gitdir]]] \
1834                 end]): [lindex $console_data($w) 0]"
1835         return $w
1836 }
1837
1838 proc console_exec {w cmd {after {}}} {
1839         global tcl_platform
1840
1841         # -- Windows tosses the enviroment when we exec our child.
1842         #    But most users need that so we have to relogin. :-(
1843         #
1844         if {$tcl_platform(platform) eq {windows}} {
1845                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1846         }
1847
1848         # -- Tcl won't let us redirect both stdout and stderr to
1849         #    the same pipe.  So pass it through cat...
1850         #
1851         set cmd [concat | $cmd |& cat]
1852
1853         set fd_f [open $cmd r]
1854         fconfigure $fd_f -blocking 0 -translation binary
1855         fileevent $fd_f readable [list console_read $w $fd_f $after]
1856 }
1857
1858 proc console_read {w fd after} {
1859         global console_cr console_data
1860
1861         set buf [read $fd]
1862         if {$buf ne {}} {
1863                 if {![winfo exists $w]} {console_init $w}
1864                 $w.m.t conf -state normal
1865                 set c 0
1866                 set n [string length $buf]
1867                 while {$c < $n} {
1868                         set cr [string first "\r" $buf $c]
1869                         set lf [string first "\n" $buf $c]
1870                         if {$cr < 0} {set cr [expr {$n + 1}]}
1871                         if {$lf < 0} {set lf [expr {$n + 1}]}
1872
1873                         if {$lf < $cr} {
1874                                 $w.m.t insert end [string range $buf $c $lf]
1875                                 set console_cr($w) [$w.m.t index {end -1c}]
1876                                 set c $lf
1877                                 incr c
1878                         } else {
1879                                 $w.m.t delete $console_cr($w) end
1880                                 $w.m.t insert end "\n"
1881                                 $w.m.t insert end [string range $buf $c $cr]
1882                                 set c $cr
1883                                 incr c
1884                         }
1885                 }
1886                 $w.m.t conf -state disabled
1887                 $w.m.t see end
1888         }
1889
1890         fconfigure $fd -blocking 1
1891         if {[eof $fd]} {
1892                 if {[catch {close $fd}]} {
1893                         if {![winfo exists $w]} {console_init $w}
1894                         $w.m.s conf -background red -text {Error: Command Failed}
1895                         $w.ok conf -state normal
1896                         set ok 0
1897                 } elseif {[winfo exists $w]} {
1898                         $w.m.s conf -background green -text {Success}
1899                         $w.ok conf -state normal
1900                         set ok 1
1901                 }
1902                 array unset console_cr $w
1903                 array unset console_data $w
1904                 if {$after ne {}} {
1905                         uplevel #0 $after $ok
1906                 }
1907                 return
1908         }
1909         fconfigure $fd -blocking 0
1910 }
1911
1912 ######################################################################
1913 ##
1914 ## ui commands
1915
1916 set starting_gitk_msg {Please wait... Starting gitk...}
1917
1918 proc do_gitk {} {
1919         global tcl_platform ui_status_value starting_gitk_msg
1920
1921         set ui_status_value $starting_gitk_msg
1922         after 10000 {
1923                 if {$ui_status_value eq $starting_gitk_msg} {
1924                         set ui_status_value {Ready.}
1925                 }
1926         }
1927
1928         if {$tcl_platform(platform) eq {windows}} {
1929                 exec sh -c gitk &
1930         } else {
1931                 exec gitk &
1932         }
1933 }
1934
1935 proc do_repack {} {
1936         set w [new_console "repack" "Repacking the object database"]
1937         set cmd [list git repack]
1938         lappend cmd -a
1939         lappend cmd -d
1940         console_exec $w $cmd
1941 }
1942
1943 set is_quitting 0
1944
1945 proc do_quit {} {
1946         global gitdir ui_comm is_quitting repo_config
1947
1948         if {$is_quitting} return
1949         set is_quitting 1
1950
1951         # -- Stash our current commit buffer.
1952         #
1953         set save [file join $gitdir GITGUI_MSG]
1954         set msg [string trim [$ui_comm get 0.0 end]]
1955         if {[$ui_comm edit modified] && $msg ne {}} {
1956                 catch {
1957                         set fd [open $save w]
1958                         puts $fd [string trim [$ui_comm get 0.0 end]]
1959                         close $fd
1960                 }
1961         } elseif {$msg eq {} && [file exists $save]} {
1962                 file delete $save
1963         }
1964
1965         # -- Stash our current window geometry into this repository.
1966         #
1967         set cfg_geometry [list]
1968         lappend cfg_geometry [wm geometry .]
1969         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1970         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1971         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1972                 set rc_geometry {}
1973         }
1974         if {$cfg_geometry ne $rc_geometry} {
1975                 catch {exec git repo-config gui.geometry $cfg_geometry}
1976         }
1977
1978         destroy .
1979 }
1980
1981 proc do_rescan {} {
1982         rescan {set ui_status_value {Ready.}}
1983 }
1984
1985 proc remove_helper {txt paths} {
1986         global file_states current_diff
1987
1988         if {![lock_index begin-update]} return
1989
1990         set pathList [list]
1991         set after {}
1992         foreach path $paths {
1993                 switch -glob -- [lindex $file_states($path) 0] {
1994                 A? -
1995                 M? -
1996                 D? {
1997                         lappend pathList $path
1998                         if {$path eq $current_diff} {
1999                                 set after {reshow_diff;}
2000                         }
2001                 }
2002                 }
2003         }
2004         if {$pathList eq {}} {
2005                 unlock_index
2006         } else {
2007                 update_indexinfo \
2008                         $txt \
2009                         $pathList \
2010                         [concat $after {set ui_status_value {Ready.}}]
2011         }
2012 }
2013
2014 proc do_remove_selection {} {
2015         global current_diff selected_paths
2016
2017         if {[array size selected_paths] > 0} {
2018                 remove_helper \
2019                         {Removing selected files from commit} \
2020                         [array names selected_paths]
2021         } elseif {$current_diff ne {}} {
2022                 remove_helper \
2023                         "Removing [short_path $current_diff] from commit" \
2024                         [list $current_diff]
2025         }
2026 }
2027
2028 proc include_helper {txt paths} {
2029         global file_states current_diff
2030
2031         if {![lock_index begin-update]} return
2032
2033         set pathList [list]
2034         set after {}
2035         foreach path $paths {
2036                 switch -- [lindex $file_states($path) 0] {
2037                 AM -
2038                 AD -
2039                 MM -
2040                 UM -
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                 D_ {
2441                         update_indexinfo \
2442                                 "Removing [short_path $path] from commit" \
2443                                 [list $path] \
2444                                 [concat $after {set ui_status_value {Ready.}}]
2445                 }
2446                 ?? {
2447                         update_index \
2448                                 "Including [short_path $path]" \
2449                                 [list $path] \
2450                                 [concat $after {set ui_status_value {Ready.}}]
2451                 }
2452                 }
2453         } else {
2454                 show_diff $path $w $lno
2455         }
2456 }
2457
2458 proc add_one_to_selection {w x y} {
2459         global file_lists
2460         global last_clicked selected_paths
2461
2462         set pos [split [$w index @$x,$y] .]
2463         set lno [lindex $pos 0]
2464         set col [lindex $pos 1]
2465         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2466         if {$path eq {}} {
2467                 set last_clicked {}
2468                 return
2469         }
2470
2471         set last_clicked [list $w $lno]
2472         if {[catch {set in_sel $selected_paths($path)}]} {
2473                 set in_sel 0
2474         }
2475         if {$in_sel} {
2476                 unset selected_paths($path)
2477                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2478         } else {
2479                 set selected_paths($path) 1
2480                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2481         }
2482 }
2483
2484 proc add_range_to_selection {w x y} {
2485         global file_lists
2486         global last_clicked selected_paths
2487
2488         if {[lindex $last_clicked 0] ne $w} {
2489                 toggle_or_diff $w $x $y
2490                 return
2491         }
2492
2493         set pos [split [$w index @$x,$y] .]
2494         set lno [lindex $pos 0]
2495         set lc [lindex $last_clicked 1]
2496         if {$lc < $lno} {
2497                 set begin $lc
2498                 set end $lno
2499         } else {
2500                 set begin $lno
2501                 set end $lc
2502         }
2503
2504         foreach path [lrange $file_lists($w) \
2505                 [expr {$begin - 1}] \
2506                 [expr {$end - 1}]] {
2507                 set selected_paths($path) 1
2508         }
2509         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2510 }
2511
2512 ######################################################################
2513 ##
2514 ## config defaults
2515
2516 set cursor_ptr arrow
2517 font create font_diff -family Courier -size 10
2518 font create font_ui
2519 catch {
2520         label .dummy
2521         eval font configure font_ui [font actual [.dummy cget -font]]
2522         destroy .dummy
2523 }
2524
2525 font create font_uibold
2526 font create font_diffbold
2527
2528 set M1B M1
2529 set M1T M1
2530 if {$tcl_platform(platform) eq {windows}} {
2531         set M1B Control
2532         set M1T Ctrl
2533 } elseif {[is_MacOSX]} {
2534         set M1B M1
2535         set M1T Cmd
2536 }
2537
2538 proc apply_config {} {
2539         global repo_config font_descs
2540
2541         foreach option $font_descs {
2542                 set name [lindex $option 0]
2543                 set font [lindex $option 1]
2544                 if {[catch {
2545                         foreach {cn cv} $repo_config(gui.$name) {
2546                                 font configure $font $cn $cv
2547                         }
2548                         } err]} {
2549                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2550                 }
2551                 foreach {cn cv} [font configure $font] {
2552                         font configure ${font}bold $cn $cv
2553                 }
2554                 font configure ${font}bold -weight bold
2555         }
2556 }
2557
2558 set default_config(gui.trustmtime) false
2559 set default_config(gui.pullsummary) true
2560 set default_config(gui.partialinclude) false
2561 set default_config(gui.diffcontext) 5
2562 set default_config(gui.fontui) [font configure font_ui]
2563 set default_config(gui.fontdiff) [font configure font_diff]
2564 set font_descs {
2565         {fontui   font_ui   {Main Font}}
2566         {fontdiff font_diff {Diff/Console Font}}
2567 }
2568 load_config 0
2569 apply_config
2570
2571 ######################################################################
2572 ##
2573 ## ui construction
2574
2575 # -- Menu Bar
2576 #
2577 menu .mbar -tearoff 0
2578 .mbar add cascade -label Project -menu .mbar.project
2579 .mbar add cascade -label Edit -menu .mbar.edit
2580 .mbar add cascade -label Commit -menu .mbar.commit
2581 if {!$single_commit} {
2582         .mbar add cascade -label Fetch -menu .mbar.fetch
2583         .mbar add cascade -label Pull -menu .mbar.pull
2584         .mbar add cascade -label Push -menu .mbar.push
2585 }
2586 . configure -menu .mbar
2587
2588 # -- Project Menu
2589 #
2590 menu .mbar.project
2591 .mbar.project add command -label Visualize \
2592         -command do_gitk \
2593         -font font_ui
2594 if {!$single_commit} {
2595         .mbar.project add command -label {Repack Database} \
2596                 -command do_repack \
2597                 -font font_ui
2598
2599         if {$tcl_platform(platform) eq {windows}} {
2600                 .mbar.project add command \
2601                         -label {Create Desktop Icon} \
2602                         -command do_windows_shortcut \
2603                         -font font_ui
2604         } elseif {[is_MacOSX]} {
2605                 .mbar.project add command \
2606                         -label {Create Desktop Icon} \
2607                         -command do_macosx_app \
2608                         -font font_ui
2609         }
2610 }
2611 .mbar.project add command -label Quit \
2612         -command do_quit \
2613         -accelerator $M1T-Q \
2614         -font font_ui
2615
2616 # -- Edit Menu
2617 #
2618 menu .mbar.edit
2619 .mbar.edit add command -label Undo \
2620         -command {catch {[focus] edit undo}} \
2621         -accelerator $M1T-Z \
2622         -font font_ui
2623 .mbar.edit add command -label Redo \
2624         -command {catch {[focus] edit redo}} \
2625         -accelerator $M1T-Y \
2626         -font font_ui
2627 .mbar.edit add separator
2628 .mbar.edit add command -label Cut \
2629         -command {catch {tk_textCut [focus]}} \
2630         -accelerator $M1T-X \
2631         -font font_ui
2632 .mbar.edit add command -label Copy \
2633         -command {catch {tk_textCopy [focus]}} \
2634         -accelerator $M1T-C \
2635         -font font_ui
2636 .mbar.edit add command -label Paste \
2637         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2638         -accelerator $M1T-V \
2639         -font font_ui
2640 .mbar.edit add command -label Delete \
2641         -command {catch {[focus] delete sel.first sel.last}} \
2642         -accelerator Del \
2643         -font font_ui
2644 .mbar.edit add separator
2645 .mbar.edit add command -label {Select All} \
2646         -command {catch {[focus] tag add sel 0.0 end}} \
2647         -accelerator $M1T-A \
2648         -font font_ui
2649 .mbar.edit add separator
2650 .mbar.edit add command -label {Options...} \
2651         -command do_options \
2652         -font font_ui
2653
2654 # -- Commit Menu
2655 #
2656 menu .mbar.commit
2657
2658 .mbar.commit add radiobutton \
2659         -label {New Commit} \
2660         -command do_select_commit_type \
2661         -variable selected_commit_type \
2662         -value new \
2663         -font font_ui
2664 lappend disable_on_lock \
2665         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2666
2667 .mbar.commit add radiobutton \
2668         -label {Amend Last Commit} \
2669         -command do_select_commit_type \
2670         -variable selected_commit_type \
2671         -value amend \
2672         -font font_ui
2673 lappend disable_on_lock \
2674         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2675
2676 .mbar.commit add separator
2677
2678 .mbar.commit add command -label Rescan \
2679         -command do_rescan \
2680         -accelerator F5 \
2681         -font font_ui
2682 lappend disable_on_lock \
2683         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2684
2685 .mbar.commit add command -label {Remove From Commit} \
2686         -command do_remove_selection \
2687         -font font_ui
2688 lappend disable_on_lock \
2689         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2690
2691 .mbar.commit add command -label {Include In Commit} \
2692         -command do_include_selection \
2693         -font font_ui
2694 lappend disable_on_lock \
2695         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696
2697 .mbar.commit add command -label {Include All} \
2698         -command do_include_all \
2699         -accelerator $M1T-I \
2700         -font font_ui
2701 lappend disable_on_lock \
2702         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2703
2704 .mbar.commit add separator
2705
2706 .mbar.commit add command -label {Sign Off} \
2707         -command do_signoff \
2708         -accelerator $M1T-S \
2709         -font font_ui
2710
2711 .mbar.commit add command -label Commit \
2712         -command do_commit \
2713         -accelerator $M1T-Return \
2714         -font font_ui
2715 lappend disable_on_lock \
2716         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2717
2718 # -- Transport menus
2719 #
2720 if {!$single_commit} {
2721         menu .mbar.fetch
2722         menu .mbar.pull
2723         menu .mbar.push
2724 }
2725
2726 # -- Main Window Layout
2727 #
2728 panedwindow .vpane -orient vertical
2729 panedwindow .vpane.files -orient horizontal
2730 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2731 pack .vpane -anchor n -side top -fill both -expand 1
2732
2733 # -- Index File List
2734 #
2735 frame .vpane.files.index -height 100 -width 400
2736 label .vpane.files.index.title -text {Modified Files} \
2737         -background green \
2738         -font font_ui
2739 text $ui_index -background white -borderwidth 0 \
2740         -width 40 -height 10 \
2741         -font font_ui \
2742         -cursor $cursor_ptr \
2743         -yscrollcommand {.vpane.files.index.sb set} \
2744         -state disabled
2745 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2746 pack .vpane.files.index.title -side top -fill x
2747 pack .vpane.files.index.sb -side right -fill y
2748 pack $ui_index -side left -fill both -expand 1
2749 .vpane.files add .vpane.files.index -sticky nsew
2750
2751 # -- Other (Add) File List
2752 #
2753 frame .vpane.files.other -height 100 -width 100
2754 label .vpane.files.other.title -text {Untracked Files} \
2755         -background red \
2756         -font font_ui
2757 text $ui_other -background white -borderwidth 0 \
2758         -width 40 -height 10 \
2759         -font font_ui \
2760         -cursor $cursor_ptr \
2761         -yscrollcommand {.vpane.files.other.sb set} \
2762         -state disabled
2763 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2764 pack .vpane.files.other.title -side top -fill x
2765 pack .vpane.files.other.sb -side right -fill y
2766 pack $ui_other -side left -fill both -expand 1
2767 .vpane.files add .vpane.files.other -sticky nsew
2768
2769 foreach i [list $ui_index $ui_other] {
2770         $i tag conf in_diff -font font_uibold
2771         $i tag conf in_sel \
2772                 -background [$i cget -foreground] \
2773                 -foreground [$i cget -background]
2774 }
2775 unset i
2776
2777 # -- Diff and Commit Area
2778 #
2779 frame .vpane.lower -height 300 -width 400
2780 frame .vpane.lower.commarea
2781 frame .vpane.lower.diff -relief sunken -borderwidth 1
2782 pack .vpane.lower.commarea -side top -fill x
2783 pack .vpane.lower.diff -side bottom -fill both -expand 1
2784 .vpane add .vpane.lower -stick nsew
2785
2786 # -- Commit Area Buttons
2787 #
2788 frame .vpane.lower.commarea.buttons
2789 label .vpane.lower.commarea.buttons.l -text {} \
2790         -anchor w \
2791         -justify left \
2792         -font font_ui
2793 pack .vpane.lower.commarea.buttons.l -side top -fill x
2794 pack .vpane.lower.commarea.buttons -side left -fill y
2795
2796 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2797         -command do_rescan \
2798         -font font_ui
2799 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2800 lappend disable_on_lock \
2801         {.vpane.lower.commarea.buttons.rescan conf -state}
2802
2803 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2804         -command do_include_all \
2805         -font font_ui
2806 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2807 lappend disable_on_lock \
2808         {.vpane.lower.commarea.buttons.incall conf -state}
2809
2810 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2811         -command do_signoff \
2812         -font font_ui
2813 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2814
2815 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2816         -command do_commit \
2817         -font font_ui
2818 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2819 lappend disable_on_lock \
2820         {.vpane.lower.commarea.buttons.commit conf -state}
2821
2822 # -- Commit Message Buffer
2823 #
2824 frame .vpane.lower.commarea.buffer
2825 frame .vpane.lower.commarea.buffer.header
2826 set ui_comm .vpane.lower.commarea.buffer.t
2827 set ui_coml .vpane.lower.commarea.buffer.header.l
2828 radiobutton .vpane.lower.commarea.buffer.header.new \
2829         -text {New Commit} \
2830         -command do_select_commit_type \
2831         -variable selected_commit_type \
2832         -value new \
2833         -font font_ui
2834 lappend disable_on_lock \
2835         [list .vpane.lower.commarea.buffer.header.new conf -state]
2836 radiobutton .vpane.lower.commarea.buffer.header.amend \
2837         -text {Amend Last Commit} \
2838         -command do_select_commit_type \
2839         -variable selected_commit_type \
2840         -value amend \
2841         -font font_ui
2842 lappend disable_on_lock \
2843         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2844 label $ui_coml \
2845         -anchor w \
2846         -justify left \
2847         -font font_ui
2848 proc trace_commit_type {varname args} {
2849         global ui_coml commit_type
2850         switch -glob -- $commit_type {
2851         initial       {set txt {Initial Commit Message:}}
2852         amend         {set txt {Amended Commit Message:}}
2853         amend-initial {set txt {Amended Initial Commit Message:}}
2854         merge         {set txt {Merge Commit Message:}}
2855         *             {set txt {Commit Message:}}
2856         }
2857         $ui_coml conf -text $txt
2858 }
2859 trace add variable commit_type write trace_commit_type
2860 pack $ui_coml -side left -fill x
2861 pack .vpane.lower.commarea.buffer.header.amend -side right
2862 pack .vpane.lower.commarea.buffer.header.new -side right
2863
2864 text $ui_comm -background white -borderwidth 1 \
2865         -undo true \
2866         -maxundo 20 \
2867         -autoseparators true \
2868         -relief sunken \
2869         -width 75 -height 9 -wrap none \
2870         -font font_diff \
2871         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2872 scrollbar .vpane.lower.commarea.buffer.sby \
2873         -command [list $ui_comm yview]
2874 pack .vpane.lower.commarea.buffer.header -side top -fill x
2875 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2876 pack $ui_comm -side left -fill y
2877 pack .vpane.lower.commarea.buffer -side left -fill y
2878
2879 # -- Commit Message Buffer Context Menu
2880 #
2881 set ctxm .vpane.lower.commarea.buffer.ctxm
2882 menu $ctxm -tearoff 0
2883 $ctxm add command \
2884         -label {Cut} \
2885         -font font_ui \
2886         -command {tk_textCut $ui_comm}
2887 $ctxm add command \
2888         -label {Copy} \
2889         -font font_ui \
2890         -command {tk_textCopy $ui_comm}
2891 $ctxm add command \
2892         -label {Paste} \
2893         -font font_ui \
2894         -command {tk_textPaste $ui_comm}
2895 $ctxm add command \
2896         -label {Delete} \
2897         -font font_ui \
2898         -command {$ui_comm delete sel.first sel.last}
2899 $ctxm add separator
2900 $ctxm add command \
2901         -label {Select All} \
2902         -font font_ui \
2903         -command {$ui_comm tag add sel 0.0 end}
2904 $ctxm add command \
2905         -label {Copy All} \
2906         -font font_ui \
2907         -command {
2908                 $ui_comm tag add sel 0.0 end
2909                 tk_textCopy $ui_comm
2910                 $ui_comm tag remove sel 0.0 end
2911         }
2912 $ctxm add separator
2913 $ctxm add command \
2914         -label {Sign Off} \
2915         -font font_ui \
2916         -command do_signoff
2917 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2918
2919 # -- Diff Header
2920 #
2921 set current_diff {}
2922 set diff_actions [list]
2923 proc trace_current_diff {varname args} {
2924         global current_diff diff_actions file_states
2925         if {$current_diff eq {}} {
2926                 set s {}
2927                 set f {}
2928                 set p {}
2929                 set o disabled
2930         } else {
2931                 set p $current_diff
2932                 set s [mapdesc [lindex $file_states($p) 0] $p]
2933                 set f {File:}
2934                 set p [escape_path $p]
2935                 set o normal
2936         }
2937
2938         .vpane.lower.diff.header.status configure -text $s
2939         .vpane.lower.diff.header.file configure -text $f
2940         .vpane.lower.diff.header.path configure -text $p
2941         foreach w $diff_actions {
2942                 uplevel #0 $w $o
2943         }
2944 }
2945 trace add variable current_diff write trace_current_diff
2946
2947 frame .vpane.lower.diff.header -background orange
2948 label .vpane.lower.diff.header.status \
2949         -background orange \
2950         -width $max_status_desc \
2951         -anchor w \
2952         -justify left \
2953         -font font_ui
2954 label .vpane.lower.diff.header.file \
2955         -background orange \
2956         -anchor w \
2957         -justify left \
2958         -font font_ui
2959 label .vpane.lower.diff.header.path \
2960         -background orange \
2961         -anchor w \
2962         -justify left \
2963         -font font_ui
2964 pack .vpane.lower.diff.header.status -side left
2965 pack .vpane.lower.diff.header.file -side left
2966 pack .vpane.lower.diff.header.path -fill x
2967 set ctxm .vpane.lower.diff.header.ctxm
2968 menu $ctxm -tearoff 0
2969 $ctxm add command \
2970         -label {Copy} \
2971         -font font_ui \
2972         -command {
2973                 clipboard clear
2974                 clipboard append \
2975                         -format STRING \
2976                         -type STRING \
2977                         -- $current_diff
2978         }
2979 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2980 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2981
2982 # -- Diff Body
2983 #
2984 frame .vpane.lower.diff.body
2985 set ui_diff .vpane.lower.diff.body.t
2986 text $ui_diff -background white -borderwidth 0 \
2987         -width 80 -height 15 -wrap none \
2988         -font font_diff \
2989         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2990         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2991         -state disabled
2992 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2993         -command [list $ui_diff xview]
2994 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2995         -command [list $ui_diff yview]
2996 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2997 pack .vpane.lower.diff.body.sby -side right -fill y
2998 pack $ui_diff -side left -fill both -expand 1
2999 pack .vpane.lower.diff.header -side top -fill x
3000 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3001
3002 $ui_diff tag conf d_@ -font font_diffbold
3003 $ui_diff tag conf d_+  -foreground blue
3004 $ui_diff tag conf d_-  -foreground red
3005 $ui_diff tag conf d_++ -foreground {#00a000}
3006 $ui_diff tag conf d_-- -foreground {#a000a0}
3007 $ui_diff tag conf d_+- \
3008         -foreground red \
3009         -background {light goldenrod yellow}
3010 $ui_diff tag conf d_-+ \
3011         -foreground blue \
3012         -background azure2
3013
3014 # -- Diff Body Context Menu
3015 #
3016 set ctxm .vpane.lower.diff.body.ctxm
3017 menu $ctxm -tearoff 0
3018 $ctxm add command \
3019         -label {Copy} \
3020         -font font_ui \
3021         -command {tk_textCopy $ui_diff}
3022 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3023 $ctxm add command \
3024         -label {Select All} \
3025         -font font_ui \
3026         -command {$ui_diff tag add sel 0.0 end}
3027 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3028 $ctxm add command \
3029         -label {Copy All} \
3030         -font font_ui \
3031         -command {
3032                 $ui_diff tag add sel 0.0 end
3033                 tk_textCopy $ui_diff
3034                 $ui_diff tag remove sel 0.0 end
3035         }
3036 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3037 $ctxm add separator
3038 $ctxm add command \
3039         -label {Decrease Font Size} \
3040         -font font_ui \
3041         -command {incr_font_size font_diff -1}
3042 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3043 $ctxm add command \
3044         -label {Increase Font Size} \
3045         -font font_ui \
3046         -command {incr_font_size font_diff 1}
3047 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3048 $ctxm add separator
3049 $ctxm add command \
3050         -label {Show Less Context} \
3051         -font font_ui \
3052         -command {if {$repo_config(gui.diffcontext) >= 2} {
3053                 incr repo_config(gui.diffcontext) -1
3054                 reshow_diff
3055         }}
3056 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3057 $ctxm add command \
3058         -label {Show More Context} \
3059         -font font_ui \
3060         -command {
3061                 incr repo_config(gui.diffcontext)
3062                 reshow_diff
3063         }
3064 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3065 $ctxm add separator
3066 $ctxm add command -label {Options...} \
3067         -font font_ui \
3068         -command do_options
3069 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3070
3071 # -- Status Bar
3072 #
3073 set ui_status_value {Initializing...}
3074 label .status -textvariable ui_status_value \
3075         -anchor w \
3076         -justify left \
3077         -borderwidth 1 \
3078         -relief sunken \
3079         -font font_ui
3080 pack .status -anchor w -side bottom -fill x
3081
3082 # -- Load geometry
3083 #
3084 catch {
3085 set gm $repo_config(gui.geometry)
3086 wm geometry . [lindex $gm 0]
3087 .vpane sash place 0 \
3088         [lindex [.vpane sash coord 0] 0] \
3089         [lindex $gm 1]
3090 .vpane.files sash place 0 \
3091         [lindex $gm 2] \
3092         [lindex [.vpane.files sash coord 0] 1]
3093 unset gm
3094 }
3095
3096 # -- Key Bindings
3097 #
3098 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3099 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3100 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3101 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3102 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3103 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3104 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3105 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3106 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3107 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3108 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3109
3110 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3111 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3112 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3113 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3114 bind $ui_diff <$M1B-Key-v> {break}
3115 bind $ui_diff <$M1B-Key-V> {break}
3116 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3117 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3118 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3119 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3120 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3121 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3122
3123 bind .   <Destroy> do_quit
3124 bind all <Key-F5> do_rescan
3125 bind all <$M1B-Key-r> do_rescan
3126 bind all <$M1B-Key-R> do_rescan
3127 bind .   <$M1B-Key-s> do_signoff
3128 bind .   <$M1B-Key-S> do_signoff
3129 bind .   <$M1B-Key-i> do_include_all
3130 bind .   <$M1B-Key-I> do_include_all
3131 bind .   <$M1B-Key-Return> do_commit
3132 bind all <$M1B-Key-q> do_quit
3133 bind all <$M1B-Key-Q> do_quit
3134 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3135 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3136 foreach i [list $ui_index $ui_other] {
3137         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3138         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3139         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3140 }
3141 unset i
3142
3143 set file_lists($ui_index) [list]
3144 set file_lists($ui_other) [list]
3145
3146 set HEAD {}
3147 set PARENT {}
3148 set commit_type {}
3149 set empty_tree {}
3150 set current_diff {}
3151 set selected_commit_type new
3152
3153 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3154 focus -force $ui_comm
3155 if {!$single_commit} {
3156         load_all_remotes
3157         populate_fetch_menu .mbar.fetch
3158         populate_pull_menu .mbar.pull
3159         populate_push_menu .mbar.push
3160 }
3161 lock_index begin-read
3162 after 1 do_rescan