git-gui

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