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