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