git-gui

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