git-gui.sh

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