git-gui.sh

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