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                 info_popup {Last scanned state does not match repository state.
1126
1127 Another Git program has modified this repository
1128 since the last scan.  A rescan must be performed
1129 before a pull operation can be started.
1130
1131 The rescan will be automatically started now.
1132 }
1133                 unlock_index
1134                 rescan {set ui_status_value {Ready.}}
1135                 return
1136         }
1137
1138         # -- No differences should exist before a pull.
1139         #
1140         if {[array size file_states] != 0} {
1141                 error_popup {Uncommitted but modified files are present.
1142
1143 You should not perform a pull with unmodified
1144 files in your working directory as Git will be
1145 unable to recover from an incorrect merge.
1146
1147 You should commit or revert all changes before
1148 starting a pull operation.
1149 }
1150                 unlock_index
1151                 return
1152         }
1153
1154         set w [new_console "pull $remote $branch" \
1155                 "Pulling new changes from branch $branch in $remote"]
1156         set cmd [list git pull]
1157         if {$repo_config(gui.pullsummary) eq {false}} {
1158                 lappend cmd --no-summary
1159         }
1160         lappend cmd $remote
1161         lappend cmd $branch
1162         console_exec $w $cmd [list post_pull_remote $remote $branch]
1163 }
1164
1165 proc post_pull_remote {remote branch success} {
1166         global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1167         global ui_status_value
1168
1169         unlock_index
1170         if {$success} {
1171                 repository_state commit_type HEAD MERGE_HEAD
1172                 set PARENT $HEAD
1173                 set selected_commit_type new
1174                 set ui_status_value "Pulling $branch from $remote complete."
1175         } else {
1176                 rescan [list set ui_status_value \
1177                         "Conflicts detected while pulling $branch from $remote."]
1178         }
1179 }
1180
1181 proc push_to {remote} {
1182         set w [new_console "push $remote" \
1183                 "Pushing changes to $remote"]
1184         set cmd [list git push]
1185         lappend cmd $remote
1186         console_exec $w $cmd
1187 }
1188
1189 ######################################################################
1190 ##
1191 ## ui helpers
1192
1193 proc mapcol {state path} {
1194         global all_cols ui_other
1195
1196         if {[catch {set r $all_cols($state)}]} {
1197                 puts "error: no column for state={$state} $path"
1198                 return $ui_other
1199         }
1200         return $r
1201 }
1202
1203 proc mapicon {state path} {
1204         global all_icons
1205
1206         if {[catch {set r $all_icons($state)}]} {
1207                 puts "error: no icon for state={$state} $path"
1208                 return file_plain
1209         }
1210         return $r
1211 }
1212
1213 proc mapdesc {state path} {
1214         global all_descs
1215
1216         if {[catch {set r $all_descs($state)}]} {
1217                 puts "error: no desc for state={$state} $path"
1218                 return $state
1219         }
1220         return $r
1221 }
1222
1223 proc escape_path {path} {
1224         regsub -all "\n" $path "\\n" path
1225         return $path
1226 }
1227
1228 proc short_path {path} {
1229         return [escape_path [lindex [file split $path] end]]
1230 }
1231
1232 set next_icon_id 0
1233 set null_sha1 [string repeat 0 40]
1234
1235 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1236         global file_states next_icon_id null_sha1
1237
1238         set s0 [string index $new_state 0]
1239         set s1 [string index $new_state 1]
1240
1241         if {[catch {set info $file_states($path)}]} {
1242                 set state __
1243                 set icon n[incr next_icon_id]
1244         } else {
1245                 set state [lindex $info 0]
1246                 set icon [lindex $info 1]
1247                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1248                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1249         }
1250
1251         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1252         elseif {$s0 eq {_}} {set s0 _}
1253
1254         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1255         elseif {$s1 eq {_}} {set s1 _}
1256
1257         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1258                 set head_info [list 0 $null_sha1]
1259         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1260                 && $head_info eq {}} {
1261                 set head_info $index_info
1262         }
1263
1264         set file_states($path) [list $s0$s1 $icon \
1265                 $head_info $index_info \
1266                 ]
1267         return $state
1268 }
1269
1270 proc display_file {path state} {
1271         global file_states file_lists selected_paths
1272
1273         set old_m [merge_state $path $state]
1274         set s $file_states($path)
1275         set new_m [lindex $s 0]
1276         set new_w [mapcol $new_m $path]
1277         set old_w [mapcol $old_m $path]
1278         set new_icon [mapicon $new_m $path]
1279
1280         if {$new_w ne $old_w} {
1281                 set lno [lsearch -sorted $file_lists($old_w) $path]
1282                 if {$lno >= 0} {
1283                         incr lno
1284                         $old_w conf -state normal
1285                         $old_w delete $lno.0 [expr {$lno + 1}].0
1286                         $old_w conf -state disabled
1287                 }
1288
1289                 lappend file_lists($new_w) $path
1290                 set file_lists($new_w) [lsort $file_lists($new_w)]
1291                 set lno [lsearch -sorted $file_lists($new_w) $path]
1292                 incr lno
1293                 $new_w conf -state normal
1294                 $new_w image create $lno.0 \
1295                         -align center -padx 5 -pady 1 \
1296                         -name [lindex $s 1] \
1297                         -image $new_icon
1298                 $new_w insert $lno.1 "[escape_path $path]\n"
1299                 if {[catch {set in_sel $selected_paths($path)}]} {
1300                         set in_sel 0
1301                 }
1302                 if {$in_sel} {
1303                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1304                 }
1305                 $new_w conf -state disabled
1306         } elseif {$new_icon ne [mapicon $old_m $path]} {
1307                 $new_w conf -state normal
1308                 $new_w image conf [lindex $s 1] -image $new_icon
1309                 $new_w conf -state disabled
1310         }
1311 }
1312
1313 proc display_all_files {} {
1314         global ui_index ui_other
1315         global file_states file_lists
1316         global last_clicked selected_paths
1317
1318         $ui_index conf -state normal
1319         $ui_other conf -state normal
1320
1321         $ui_index delete 0.0 end
1322         $ui_other delete 0.0 end
1323         set last_clicked {}
1324
1325         set file_lists($ui_index) [list]
1326         set file_lists($ui_other) [list]
1327
1328         foreach path [lsort [array names file_states]] {
1329                 set s $file_states($path)
1330                 set m [lindex $s 0]
1331                 set w [mapcol $m $path]
1332                 lappend file_lists($w) $path
1333                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1334                 $w image create end \
1335                         -align center -padx 5 -pady 1 \
1336                         -name [lindex $s 1] \
1337                         -image [mapicon $m $path]
1338                 $w insert end "[escape_path $path]\n"
1339                 if {[catch {set in_sel $selected_paths($path)}]} {
1340                         set in_sel 0
1341                 }
1342                 if {$in_sel} {
1343                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1344                 }
1345         }
1346
1347         $ui_index conf -state disabled
1348         $ui_other conf -state disabled
1349 }
1350
1351 proc update_indexinfo {msg pathList after} {
1352         global update_index_cp ui_status_value
1353
1354         if {![lock_index update]} return
1355
1356         set update_index_cp 0
1357         set pathList [lsort $pathList]
1358         set totalCnt [llength $pathList]
1359         set batch [expr {int($totalCnt * .01) + 1}]
1360         if {$batch > 25} {set batch 25}
1361
1362         set ui_status_value [format \
1363                 "$msg... %i/%i files (%.2f%%)" \
1364                 $update_index_cp \
1365                 $totalCnt \
1366                 0.0]
1367         set fd [open "| git update-index -z --index-info" w]
1368         fconfigure $fd \
1369                 -blocking 0 \
1370                 -buffering full \
1371                 -buffersize 512 \
1372                 -translation binary
1373         fileevent $fd writable [list \
1374                 write_update_indexinfo \
1375                 $fd \
1376                 $pathList \
1377                 $totalCnt \
1378                 $batch \
1379                 $msg \
1380                 $after \
1381                 ]
1382 }
1383
1384 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1385         global update_index_cp ui_status_value
1386         global file_states current_diff
1387
1388         if {$update_index_cp >= $totalCnt} {
1389                 close $fd
1390                 unlock_index
1391                 uplevel #0 $after
1392                 return
1393         }
1394
1395         for {set i $batch} \
1396                 {$update_index_cp < $totalCnt && $i > 0} \
1397                 {incr i -1} {
1398                 set path [lindex $pathList $update_index_cp]
1399                 incr update_index_cp
1400
1401                 set s $file_states($path)
1402                 switch -glob -- [lindex $s 0] {
1403                 A? {set new _O}
1404                 M? {set new _M}
1405                 D? {set new _?}
1406                 ?? {continue}
1407                 }
1408                 set info [lindex $s 2]
1409                 if {$info eq {}} continue
1410
1411                 puts -nonewline $fd $info
1412                 puts -nonewline $fd "\t"
1413                 puts -nonewline $fd $path
1414                 puts -nonewline $fd "\0"
1415                 display_file $path $new
1416         }
1417
1418         set ui_status_value [format \
1419                 "$msg... %i/%i files (%.2f%%)" \
1420                 $update_index_cp \
1421                 $totalCnt \
1422                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1423 }
1424
1425 proc update_index {msg pathList after} {
1426         global update_index_cp ui_status_value
1427
1428         if {![lock_index update]} return
1429
1430         set update_index_cp 0
1431         set pathList [lsort $pathList]
1432         set totalCnt [llength $pathList]
1433         set batch [expr {int($totalCnt * .01) + 1}]
1434         if {$batch > 25} {set batch 25}
1435
1436         set ui_status_value [format \
1437                 "$msg... %i/%i files (%.2f%%)" \
1438                 $update_index_cp \
1439                 $totalCnt \
1440                 0.0]
1441         set fd [open "| git update-index --add --remove -z --stdin" w]
1442         fconfigure $fd \
1443                 -blocking 0 \
1444                 -buffering full \
1445                 -buffersize 512 \
1446                 -translation binary
1447         fileevent $fd writable [list \
1448                 write_update_index \
1449                 $fd \
1450                 $pathList \
1451                 $totalCnt \
1452                 $batch \
1453                 $msg \
1454                 $after \
1455                 ]
1456 }
1457
1458 proc write_update_index {fd pathList totalCnt batch msg after} {
1459         global update_index_cp ui_status_value
1460         global file_states current_diff
1461
1462         if {$update_index_cp >= $totalCnt} {
1463                 close $fd
1464                 unlock_index
1465                 uplevel #0 $after
1466                 return
1467         }
1468
1469         for {set i $batch} \
1470                 {$update_index_cp < $totalCnt && $i > 0} \
1471                 {incr i -1} {
1472                 set path [lindex $pathList $update_index_cp]
1473                 incr update_index_cp
1474
1475                 switch -glob -- [lindex $file_states($path) 0] {
1476                 AD -
1477                 MD -
1478                 _D {set new DD}
1479
1480                 _M -
1481                 MM -
1482                 M_ {set new M_}
1483
1484                 _O -
1485                 AM -
1486                 A_ {set new A_}
1487
1488                 ?? {continue}
1489                 }
1490
1491                 puts -nonewline $fd $path
1492                 puts -nonewline $fd "\0"
1493                 display_file $path $new
1494         }
1495
1496         set ui_status_value [format \
1497                 "$msg... %i/%i files (%.2f%%)" \
1498                 $update_index_cp \
1499                 $totalCnt \
1500                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1501 }
1502
1503 ######################################################################
1504 ##
1505 ## remote management
1506
1507 proc load_all_remotes {} {
1508         global gitdir all_remotes repo_config
1509
1510         set all_remotes [list]
1511         set rm_dir [file join $gitdir remotes]
1512         if {[file isdirectory $rm_dir]} {
1513                 set all_remotes [concat $all_remotes [glob \
1514                         -types f \
1515                         -tails \
1516                         -nocomplain \
1517                         -directory $rm_dir *]]
1518         }
1519
1520         foreach line [array names repo_config remote.*.url] {
1521                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1522                         lappend all_remotes $name
1523                 }
1524         }
1525
1526         set all_remotes [lsort -unique $all_remotes]
1527 }
1528
1529 proc populate_fetch_menu {m} {
1530         global gitdir all_remotes repo_config
1531
1532         foreach r $all_remotes {
1533                 set enable 0
1534                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1535                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1536                                 set enable 1
1537                         }
1538                 } else {
1539                         catch {
1540                                 set fd [open [file join $gitdir remotes $r] r]
1541                                 while {[gets $fd n] >= 0} {
1542                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1543                                                 set enable 1
1544                                                 break
1545                                         }
1546                                 }
1547                                 close $fd
1548                         }
1549                 }
1550
1551                 if {$enable} {
1552                         $m add command \
1553                                 -label "Fetch from $r..." \
1554                                 -command [list fetch_from $r] \
1555                                 -font font_ui
1556                 }
1557         }
1558 }
1559
1560 proc populate_push_menu {m} {
1561         global gitdir all_remotes repo_config
1562
1563         foreach r $all_remotes {
1564                 set enable 0
1565                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1566                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1567                                 set enable 1
1568                         }
1569                 } else {
1570                         catch {
1571                                 set fd [open [file join $gitdir remotes $r] r]
1572                                 while {[gets $fd n] >= 0} {
1573                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1574                                                 set enable 1
1575                                                 break
1576                                         }
1577                                 }
1578                                 close $fd
1579                         }
1580                 }
1581
1582                 if {$enable} {
1583                         $m add command \
1584                                 -label "Push to $r..." \
1585                                 -command [list push_to $r] \
1586                                 -font font_ui
1587                 }
1588         }
1589 }
1590
1591 proc populate_pull_menu {m} {
1592         global gitdir repo_config all_remotes disable_on_lock
1593
1594         foreach remote $all_remotes {
1595                 set rb {}
1596                 if {[array get repo_config remote.$remote.url] ne {}} {
1597                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1598                                 regexp {^([^:]+):} \
1599                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1600                                         line rb
1601                         }
1602                 } else {
1603                         catch {
1604                                 set fd [open [file join $gitdir remotes $remote] r]
1605                                 while {[gets $fd line] >= 0} {
1606                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1607                                                 break
1608                                         }
1609                                 }
1610                                 close $fd
1611                         }
1612                 }
1613
1614                 set rb_short $rb
1615                 regsub ^refs/heads/ $rb {} rb_short
1616                 if {$rb_short ne {}} {
1617                         $m add command \
1618                                 -label "Branch $rb_short from $remote..." \
1619                                 -command [list pull_remote $remote $rb] \
1620                                 -font font_ui
1621                         lappend disable_on_lock \
1622                                 [list $m entryconf [$m index last] -state]
1623                 }
1624         }
1625 }
1626
1627 ######################################################################
1628 ##
1629 ## icons
1630
1631 set filemask {
1632 #define mask_width 14
1633 #define mask_height 15
1634 static unsigned char mask_bits[] = {
1635    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1636    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1637    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1638 }
1639
1640 image create bitmap file_plain -background white -foreground black -data {
1641 #define plain_width 14
1642 #define plain_height 15
1643 static unsigned char plain_bits[] = {
1644    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1645    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1646    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1647 } -maskdata $filemask
1648
1649 image create bitmap file_mod -background white -foreground blue -data {
1650 #define mod_width 14
1651 #define mod_height 15
1652 static unsigned char mod_bits[] = {
1653    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1654    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1655    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1656 } -maskdata $filemask
1657
1658 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1659 #define file_fulltick_width 14
1660 #define file_fulltick_height 15
1661 static unsigned char file_fulltick_bits[] = {
1662    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1663    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1664    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1665 } -maskdata $filemask
1666
1667 image create bitmap file_parttick -background white -foreground "#005050" -data {
1668 #define parttick_width 14
1669 #define parttick_height 15
1670 static unsigned char parttick_bits[] = {
1671    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1672    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1673    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1674 } -maskdata $filemask
1675
1676 image create bitmap file_question -background white -foreground black -data {
1677 #define file_question_width 14
1678 #define file_question_height 15
1679 static unsigned char file_question_bits[] = {
1680    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1681    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1682    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1683 } -maskdata $filemask
1684
1685 image create bitmap file_removed -background white -foreground red -data {
1686 #define file_removed_width 14
1687 #define file_removed_height 15
1688 static unsigned char file_removed_bits[] = {
1689    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1690    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1691    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1692 } -maskdata $filemask
1693
1694 image create bitmap file_merge -background white -foreground blue -data {
1695 #define file_merge_width 14
1696 #define file_merge_height 15
1697 static unsigned char file_merge_bits[] = {
1698    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1699    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1700    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1701 } -maskdata $filemask
1702
1703 set ui_index .vpane.files.index.list
1704 set ui_other .vpane.files.other.list
1705 set max_status_desc 0
1706 foreach i {
1707                 {__ i plain    "Unmodified"}
1708                 {_M i mod      "Modified"}
1709                 {M_ i fulltick "Included in commit"}
1710                 {MM i parttick "Partially included"}
1711
1712                 {_O o plain    "Untracked"}
1713                 {A_ o fulltick "Added by commit"}
1714                 {AM o parttick "Partially added"}
1715                 {AD o question "Added (but now gone)"}
1716
1717                 {_D i question "Missing"}
1718                 {DD i removed  "Removed by commit"}
1719                 {DO i removed  "Removed (still exists)"}
1720                 {DM i removed  "Removed (but modified)"}
1721
1722                 {UD i merge    "Merge conflicts"}
1723                 {UM i merge    "Merge conflicts"}
1724                 {U_ i merge    "Merge conflicts"}
1725         } {
1726         if {$max_status_desc < [string length [lindex $i 3]]} {
1727                 set max_status_desc [string length [lindex $i 3]]
1728         }
1729         if {[lindex $i 1] eq {i}} {
1730                 set all_cols([lindex $i 0]) $ui_index
1731         } else {
1732                 set all_cols([lindex $i 0]) $ui_other
1733         }
1734         set all_icons([lindex $i 0]) file_[lindex $i 2]
1735         set all_descs([lindex $i 0]) [lindex $i 3]
1736 }
1737 unset filemask i
1738
1739 ######################################################################
1740 ##
1741 ## util
1742
1743 proc is_MacOSX {} {
1744         global tcl_platform tk_library
1745         if {[tk windowingsystem] eq {aqua}} {
1746                 return 1
1747         }
1748         return 0
1749 }
1750
1751 proc is_Windows {} {
1752         global tcl_platform
1753         if {$tcl_platform(platform) eq {windows}} {
1754                 return 1
1755         }
1756         return 0
1757 }
1758
1759 proc bind_button3 {w cmd} {
1760         bind $w <Any-Button-3> $cmd
1761         if {[is_MacOSX]} {
1762                 bind $w <Control-Button-1> $cmd
1763         }
1764 }
1765
1766 proc incr_font_size {font {amt 1}} {
1767         set sz [font configure $font -size]
1768         incr sz $amt
1769         font configure $font -size $sz
1770         font configure ${font}bold -size $sz
1771 }
1772
1773 proc hook_failed_popup {hook msg} {
1774         global gitdir appname
1775
1776         set w .hookfail
1777         toplevel $w
1778
1779         frame $w.m
1780         label $w.m.l1 -text "$hook hook failed:" \
1781                 -anchor w \
1782                 -justify left \
1783                 -font font_uibold
1784         text $w.m.t \
1785                 -background white -borderwidth 1 \
1786                 -relief sunken \
1787                 -width 80 -height 10 \
1788                 -font font_diff \
1789                 -yscrollcommand [list $w.m.sby set]
1790         label $w.m.l2 \
1791                 -text {You must correct the above errors before committing.} \
1792                 -anchor w \
1793                 -justify left \
1794                 -font font_uibold
1795         scrollbar $w.m.sby -command [list $w.m.t yview]
1796         pack $w.m.l1 -side top -fill x
1797         pack $w.m.l2 -side bottom -fill x
1798         pack $w.m.sby -side right -fill y
1799         pack $w.m.t -side left -fill both -expand 1
1800         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1801
1802         $w.m.t insert 1.0 $msg
1803         $w.m.t conf -state disabled
1804
1805         button $w.ok -text OK \
1806                 -width 15 \
1807                 -font font_ui \
1808                 -command "destroy $w"
1809         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1810
1811         bind $w <Visibility> "grab $w; focus $w"
1812         bind $w <Key-Return> "destroy $w"
1813         wm title $w "$appname ([lindex [file split \
1814                 [file normalize [file dirname $gitdir]]] \
1815                 end]): error"
1816         tkwait window $w
1817 }
1818
1819 set next_console_id 0
1820
1821 proc new_console {short_title long_title} {
1822         global next_console_id console_data
1823         set w .console[incr next_console_id]
1824         set console_data($w) [list $short_title $long_title]
1825         return [console_init $w]
1826 }
1827
1828 proc console_init {w} {
1829         global console_cr console_data
1830         global gitdir appname M1B
1831
1832         set console_cr($w) 1.0
1833         toplevel $w
1834         frame $w.m
1835         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1836                 -anchor w \
1837                 -justify left \
1838                 -font font_uibold
1839         text $w.m.t \
1840                 -background white -borderwidth 1 \
1841                 -relief sunken \
1842                 -width 80 -height 10 \
1843                 -font font_diff \
1844                 -state disabled \
1845                 -yscrollcommand [list $w.m.sby set]
1846         label $w.m.s -text {Working... please wait...} \
1847                 -anchor w \
1848                 -justify left \
1849                 -font font_uibold
1850         scrollbar $w.m.sby -command [list $w.m.t yview]
1851         pack $w.m.l1 -side top -fill x
1852         pack $w.m.s -side bottom -fill x
1853         pack $w.m.sby -side right -fill y
1854         pack $w.m.t -side left -fill both -expand 1
1855         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1856
1857         menu $w.ctxm -tearoff 0
1858         $w.ctxm add command -label "Copy" \
1859                 -font font_ui \
1860                 -command "tk_textCopy $w.m.t"
1861         $w.ctxm add command -label "Select All" \
1862                 -font font_ui \
1863                 -command "$w.m.t tag add sel 0.0 end"
1864         $w.ctxm add command -label "Copy All" \
1865                 -font font_ui \
1866                 -command "
1867                         $w.m.t tag add sel 0.0 end
1868                         tk_textCopy $w.m.t
1869                         $w.m.t tag remove sel 0.0 end
1870                 "
1871
1872         button $w.ok -text {Close} \
1873                 -font font_ui \
1874                 -state disabled \
1875                 -command "destroy $w"
1876         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1877
1878         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1879         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1880         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1881         bind $w <Visibility> "focus $w"
1882         wm title $w "$appname ([lindex [file split \
1883                 [file normalize [file dirname $gitdir]]] \
1884                 end]): [lindex $console_data($w) 0]"
1885         return $w
1886 }
1887
1888 proc console_exec {w cmd {after {}}} {
1889         # -- Windows tosses the enviroment when we exec our child.
1890         #    But most users need that so we have to relogin. :-(
1891         #
1892         if {[is_Windows]} {
1893                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1894         }
1895
1896         # -- Tcl won't let us redirect both stdout and stderr to
1897         #    the same pipe.  So pass it through cat...
1898         #
1899         set cmd [concat | $cmd |& cat]
1900
1901         set fd_f [open $cmd r]
1902         fconfigure $fd_f -blocking 0 -translation binary
1903         fileevent $fd_f readable [list console_read $w $fd_f $after]
1904 }
1905
1906 proc console_read {w fd after} {
1907         global console_cr console_data
1908
1909         set buf [read $fd]
1910         if {$buf ne {}} {
1911                 if {![winfo exists $w]} {console_init $w}
1912                 $w.m.t conf -state normal
1913                 set c 0
1914                 set n [string length $buf]
1915                 while {$c < $n} {
1916                         set cr [string first "\r" $buf $c]
1917                         set lf [string first "\n" $buf $c]
1918                         if {$cr < 0} {set cr [expr {$n + 1}]}
1919                         if {$lf < 0} {set lf [expr {$n + 1}]}
1920
1921                         if {$lf < $cr} {
1922                                 $w.m.t insert end [string range $buf $c $lf]
1923                                 set console_cr($w) [$w.m.t index {end -1c}]
1924                                 set c $lf
1925                                 incr c
1926                         } else {
1927                                 $w.m.t delete $console_cr($w) end
1928                                 $w.m.t insert end "\n"
1929                                 $w.m.t insert end [string range $buf $c $cr]
1930                                 set c $cr
1931                                 incr c
1932                         }
1933                 }
1934                 $w.m.t conf -state disabled
1935                 $w.m.t see end
1936         }
1937
1938         fconfigure $fd -blocking 1
1939         if {[eof $fd]} {
1940                 if {[catch {close $fd}]} {
1941                         if {![winfo exists $w]} {console_init $w}
1942                         $w.m.s conf -background red -text {Error: Command Failed}
1943                         $w.ok conf -state normal
1944                         set ok 0
1945                 } elseif {[winfo exists $w]} {
1946                         $w.m.s conf -background green -text {Success}
1947                         $w.ok conf -state normal
1948                         set ok 1
1949                 }
1950                 array unset console_cr $w
1951                 array unset console_data $w
1952                 if {$after ne {}} {
1953                         uplevel #0 $after $ok
1954                 }
1955                 return
1956         }
1957         fconfigure $fd -blocking 0
1958 }
1959
1960 ######################################################################
1961 ##
1962 ## ui commands
1963
1964 set starting_gitk_msg {Please wait... Starting gitk...}
1965
1966 proc do_gitk {revs} {
1967         global ui_status_value starting_gitk_msg
1968
1969         set cmd gitk
1970         if {$revs ne {}} {
1971                 append cmd { }
1972                 append cmd $revs
1973         }
1974         if {[is_Windows]} {
1975                 set cmd "sh -c \"exec $cmd\""
1976         }
1977         append cmd { &}
1978
1979         if {[catch {eval exec $cmd} err]} {
1980                 error_popup "Failed to start gitk:\n\n$err"
1981         } else {
1982                 set ui_status_value $starting_gitk_msg
1983                 after 10000 {
1984                         if {$ui_status_value eq $starting_gitk_msg} {
1985                                 set ui_status_value {Ready.}
1986                         }
1987                 }
1988         }
1989 }
1990
1991 proc do_repack {} {
1992         set w [new_console {repack} \
1993                 {Repacking the object database}]
1994         set cmd [list git repack]
1995         lappend cmd -a
1996         lappend cmd -d
1997         console_exec $w $cmd
1998 }
1999
2000 proc do_fsck_objects {} {
2001         set w [new_console {fsck-objects} \
2002                 {Verifying the object database with fsck-objects}]
2003         set cmd [list git fsck-objects]
2004         lappend cmd --full
2005         lappend cmd --cache
2006         lappend cmd --strict
2007         console_exec $w $cmd
2008 }
2009
2010 set is_quitting 0
2011
2012 proc do_quit {} {
2013         global gitdir ui_comm is_quitting repo_config commit_type
2014
2015         if {$is_quitting} return
2016         set is_quitting 1
2017
2018         # -- Stash our current commit buffer.
2019         #
2020         set save [file join $gitdir GITGUI_MSG]
2021         set msg [string trim [$ui_comm get 0.0 end]]
2022         if {![string match amend* $commit_type]
2023                 && [$ui_comm edit modified]
2024                 && $msg ne {}} {
2025                 catch {
2026                         set fd [open $save w]
2027                         puts $fd [string trim [$ui_comm get 0.0 end]]
2028                         close $fd
2029                 }
2030         } else {
2031                 catch {file delete $save}
2032         }
2033
2034         # -- Stash our current window geometry into this repository.
2035         #
2036         set cfg_geometry [list]
2037         lappend cfg_geometry [wm geometry .]
2038         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2039         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2040         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2041                 set rc_geometry {}
2042         }
2043         if {$cfg_geometry ne $rc_geometry} {
2044                 catch {exec git repo-config gui.geometry $cfg_geometry}
2045         }
2046
2047         destroy .
2048 }
2049
2050 proc do_rescan {} {
2051         rescan {set ui_status_value {Ready.}}
2052 }
2053
2054 proc remove_helper {txt paths} {
2055         global file_states current_diff
2056
2057         if {![lock_index begin-update]} return
2058
2059         set pathList [list]
2060         set after {}
2061         foreach path $paths {
2062                 switch -glob -- [lindex $file_states($path) 0] {
2063                 A? -
2064                 M? -
2065                 D? {
2066                         lappend pathList $path
2067                         if {$path eq $current_diff} {
2068                                 set after {reshow_diff;}
2069                         }
2070                 }
2071                 }
2072         }
2073         if {$pathList eq {}} {
2074                 unlock_index
2075         } else {
2076                 update_indexinfo \
2077                         $txt \
2078                         $pathList \
2079                         [concat $after {set ui_status_value {Ready.}}]
2080         }
2081 }
2082
2083 proc do_remove_selection {} {
2084         global current_diff selected_paths
2085
2086         if {[array size selected_paths] > 0} {
2087                 remove_helper \
2088                         {Removing selected files from commit} \
2089                         [array names selected_paths]
2090         } elseif {$current_diff ne {}} {
2091                 remove_helper \
2092                         "Removing [short_path $current_diff] from commit" \
2093                         [list $current_diff]
2094         }
2095 }
2096
2097 proc include_helper {txt paths} {
2098         global file_states current_diff
2099
2100         if {![lock_index begin-update]} return
2101
2102         set pathList [list]
2103         set after {}
2104         foreach path $paths {
2105                 switch -glob -- [lindex $file_states($path) 0] {
2106                 AM -
2107                 AD -
2108                 MM -
2109                 U? -
2110                 _M -
2111                 _D -
2112                 _O {
2113                         lappend pathList $path
2114                         if {$path eq $current_diff} {
2115                                 set after {reshow_diff;}
2116                         }
2117                 }
2118                 }
2119         }
2120         if {$pathList eq {}} {
2121                 unlock_index
2122         } else {
2123                 update_index \
2124                         $txt \
2125                         $pathList \
2126                         [concat $after {set ui_status_value {Ready to commit.}}]
2127         }
2128 }
2129
2130 proc do_include_selection {} {
2131         global current_diff selected_paths
2132
2133         if {[array size selected_paths] > 0} {
2134                 include_helper \
2135                         {Including selected files} \
2136                         [array names selected_paths]
2137         } elseif {$current_diff ne {}} {
2138                 include_helper \
2139                         "Including [short_path $current_diff]" \
2140                         [list $current_diff]
2141         }
2142 }
2143
2144 proc do_include_all {} {
2145         global file_states
2146
2147         set paths [list]
2148         foreach path [array names file_states] {
2149                 switch -- [lindex $file_states($path) 0] {
2150                 AM -
2151                 AD -
2152                 MM -
2153                 _M -
2154                 _D {lappend paths $path}
2155                 }
2156         }
2157         include_helper \
2158                 {Including all modified files} \
2159                 $paths
2160 }
2161
2162 proc do_signoff {} {
2163         global ui_comm
2164
2165         set me [committer_ident]
2166         if {$me eq {}} return
2167
2168         set sob "Signed-off-by: $me"
2169         set last [$ui_comm get {end -1c linestart} {end -1c}]
2170         if {$last ne $sob} {
2171                 $ui_comm edit separator
2172                 if {$last ne {}
2173                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2174                         $ui_comm insert end "\n"
2175                 }
2176                 $ui_comm insert end "\n$sob"
2177                 $ui_comm edit separator
2178                 $ui_comm see end
2179         }
2180 }
2181
2182 proc do_select_commit_type {} {
2183         global commit_type selected_commit_type
2184
2185         if {$selected_commit_type eq {new}
2186                 && [string match amend* $commit_type]} {
2187                 create_new_commit
2188         } elseif {$selected_commit_type eq {amend}
2189                 && ![string match amend* $commit_type]} {
2190                 load_last_commit
2191
2192                 # The amend request was rejected...
2193                 #
2194                 if {![string match amend* $commit_type]} {
2195                         set selected_commit_type new
2196                 }
2197         }
2198 }
2199
2200 proc do_commit {} {
2201         commit_tree
2202 }
2203
2204 proc do_about {} {
2205         global appname copyright
2206         global tcl_patchLevel tk_patchLevel
2207
2208         set w .about_dialog
2209         toplevel $w
2210         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2211
2212         label $w.header -text "About $appname" \
2213                 -font font_uibold
2214         pack $w.header -side top -fill x
2215
2216         frame $w.buttons
2217         button $w.buttons.close -text {Close} \
2218                 -font font_ui \
2219                 -command [list destroy $w]
2220         pack $w.buttons.close -side right
2221         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2222
2223         label $w.desc \
2224                 -text "$appname - a commit creation tool for Git.
2225 $copyright" \
2226                 -padx 5 -pady 5 \
2227                 -justify left \
2228                 -anchor w \
2229                 -borderwidth 1 \
2230                 -relief solid \
2231                 -font font_ui
2232         pack $w.desc -side top -fill x -padx 5 -pady 5
2233
2234         set v [exec git --version]
2235         append v "\n\n"
2236         if {$tcl_patchLevel eq $tk_patchLevel} {
2237                 append v "Tcl/Tk version $tcl_patchLevel"
2238         } else {
2239                 append v "Tcl version $tcl_patchLevel"
2240                 append v ", Tk version $tk_patchLevel"
2241         }
2242
2243         label $w.vers \
2244                 -text $v \
2245                 -padx 5 -pady 5 \
2246                 -justify left \
2247                 -anchor w \
2248                 -borderwidth 1 \
2249                 -relief solid \
2250                 -font font_ui
2251         pack $w.vers -side top -fill x -padx 5 -pady 5
2252
2253         bind $w <Visibility> "grab $w; focus $w"
2254         bind $w <Key-Escape> "destroy $w"
2255         wm title $w "About $appname"
2256         tkwait window $w
2257 }
2258
2259 proc do_options {} {
2260         global appname gitdir font_descs
2261         global repo_config global_config
2262         global repo_config_new global_config_new
2263
2264         array unset repo_config_new
2265         array unset global_config_new
2266         foreach name [array names repo_config] {
2267                 set repo_config_new($name) $repo_config($name)
2268         }
2269         load_config 1
2270         foreach name [array names repo_config] {
2271                 switch -- $name {
2272                 gui.diffcontext {continue}
2273                 }
2274                 set repo_config_new($name) $repo_config($name)
2275         }
2276         foreach name [array names global_config] {
2277                 set global_config_new($name) $global_config($name)
2278         }
2279         set reponame [lindex [file split \
2280                 [file normalize [file dirname $gitdir]]] \
2281                 end]
2282
2283         set w .options_editor
2284         toplevel $w
2285         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2286
2287         label $w.header -text "$appname Options" \
2288                 -font font_uibold
2289         pack $w.header -side top -fill x
2290
2291         frame $w.buttons
2292         button $w.buttons.restore -text {Restore Defaults} \
2293                 -font font_ui \
2294                 -command do_restore_defaults
2295         pack $w.buttons.restore -side left
2296         button $w.buttons.save -text Save \
2297                 -font font_ui \
2298                 -command [list do_save_config $w]
2299         pack $w.buttons.save -side right
2300         button $w.buttons.cancel -text {Cancel} \
2301                 -font font_ui \
2302                 -command [list destroy $w]
2303         pack $w.buttons.cancel -side right
2304         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2305
2306         labelframe $w.repo -text "$reponame Repository" \
2307                 -font font_ui \
2308                 -relief raised -borderwidth 2
2309         labelframe $w.global -text {Global (All Repositories)} \
2310                 -font font_ui \
2311                 -relief raised -borderwidth 2
2312         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2313         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2314
2315         foreach option {
2316                 {b partialinclude {Allow Partially Included Files}}
2317                 {b pullsummary {Show Pull Summary}}
2318                 {b trustmtime  {Trust File Modification Timestamps}}
2319                 {i diffcontext {Number of Diff Context Lines}}
2320                 } {
2321                 set type [lindex $option 0]
2322                 set name [lindex $option 1]
2323                 set text [lindex $option 2]
2324                 foreach f {repo global} {
2325                         switch $type {
2326                         b {
2327                                 checkbutton $w.$f.$name -text $text \
2328                                         -variable ${f}_config_new(gui.$name) \
2329                                         -onvalue true \
2330                                         -offvalue false \
2331                                         -font font_ui
2332                                 pack $w.$f.$name -side top -anchor w
2333                         }
2334                         i {
2335                                 frame $w.$f.$name
2336                                 label $w.$f.$name.l -text "$text:" -font font_ui
2337                                 pack $w.$f.$name.l -side left -anchor w -fill x
2338                                 spinbox $w.$f.$name.v \
2339                                         -textvariable ${f}_config_new(gui.$name) \
2340                                         -from 1 -to 99 -increment 1 \
2341                                         -width 3 \
2342                                         -font font_ui
2343                                 pack $w.$f.$name.v -side right -anchor e
2344                                 pack $w.$f.$name -side top -anchor w -fill x
2345                         }
2346                         }
2347                 }
2348         }
2349
2350         set all_fonts [lsort [font families]]
2351         foreach option $font_descs {
2352                 set name [lindex $option 0]
2353                 set font [lindex $option 1]
2354                 set text [lindex $option 2]
2355
2356                 set global_config_new(gui.$font^^family) \
2357                         [font configure $font -family]
2358                 set global_config_new(gui.$font^^size) \
2359                         [font configure $font -size]
2360
2361                 frame $w.global.$name
2362                 label $w.global.$name.l -text "$text:" -font font_ui
2363                 pack $w.global.$name.l -side left -anchor w -fill x
2364                 eval tk_optionMenu $w.global.$name.family \
2365                         global_config_new(gui.$font^^family) \
2366                         $all_fonts
2367                 spinbox $w.global.$name.size \
2368                         -textvariable global_config_new(gui.$font^^size) \
2369                         -from 2 -to 80 -increment 1 \
2370                         -width 3 \
2371                         -font font_ui
2372                 pack $w.global.$name.size -side right -anchor e
2373                 pack $w.global.$name.family -side right -anchor e
2374                 pack $w.global.$name -side top -anchor w -fill x
2375         }
2376
2377         bind $w <Visibility> "grab $w; focus $w"
2378         bind $w <Key-Escape> "destroy $w"
2379         wm title $w "$appname ($reponame): Options"
2380         tkwait window $w
2381 }
2382
2383 proc do_restore_defaults {} {
2384         global font_descs default_config repo_config
2385         global repo_config_new global_config_new
2386
2387         foreach name [array names default_config] {
2388                 set repo_config_new($name) $default_config($name)
2389                 set global_config_new($name) $default_config($name)
2390         }
2391
2392         foreach option $font_descs {
2393                 set name [lindex $option 0]
2394                 set repo_config(gui.$name) $default_config(gui.$name)
2395         }
2396         apply_config
2397
2398         foreach option $font_descs {
2399                 set name [lindex $option 0]
2400                 set font [lindex $option 1]
2401                 set global_config_new(gui.$font^^family) \
2402                         [font configure $font -family]
2403                 set global_config_new(gui.$font^^size) \
2404                         [font configure $font -size]
2405         }
2406 }
2407
2408 proc do_save_config {w} {
2409         if {[catch {save_config} err]} {
2410                 error_popup "Failed to completely save options:\n\n$err"
2411         }
2412         reshow_diff
2413         destroy $w
2414 }
2415
2416 proc do_windows_shortcut {} {
2417         global gitdir appname argv0
2418
2419         set reponame [lindex [file split \
2420                 [file normalize [file dirname $gitdir]]] \
2421                 end]
2422
2423         if {[catch {
2424                 set desktop [exec cygpath \
2425                         --windows \
2426                         --absolute \
2427                         --long-name \
2428                         --desktop]
2429                 }]} {
2430                         set desktop .
2431         }
2432         set fn [tk_getSaveFile \
2433                 -parent . \
2434                 -title "$appname ($reponame): Create Desktop Icon" \
2435                 -initialdir $desktop \
2436                 -initialfile "Git $reponame.bat"]
2437         if {$fn != {}} {
2438                 if {[catch {
2439                                 set fd [open $fn w]
2440                                 set sh [exec cygpath \
2441                                         --windows \
2442                                         --absolute \
2443                                         --long-name \
2444                                         /bin/sh]
2445                                 set me [exec cygpath \
2446                                         --unix \
2447                                         --absolute \
2448                                         $argv0]
2449                                 set gd [exec cygpath \
2450                                         --unix \
2451                                         --absolute \
2452                                         $gitdir]
2453                                 regsub -all ' $me "'\\''" me
2454                                 regsub -all ' $gd "'\\''" gd
2455                                 puts -nonewline $fd "\"$sh\" --login -c \""
2456                                 puts -nonewline $fd "GIT_DIR='$gd'"
2457                                 puts -nonewline $fd " '$me'"
2458                                 puts $fd "&\""
2459                                 close $fd
2460                         } err]} {
2461                         error_popup "Cannot write script:\n\n$err"
2462                 }
2463         }
2464 }
2465
2466 proc do_macosx_app {} {
2467         global gitdir appname argv0 env
2468
2469         set reponame [lindex [file split \
2470                 [file normalize [file dirname $gitdir]]] \
2471                 end]
2472
2473         set fn [tk_getSaveFile \
2474                 -parent . \
2475                 -title "$appname ($reponame): Create Desktop Icon" \
2476                 -initialdir [file join $env(HOME) Desktop] \
2477                 -initialfile "Git $reponame.app"]
2478         if {$fn != {}} {
2479                 if {[catch {
2480                                 set Contents [file join $fn Contents]
2481                                 set MacOS [file join $Contents MacOS]
2482                                 set exe [file join $MacOS git-gui]
2483
2484                                 file mkdir $MacOS
2485
2486                                 set fd [open [file join $Contents Info.plist] w]
2487                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2488 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2489 <plist version="1.0">
2490 <dict>
2491         <key>CFBundleDevelopmentRegion</key>
2492         <string>English</string>
2493         <key>CFBundleExecutable</key>
2494         <string>git-gui</string>
2495         <key>CFBundleIdentifier</key>
2496         <string>org.spearce.git-gui</string>
2497         <key>CFBundleInfoDictionaryVersion</key>
2498         <string>6.0</string>
2499         <key>CFBundlePackageType</key>
2500         <string>APPL</string>
2501         <key>CFBundleSignature</key>
2502         <string>????</string>
2503         <key>CFBundleVersion</key>
2504         <string>1.0</string>
2505         <key>NSPrincipalClass</key>
2506         <string>NSApplication</string>
2507 </dict>
2508 </plist>}
2509                                 close $fd
2510
2511                                 set fd [open $exe w]
2512                                 set gd [file normalize $gitdir]
2513                                 set ep [file normalize [exec git --exec-path]]
2514                                 regsub -all ' $gd "'\\''" gd
2515                                 regsub -all ' $ep "'\\''" ep
2516                                 puts $fd "#!/bin/sh"
2517                                 foreach name [array names env] {
2518                                         if {[string match GIT_* $name]} {
2519                                                 regsub -all ' $env($name) "'\\''" v
2520                                                 puts $fd "export $name='$v'"
2521                                         }
2522                                 }
2523                                 puts $fd "export PATH='$ep':\$PATH"
2524                                 puts $fd "export GIT_DIR='$gd'"
2525                                 puts $fd "exec [file normalize $argv0]"
2526                                 close $fd
2527
2528                                 file attributes $exe -permissions u+x,g+x,o+x
2529                         } err]} {
2530                         error_popup "Cannot write icon:\n\n$err"
2531                 }
2532         }
2533 }
2534
2535 proc toggle_or_diff {w x y} {
2536         global file_states file_lists current_diff ui_index ui_other
2537         global last_clicked selected_paths
2538
2539         set pos [split [$w index @$x,$y] .]
2540         set lno [lindex $pos 0]
2541         set col [lindex $pos 1]
2542         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2543         if {$path eq {}} {
2544                 set last_clicked {}
2545                 return
2546         }
2547
2548         set last_clicked [list $w $lno]
2549         array unset selected_paths
2550         $ui_index tag remove in_sel 0.0 end
2551         $ui_other tag remove in_sel 0.0 end
2552
2553         if {$col == 0} {
2554                 if {$current_diff eq $path} {
2555                         set after {reshow_diff;}
2556                 } else {
2557                         set after {}
2558                 }
2559                 switch -glob -- [lindex $file_states($path) 0] {
2560                 A_ -
2561                 M_ -
2562                 DD -
2563                 DO -
2564                 DM {
2565                         update_indexinfo \
2566                                 "Removing [short_path $path] from commit" \
2567                                 [list $path] \
2568                                 [concat $after {set ui_status_value {Ready.}}]
2569                 }
2570                 ?? {
2571                         update_index \
2572                                 "Including [short_path $path]" \
2573                                 [list $path] \
2574                                 [concat $after {set ui_status_value {Ready.}}]
2575                 }
2576                 }
2577         } else {
2578                 show_diff $path $w $lno
2579         }
2580 }
2581
2582 proc add_one_to_selection {w x y} {
2583         global file_lists
2584         global last_clicked selected_paths
2585
2586         set pos [split [$w index @$x,$y] .]
2587         set lno [lindex $pos 0]
2588         set col [lindex $pos 1]
2589         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2590         if {$path eq {}} {
2591                 set last_clicked {}
2592                 return
2593         }
2594
2595         set last_clicked [list $w $lno]
2596         if {[catch {set in_sel $selected_paths($path)}]} {
2597                 set in_sel 0
2598         }
2599         if {$in_sel} {
2600                 unset selected_paths($path)
2601                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2602         } else {
2603                 set selected_paths($path) 1
2604                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2605         }
2606 }
2607
2608 proc add_range_to_selection {w x y} {
2609         global file_lists
2610         global last_clicked selected_paths
2611
2612         if {[lindex $last_clicked 0] ne $w} {
2613                 toggle_or_diff $w $x $y
2614                 return
2615         }
2616
2617         set pos [split [$w index @$x,$y] .]
2618         set lno [lindex $pos 0]
2619         set lc [lindex $last_clicked 1]
2620         if {$lc < $lno} {
2621                 set begin $lc
2622                 set end $lno
2623         } else {
2624                 set begin $lno
2625                 set end $lc
2626         }
2627
2628         foreach path [lrange $file_lists($w) \
2629                 [expr {$begin - 1}] \
2630                 [expr {$end - 1}]] {
2631                 set selected_paths($path) 1
2632         }
2633         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2634 }
2635
2636 ######################################################################
2637 ##
2638 ## config defaults
2639
2640 set cursor_ptr arrow
2641 font create font_diff -family Courier -size 10
2642 font create font_ui
2643 catch {
2644         label .dummy
2645         eval font configure font_ui [font actual [.dummy cget -font]]
2646         destroy .dummy
2647 }
2648
2649 font create font_uibold
2650 font create font_diffbold
2651
2652 if {[is_Windows]} {
2653         set M1B Control
2654         set M1T Ctrl
2655 } elseif {[is_MacOSX]} {
2656         set M1B M1
2657         set M1T Cmd
2658 } else {
2659         set M1B M1
2660         set M1T M1
2661 }
2662
2663 proc apply_config {} {
2664         global repo_config font_descs
2665
2666         foreach option $font_descs {
2667                 set name [lindex $option 0]
2668                 set font [lindex $option 1]
2669                 if {[catch {
2670                         foreach {cn cv} $repo_config(gui.$name) {
2671                                 font configure $font $cn $cv
2672                         }
2673                         } err]} {
2674                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2675                 }
2676                 foreach {cn cv} [font configure $font] {
2677                         font configure ${font}bold $cn $cv
2678                 }
2679                 font configure ${font}bold -weight bold
2680         }
2681 }
2682
2683 set default_config(gui.trustmtime) false
2684 set default_config(gui.pullsummary) true
2685 set default_config(gui.partialinclude) false
2686 set default_config(gui.diffcontext) 5
2687 set default_config(gui.fontui) [font configure font_ui]
2688 set default_config(gui.fontdiff) [font configure font_diff]
2689 set font_descs {
2690         {fontui   font_ui   {Main Font}}
2691         {fontdiff font_diff {Diff/Console Font}}
2692 }
2693 load_config 0
2694 apply_config
2695
2696 ######################################################################
2697 ##
2698 ## ui construction
2699
2700 # -- Menu Bar
2701 #
2702 menu .mbar -tearoff 0
2703 .mbar add cascade -label Repository -menu .mbar.repository
2704 .mbar add cascade -label Edit -menu .mbar.edit
2705 .mbar add cascade -label Commit -menu .mbar.commit
2706 if {!$single_commit} {
2707         .mbar add cascade -label Fetch -menu .mbar.fetch
2708         .mbar add cascade -label Pull -menu .mbar.pull
2709         .mbar add cascade -label Push -menu .mbar.push
2710 }
2711 . configure -menu .mbar
2712
2713 # -- Repository Menu
2714 #
2715 menu .mbar.repository
2716 .mbar.repository add command \
2717         -label {Visualize Current Branch} \
2718         -command {do_gitk {}} \
2719         -font font_ui
2720 if {![is_MacOSX]} {
2721         .mbar.repository add command \
2722                 -label {Visualize All Branches} \
2723                 -command {do_gitk {--all}} \
2724                 -font font_ui
2725 }
2726 .mbar.repository add separator
2727
2728 if {!$single_commit} {
2729         .mbar.repository add command -label {Repack Database} \
2730                 -command do_repack \
2731                 -font font_ui
2732
2733         .mbar.repository add command -label {Verify Database} \
2734                 -command do_fsck_objects \
2735                 -font font_ui
2736
2737         .mbar.repository add separator
2738
2739         if {[is_Windows]} {
2740                 .mbar.repository add command \
2741                         -label {Create Desktop Icon} \
2742                         -command do_windows_shortcut \
2743                         -font font_ui
2744         } elseif {[is_MacOSX]} {
2745                 .mbar.repository add command \
2746                         -label {Create Desktop Icon} \
2747                         -command do_macosx_app \
2748                         -font font_ui
2749         }
2750 }
2751 .mbar.repository add command -label Quit \
2752         -command do_quit \
2753         -accelerator $M1T-Q \
2754         -font font_ui
2755
2756 # -- Edit Menu
2757 #
2758 menu .mbar.edit
2759 .mbar.edit add command -label Undo \
2760         -command {catch {[focus] edit undo}} \
2761         -accelerator $M1T-Z \
2762         -font font_ui
2763 .mbar.edit add command -label Redo \
2764         -command {catch {[focus] edit redo}} \
2765         -accelerator $M1T-Y \
2766         -font font_ui
2767 .mbar.edit add separator
2768 .mbar.edit add command -label Cut \
2769         -command {catch {tk_textCut [focus]}} \
2770         -accelerator $M1T-X \
2771         -font font_ui
2772 .mbar.edit add command -label Copy \
2773         -command {catch {tk_textCopy [focus]}} \
2774         -accelerator $M1T-C \
2775         -font font_ui
2776 .mbar.edit add command -label Paste \
2777         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2778         -accelerator $M1T-V \
2779         -font font_ui
2780 .mbar.edit add command -label Delete \
2781         -command {catch {[focus] delete sel.first sel.last}} \
2782         -accelerator Del \
2783         -font font_ui
2784 .mbar.edit add separator
2785 .mbar.edit add command -label {Select All} \
2786         -command {catch {[focus] tag add sel 0.0 end}} \
2787         -accelerator $M1T-A \
2788         -font font_ui
2789
2790 # -- Commit Menu
2791 #
2792 menu .mbar.commit
2793
2794 .mbar.commit add radiobutton \
2795         -label {New Commit} \
2796         -command do_select_commit_type \
2797         -variable selected_commit_type \
2798         -value new \
2799         -font font_ui
2800 lappend disable_on_lock \
2801         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2802
2803 .mbar.commit add radiobutton \
2804         -label {Amend Last Commit} \
2805         -command do_select_commit_type \
2806         -variable selected_commit_type \
2807         -value amend \
2808         -font font_ui
2809 lappend disable_on_lock \
2810         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2811
2812 .mbar.commit add separator
2813
2814 .mbar.commit add command -label Rescan \
2815         -command do_rescan \
2816         -accelerator F5 \
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 {Remove From Commit} \
2822         -command do_remove_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 In Commit} \
2828         -command do_include_selection \
2829         -font font_ui
2830 lappend disable_on_lock \
2831         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2832
2833 .mbar.commit add command -label {Include All In Commit} \
2834         -command do_include_all \
2835         -accelerator $M1T-I \
2836         -font font_ui
2837 lappend disable_on_lock \
2838         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2839
2840 .mbar.commit add separator
2841
2842 .mbar.commit add command -label {Sign Off} \
2843         -command do_signoff \
2844         -accelerator $M1T-S \
2845         -font font_ui
2846
2847 .mbar.commit add command -label Commit \
2848         -command do_commit \
2849         -accelerator $M1T-Return \
2850         -font font_ui
2851 lappend disable_on_lock \
2852         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2853
2854 # -- Transport menus
2855 #
2856 if {!$single_commit} {
2857         menu .mbar.fetch
2858         menu .mbar.pull
2859         menu .mbar.push
2860 }
2861
2862 if {[is_MacOSX]} {
2863         # -- Apple Menu (Mac OS X only)
2864         #
2865         .mbar add cascade -label Apple -menu .mbar.apple
2866         menu .mbar.apple
2867
2868         .mbar.apple add command -label "About $appname" \
2869                 -command do_about \
2870                 -font font_ui
2871         .mbar.apple add command -label "$appname Options..." \
2872                 -command do_options \
2873                 -font font_ui
2874 } else {
2875         # -- Edit Menu
2876         #
2877         .mbar.edit add separator
2878         .mbar.edit add command -label {Options...} \
2879                 -command do_options \
2880                 -font font_ui
2881
2882         # -- Help Menu
2883         #
2884         .mbar add cascade -label Help -menu .mbar.help
2885         menu .mbar.help
2886
2887         .mbar.help add command -label "About $appname" \
2888                 -command do_about \
2889                 -font font_ui
2890 }
2891
2892
2893 # -- Main Window Layout
2894 #
2895 panedwindow .vpane -orient vertical
2896 panedwindow .vpane.files -orient horizontal
2897 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2898 pack .vpane -anchor n -side top -fill both -expand 1
2899
2900 # -- Index File List
2901 #
2902 frame .vpane.files.index -height 100 -width 400
2903 label .vpane.files.index.title -text {Modified Files} \
2904         -background green \
2905         -font font_ui
2906 text $ui_index -background white -borderwidth 0 \
2907         -width 40 -height 10 \
2908         -font font_ui \
2909         -cursor $cursor_ptr \
2910         -yscrollcommand {.vpane.files.index.sb set} \
2911         -state disabled
2912 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2913 pack .vpane.files.index.title -side top -fill x
2914 pack .vpane.files.index.sb -side right -fill y
2915 pack $ui_index -side left -fill both -expand 1
2916 .vpane.files add .vpane.files.index -sticky nsew
2917
2918 # -- Other (Add) File List
2919 #
2920 frame .vpane.files.other -height 100 -width 100
2921 label .vpane.files.other.title -text {Untracked Files} \
2922         -background red \
2923         -font font_ui
2924 text $ui_other -background white -borderwidth 0 \
2925         -width 40 -height 10 \
2926         -font font_ui \
2927         -cursor $cursor_ptr \
2928         -yscrollcommand {.vpane.files.other.sb set} \
2929         -state disabled
2930 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2931 pack .vpane.files.other.title -side top -fill x
2932 pack .vpane.files.other.sb -side right -fill y
2933 pack $ui_other -side left -fill both -expand 1
2934 .vpane.files add .vpane.files.other -sticky nsew
2935
2936 foreach i [list $ui_index $ui_other] {
2937         $i tag conf in_diff -font font_uibold
2938         $i tag conf in_sel \
2939                 -background [$i cget -foreground] \
2940                 -foreground [$i cget -background]
2941 }
2942 unset i
2943
2944 # -- Diff and Commit Area
2945 #
2946 frame .vpane.lower -height 300 -width 400
2947 frame .vpane.lower.commarea
2948 frame .vpane.lower.diff -relief sunken -borderwidth 1
2949 pack .vpane.lower.commarea -side top -fill x
2950 pack .vpane.lower.diff -side bottom -fill both -expand 1
2951 .vpane add .vpane.lower -stick nsew
2952
2953 # -- Commit Area Buttons
2954 #
2955 frame .vpane.lower.commarea.buttons
2956 label .vpane.lower.commarea.buttons.l -text {} \
2957         -anchor w \
2958         -justify left \
2959         -font font_ui
2960 pack .vpane.lower.commarea.buttons.l -side top -fill x
2961 pack .vpane.lower.commarea.buttons -side left -fill y
2962
2963 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2964         -command do_rescan \
2965         -font font_ui
2966 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2967 lappend disable_on_lock \
2968         {.vpane.lower.commarea.buttons.rescan conf -state}
2969
2970 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2971         -command do_include_all \
2972         -font font_ui
2973 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2974 lappend disable_on_lock \
2975         {.vpane.lower.commarea.buttons.incall conf -state}
2976
2977 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2978         -command do_signoff \
2979         -font font_ui
2980 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2981
2982 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2983         -command do_commit \
2984         -font font_ui
2985 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2986 lappend disable_on_lock \
2987         {.vpane.lower.commarea.buttons.commit conf -state}
2988
2989 # -- Commit Message Buffer
2990 #
2991 frame .vpane.lower.commarea.buffer
2992 frame .vpane.lower.commarea.buffer.header
2993 set ui_comm .vpane.lower.commarea.buffer.t
2994 set ui_coml .vpane.lower.commarea.buffer.header.l
2995 radiobutton .vpane.lower.commarea.buffer.header.new \
2996         -text {New Commit} \
2997         -command do_select_commit_type \
2998         -variable selected_commit_type \
2999         -value new \
3000         -font font_ui
3001 lappend disable_on_lock \
3002         [list .vpane.lower.commarea.buffer.header.new conf -state]
3003 radiobutton .vpane.lower.commarea.buffer.header.amend \
3004         -text {Amend Last Commit} \
3005         -command do_select_commit_type \
3006         -variable selected_commit_type \
3007         -value amend \
3008         -font font_ui
3009 lappend disable_on_lock \
3010         [list .vpane.lower.commarea.buffer.header.amend conf -state]
3011 label $ui_coml \
3012         -anchor w \
3013         -justify left \
3014         -font font_ui
3015 proc trace_commit_type {varname args} {
3016         global ui_coml commit_type
3017         switch -glob -- $commit_type {
3018         initial       {set txt {Initial Commit Message:}}
3019         amend         {set txt {Amended Commit Message:}}
3020         amend-initial {set txt {Amended Initial Commit Message:}}
3021         amend-merge   {set txt {Amended Merge Commit Message:}}
3022         merge         {set txt {Merge Commit Message:}}
3023         *             {set txt {Commit Message:}}
3024         }
3025         $ui_coml conf -text $txt
3026 }
3027 trace add variable commit_type write trace_commit_type
3028 pack $ui_coml -side left -fill x
3029 pack .vpane.lower.commarea.buffer.header.amend -side right
3030 pack .vpane.lower.commarea.buffer.header.new -side right
3031
3032 text $ui_comm -background white -borderwidth 1 \
3033         -undo true \
3034         -maxundo 20 \
3035         -autoseparators true \
3036         -relief sunken \
3037         -width 75 -height 9 -wrap none \
3038         -font font_diff \
3039         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3040 scrollbar .vpane.lower.commarea.buffer.sby \
3041         -command [list $ui_comm yview]
3042 pack .vpane.lower.commarea.buffer.header -side top -fill x
3043 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3044 pack $ui_comm -side left -fill y
3045 pack .vpane.lower.commarea.buffer -side left -fill y
3046
3047 # -- Commit Message Buffer Context Menu
3048 #
3049 set ctxm .vpane.lower.commarea.buffer.ctxm
3050 menu $ctxm -tearoff 0
3051 $ctxm add command \
3052         -label {Cut} \
3053         -font font_ui \
3054         -command {tk_textCut $ui_comm}
3055 $ctxm add command \
3056         -label {Copy} \
3057         -font font_ui \
3058         -command {tk_textCopy $ui_comm}
3059 $ctxm add command \
3060         -label {Paste} \
3061         -font font_ui \
3062         -command {tk_textPaste $ui_comm}
3063 $ctxm add command \
3064         -label {Delete} \
3065         -font font_ui \
3066         -command {$ui_comm delete sel.first sel.last}
3067 $ctxm add separator
3068 $ctxm add command \
3069         -label {Select All} \
3070         -font font_ui \
3071         -command {$ui_comm tag add sel 0.0 end}
3072 $ctxm add command \
3073         -label {Copy All} \
3074         -font font_ui \
3075         -command {
3076                 $ui_comm tag add sel 0.0 end
3077                 tk_textCopy $ui_comm
3078                 $ui_comm tag remove sel 0.0 end
3079         }
3080 $ctxm add separator
3081 $ctxm add command \
3082         -label {Sign Off} \
3083         -font font_ui \
3084         -command do_signoff
3085 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3086
3087 # -- Diff Header
3088 #
3089 set current_diff {}
3090 set diff_actions [list]
3091 proc trace_current_diff {varname args} {
3092         global current_diff diff_actions file_states
3093         if {$current_diff eq {}} {
3094                 set s {}
3095                 set f {}
3096                 set p {}
3097                 set o disabled
3098         } else {
3099                 set p $current_diff
3100                 set s [mapdesc [lindex $file_states($p) 0] $p]
3101                 set f {File:}
3102                 set p [escape_path $p]
3103                 set o normal
3104         }
3105
3106         .vpane.lower.diff.header.status configure -text $s
3107         .vpane.lower.diff.header.file configure -text $f
3108         .vpane.lower.diff.header.path configure -text $p
3109         foreach w $diff_actions {
3110                 uplevel #0 $w $o
3111         }
3112 }
3113 trace add variable current_diff write trace_current_diff
3114
3115 frame .vpane.lower.diff.header -background orange
3116 label .vpane.lower.diff.header.status \
3117         -background orange \
3118         -width $max_status_desc \
3119         -anchor w \
3120         -justify left \
3121         -font font_ui
3122 label .vpane.lower.diff.header.file \
3123         -background orange \
3124         -anchor w \
3125         -justify left \
3126         -font font_ui
3127 label .vpane.lower.diff.header.path \
3128         -background orange \
3129         -anchor w \
3130         -justify left \
3131         -font font_ui
3132 pack .vpane.lower.diff.header.status -side left
3133 pack .vpane.lower.diff.header.file -side left
3134 pack .vpane.lower.diff.header.path -fill x
3135 set ctxm .vpane.lower.diff.header.ctxm
3136 menu $ctxm -tearoff 0
3137 $ctxm add command \
3138         -label {Copy} \
3139         -font font_ui \
3140         -command {
3141                 clipboard clear
3142                 clipboard append \
3143                         -format STRING \
3144                         -type STRING \
3145                         -- $current_diff
3146         }
3147 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3148 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3149
3150 # -- Diff Body
3151 #
3152 frame .vpane.lower.diff.body
3153 set ui_diff .vpane.lower.diff.body.t
3154 text $ui_diff -background white -borderwidth 0 \
3155         -width 80 -height 15 -wrap none \
3156         -font font_diff \
3157         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3158         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3159         -state disabled
3160 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3161         -command [list $ui_diff xview]
3162 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3163         -command [list $ui_diff yview]
3164 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3165 pack .vpane.lower.diff.body.sby -side right -fill y
3166 pack $ui_diff -side left -fill both -expand 1
3167 pack .vpane.lower.diff.header -side top -fill x
3168 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3169
3170 $ui_diff tag conf d_@ -font font_diffbold
3171 $ui_diff tag conf d_+  -foreground blue
3172 $ui_diff tag conf d_-  -foreground red
3173 $ui_diff tag conf d_++ -foreground {#00a000}
3174 $ui_diff tag conf d_-- -foreground {#a000a0}
3175 $ui_diff tag conf d_+- \
3176         -foreground red \
3177         -background {light goldenrod yellow}
3178 $ui_diff tag conf d_-+ \
3179         -foreground blue \
3180         -background azure2
3181
3182 # -- Diff Body Context Menu
3183 #
3184 set ctxm .vpane.lower.diff.body.ctxm
3185 menu $ctxm -tearoff 0
3186 $ctxm add command \
3187         -label {Copy} \
3188         -font font_ui \
3189         -command {tk_textCopy $ui_diff}
3190 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3191 $ctxm add command \
3192         -label {Select All} \
3193         -font font_ui \
3194         -command {$ui_diff tag add sel 0.0 end}
3195 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3196 $ctxm add command \
3197         -label {Copy All} \
3198         -font font_ui \
3199         -command {
3200                 $ui_diff tag add sel 0.0 end
3201                 tk_textCopy $ui_diff
3202                 $ui_diff tag remove sel 0.0 end
3203         }
3204 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3205 $ctxm add separator
3206 $ctxm add command \
3207         -label {Decrease Font Size} \
3208         -font font_ui \
3209         -command {incr_font_size font_diff -1}
3210 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3211 $ctxm add command \
3212         -label {Increase Font Size} \
3213         -font font_ui \
3214         -command {incr_font_size font_diff 1}
3215 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3216 $ctxm add separator
3217 $ctxm add command \
3218         -label {Show Less Context} \
3219         -font font_ui \
3220         -command {if {$repo_config(gui.diffcontext) >= 2} {
3221                 incr repo_config(gui.diffcontext) -1
3222                 reshow_diff
3223         }}
3224 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3225 $ctxm add command \
3226         -label {Show More Context} \
3227         -font font_ui \
3228         -command {
3229                 incr repo_config(gui.diffcontext)
3230                 reshow_diff
3231         }
3232 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3233 $ctxm add separator
3234 $ctxm add command -label {Options...} \
3235         -font font_ui \
3236         -command do_options
3237 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3238
3239 # -- Status Bar
3240 #
3241 set ui_status_value {Initializing...}
3242 label .status -textvariable ui_status_value \
3243         -anchor w \
3244         -justify left \
3245         -borderwidth 1 \
3246         -relief sunken \
3247         -font font_ui
3248 pack .status -anchor w -side bottom -fill x
3249
3250 # -- Load geometry
3251 #
3252 catch {
3253 set gm $repo_config(gui.geometry)
3254 wm geometry . [lindex $gm 0]
3255 .vpane sash place 0 \
3256         [lindex [.vpane sash coord 0] 0] \
3257         [lindex $gm 1]
3258 .vpane.files sash place 0 \
3259         [lindex $gm 2] \
3260         [lindex [.vpane.files sash coord 0] 1]
3261 unset gm
3262 }
3263
3264 # -- Key Bindings
3265 #
3266 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3267 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3268 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3269 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3270 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3271 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3272 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3273 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3274 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3275 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3276 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3277
3278 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3279 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3280 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3281 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3282 bind $ui_diff <$M1B-Key-v> {break}
3283 bind $ui_diff <$M1B-Key-V> {break}
3284 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3285 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3286 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3287 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3288 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3289 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3290
3291 bind .   <Destroy> do_quit
3292 bind all <Key-F5> do_rescan
3293 bind all <$M1B-Key-r> do_rescan
3294 bind all <$M1B-Key-R> do_rescan
3295 bind .   <$M1B-Key-s> do_signoff
3296 bind .   <$M1B-Key-S> do_signoff
3297 bind .   <$M1B-Key-i> do_include_all
3298 bind .   <$M1B-Key-I> do_include_all
3299 bind .   <$M1B-Key-Return> do_commit
3300 bind all <$M1B-Key-q> do_quit
3301 bind all <$M1B-Key-Q> do_quit
3302 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3303 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3304 foreach i [list $ui_index $ui_other] {
3305         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3306         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3307         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3308 }
3309 unset i
3310
3311 set file_lists($ui_index) [list]
3312 set file_lists($ui_other) [list]
3313
3314 set HEAD {}
3315 set PARENT {}
3316 set MERGE_HEAD [list]
3317 set commit_type {}
3318 set empty_tree {}
3319 set current_diff {}
3320 set selected_commit_type new
3321
3322 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3323 focus -force $ui_comm
3324
3325 # -- Warn the user about environmental problems.
3326 #    Cygwin's Tcl does *not* pass its env array
3327 #    onto any processes it spawns.  This means
3328 #    that the git processes get none of our
3329 #    environment.  That may not work...
3330 #
3331 if {[is_Windows]} {
3332         set ignored_env 0
3333         set suggest_user {}
3334         set msg "Possible environment issues exist.
3335
3336 The following environment variables are probably
3337 going to be ignored by any Git subprocess run
3338 by $appname:
3339
3340 "
3341         foreach name [array names env] {
3342                 switch -regexp -- $name {
3343                 {^GIT_INDEX_FILE$} -
3344                 {^GIT_OBJECT_DIRECTORY$} -
3345                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3346                 {^GIT_DIFF_OPTS$} -
3347                 {^GIT_EXTERNAL_DIFF$} -
3348                 {^GIT_PAGER$} -
3349                 {^GIT_TRACE$} -
3350                 {^GIT_CONFIG$} -
3351                 {^GIT_CONFIG_LOCAL$} -
3352                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3353                         append msg " - $name\n"
3354                         incr ignored_env
3355                 }
3356                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3357                         append msg " - $name\n"
3358                         incr ignored_env
3359                         set suggest_user $name
3360                 }
3361                 }
3362         }
3363         if {$ignored_env > 0} {
3364                 append msg "
3365 This is due to a known issue with the
3366 Tcl binary distributed by Cygwin."
3367
3368                 if {$suggest_user ne {}} {
3369                         append msg "
3370
3371 A good replacement for $suggest_user
3372 is placing values for the user.name and
3373 user.email settings into your personal
3374 ~/.gitconfig file.
3375 "
3376                 }
3377                 warn_popup $msg
3378         }
3379         unset ignored_env msg suggest_user name
3380 }
3381
3382 if {!$single_commit} {
3383         load_all_remotes
3384         populate_fetch_menu .mbar.fetch
3385         populate_pull_menu .mbar.pull
3386         populate_push_menu .mbar.push
3387 }
3388 lock_index begin-read
3389 after 1 do_rescan