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