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