git-gui

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