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