git-gui.sh

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