git-gui.sh

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