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 {@@GITGUI_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\n"
2547         append v "[exec git --version]\n\n"
2548         if {$tcl_patchLevel eq $tk_patchLevel} {
2549                 append v "Tcl/Tk version $tcl_patchLevel"
2550         } else {
2551                 append v "Tcl version $tcl_patchLevel"
2552                 append v ", Tk version $tk_patchLevel"
2553         }
2554
2555         label $w.vers \
2556                 -text $v \
2557                 -padx 5 -pady 5 \
2558                 -justify left \
2559                 -anchor w \
2560                 -borderwidth 1 \
2561                 -relief solid \
2562                 -font font_ui
2563         pack $w.vers -side top -fill x -padx 5 -pady 5
2564
2565         bind $w <Visibility> "grab $w; focus $w"
2566         bind $w <Key-Escape> "destroy $w"
2567         wm title $w "About $appname"
2568         tkwait window $w
2569 }
2570
2571 proc do_options {} {
2572         global appname gitdir font_descs
2573         global repo_config global_config
2574         global repo_config_new global_config_new
2575
2576         array unset repo_config_new
2577         array unset global_config_new
2578         foreach name [array names repo_config] {
2579                 set repo_config_new($name) $repo_config($name)
2580         }
2581         load_config 1
2582         foreach name [array names repo_config] {
2583                 switch -- $name {
2584                 gui.diffcontext {continue}
2585                 }
2586                 set repo_config_new($name) $repo_config($name)
2587         }
2588         foreach name [array names global_config] {
2589                 set global_config_new($name) $global_config($name)
2590         }
2591         set reponame [lindex [file split \
2592                 [file normalize [file dirname $gitdir]]] \
2593                 end]
2594
2595         set w .options_editor
2596         toplevel $w
2597         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2598
2599         label $w.header -text "$appname Options" \
2600                 -font font_uibold
2601         pack $w.header -side top -fill x
2602
2603         frame $w.buttons
2604         button $w.buttons.restore -text {Restore Defaults} \
2605                 -font font_ui \
2606                 -command do_restore_defaults
2607         pack $w.buttons.restore -side left
2608         button $w.buttons.save -text Save \
2609                 -font font_ui \
2610                 -command [list do_save_config $w]
2611         pack $w.buttons.save -side right
2612         button $w.buttons.cancel -text {Cancel} \
2613                 -font font_ui \
2614                 -command [list destroy $w]
2615         pack $w.buttons.cancel -side right
2616         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2617
2618         labelframe $w.repo -text "$reponame Repository" \
2619                 -font font_ui \
2620                 -relief raised -borderwidth 2
2621         labelframe $w.global -text {Global (All Repositories)} \
2622                 -font font_ui \
2623                 -relief raised -borderwidth 2
2624         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2625         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2626
2627         foreach option {
2628                 {b partialinclude {Allow Partially Added Files}}
2629                 {b pullsummary {Show Pull Summary}}
2630                 {b trustmtime  {Trust File Modification Timestamps}}
2631                 {i diffcontext {Number of Diff Context Lines}}
2632                 } {
2633                 set type [lindex $option 0]
2634                 set name [lindex $option 1]
2635                 set text [lindex $option 2]
2636                 foreach f {repo global} {
2637                         switch $type {
2638                         b {
2639                                 checkbutton $w.$f.$name -text $text \
2640                                         -variable ${f}_config_new(gui.$name) \
2641                                         -onvalue true \
2642                                         -offvalue false \
2643                                         -font font_ui
2644                                 pack $w.$f.$name -side top -anchor w
2645                         }
2646                         i {
2647                                 frame $w.$f.$name
2648                                 label $w.$f.$name.l -text "$text:" -font font_ui
2649                                 pack $w.$f.$name.l -side left -anchor w -fill x
2650                                 spinbox $w.$f.$name.v \
2651                                         -textvariable ${f}_config_new(gui.$name) \
2652                                         -from 1 -to 99 -increment 1 \
2653                                         -width 3 \
2654                                         -font font_ui
2655                                 pack $w.$f.$name.v -side right -anchor e
2656                                 pack $w.$f.$name -side top -anchor w -fill x
2657                         }
2658                         }
2659                 }
2660         }
2661
2662         set all_fonts [lsort [font families]]
2663         foreach option $font_descs {
2664                 set name [lindex $option 0]
2665                 set font [lindex $option 1]
2666                 set text [lindex $option 2]
2667
2668                 set global_config_new(gui.$font^^family) \
2669                         [font configure $font -family]
2670                 set global_config_new(gui.$font^^size) \
2671                         [font configure $font -size]
2672
2673                 frame $w.global.$name
2674                 label $w.global.$name.l -text "$text:" -font font_ui
2675                 pack $w.global.$name.l -side left -anchor w -fill x
2676                 eval tk_optionMenu $w.global.$name.family \
2677                         global_config_new(gui.$font^^family) \
2678                         $all_fonts
2679                 spinbox $w.global.$name.size \
2680                         -textvariable global_config_new(gui.$font^^size) \
2681                         -from 2 -to 80 -increment 1 \
2682                         -width 3 \
2683                         -font font_ui
2684                 pack $w.global.$name.size -side right -anchor e
2685                 pack $w.global.$name.family -side right -anchor e
2686                 pack $w.global.$name -side top -anchor w -fill x
2687         }
2688
2689         bind $w <Visibility> "grab $w; focus $w"
2690         bind $w <Key-Escape> "destroy $w"
2691         wm title $w "$appname ($reponame): Options"
2692         tkwait window $w
2693 }
2694
2695 proc do_restore_defaults {} {
2696         global font_descs default_config repo_config
2697         global repo_config_new global_config_new
2698
2699         foreach name [array names default_config] {
2700                 set repo_config_new($name) $default_config($name)
2701                 set global_config_new($name) $default_config($name)
2702         }
2703
2704         foreach option $font_descs {
2705                 set name [lindex $option 0]
2706                 set repo_config(gui.$name) $default_config(gui.$name)
2707         }
2708         apply_config
2709
2710         foreach option $font_descs {
2711                 set name [lindex $option 0]
2712                 set font [lindex $option 1]
2713                 set global_config_new(gui.$font^^family) \
2714                         [font configure $font -family]
2715                 set global_config_new(gui.$font^^size) \
2716                         [font configure $font -size]
2717         }
2718 }
2719
2720 proc do_save_config {w} {
2721         if {[catch {save_config} err]} {
2722                 error_popup "Failed to completely save options:\n\n$err"
2723         }
2724         reshow_diff
2725         destroy $w
2726 }
2727
2728 proc do_windows_shortcut {} {
2729         global gitdir appname argv0
2730
2731         set reponame [lindex [file split \
2732                 [file normalize [file dirname $gitdir]]] \
2733                 end]
2734
2735         if {[catch {
2736                 set desktop [exec cygpath \
2737                         --windows \
2738                         --absolute \
2739                         --long-name \
2740                         --desktop]
2741                 }]} {
2742                         set desktop .
2743         }
2744         set fn [tk_getSaveFile \
2745                 -parent . \
2746                 -title "$appname ($reponame): Create Desktop Icon" \
2747                 -initialdir $desktop \
2748                 -initialfile "Git $reponame.bat"]
2749         if {$fn != {}} {
2750                 if {[catch {
2751                                 set fd [open $fn w]
2752                                 set sh [exec cygpath \
2753                                         --windows \
2754                                         --absolute \
2755                                         /bin/sh]
2756                                 set me [exec cygpath \
2757                                         --unix \
2758                                         --absolute \
2759                                         $argv0]
2760                                 set gd [exec cygpath \
2761                                         --unix \
2762                                         --absolute \
2763                                         $gitdir]
2764                                 regsub -all ' $me "'\\''" me
2765                                 regsub -all ' $gd "'\\''" gd
2766                                 puts $fd "@ECHO Starting git-gui... Please wait..."
2767                                 puts -nonewline $fd "@\"$sh\" --login -c \""
2768                                 puts -nonewline $fd "GIT_DIR='$gd'"
2769                                 puts -nonewline $fd " '$me'"
2770                                 puts $fd "&\""
2771                                 close $fd
2772                         } err]} {
2773                         error_popup "Cannot write script:\n\n$err"
2774                 }
2775         }
2776 }
2777
2778 proc do_macosx_app {} {
2779         global gitdir appname argv0 env
2780
2781         set reponame [lindex [file split \
2782                 [file normalize [file dirname $gitdir]]] \
2783                 end]
2784
2785         set fn [tk_getSaveFile \
2786                 -parent . \
2787                 -title "$appname ($reponame): Create Desktop Icon" \
2788                 -initialdir [file join $env(HOME) Desktop] \
2789                 -initialfile "Git $reponame.app"]
2790         if {$fn != {}} {
2791                 if {[catch {
2792                                 set Contents [file join $fn Contents]
2793                                 set MacOS [file join $Contents MacOS]
2794                                 set exe [file join $MacOS git-gui]
2795
2796                                 file mkdir $MacOS
2797
2798                                 set fd [open [file join $Contents Info.plist] w]
2799                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2800 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2801 <plist version="1.0">
2802 <dict>
2803         <key>CFBundleDevelopmentRegion</key>
2804         <string>English</string>
2805         <key>CFBundleExecutable</key>
2806         <string>git-gui</string>
2807         <key>CFBundleIdentifier</key>
2808         <string>org.spearce.git-gui</string>
2809         <key>CFBundleInfoDictionaryVersion</key>
2810         <string>6.0</string>
2811         <key>CFBundlePackageType</key>
2812         <string>APPL</string>
2813         <key>CFBundleSignature</key>
2814         <string>????</string>
2815         <key>CFBundleVersion</key>
2816         <string>1.0</string>
2817         <key>NSPrincipalClass</key>
2818         <string>NSApplication</string>
2819 </dict>
2820 </plist>}
2821                                 close $fd
2822
2823                                 set fd [open $exe w]
2824                                 set gd [file normalize $gitdir]
2825                                 set ep [file normalize [exec git --exec-path]]
2826                                 regsub -all ' $gd "'\\''" gd
2827                                 regsub -all ' $ep "'\\''" ep
2828                                 puts $fd "#!/bin/sh"
2829                                 foreach name [array names env] {
2830                                         if {[string match GIT_* $name]} {
2831                                                 regsub -all ' $env($name) "'\\''" v
2832                                                 puts $fd "export $name='$v'"
2833                                         }
2834                                 }
2835                                 puts $fd "export PATH='$ep':\$PATH"
2836                                 puts $fd "export GIT_DIR='$gd'"
2837                                 puts $fd "exec [file normalize $argv0]"
2838                                 close $fd
2839
2840                                 file attributes $exe -permissions u+x,g+x,o+x
2841                         } err]} {
2842                         error_popup "Cannot write icon:\n\n$err"
2843                 }
2844         }
2845 }
2846
2847 proc toggle_or_diff {w x y} {
2848         global file_states file_lists current_diff ui_index ui_other
2849         global last_clicked selected_paths
2850
2851         set pos [split [$w index @$x,$y] .]
2852         set lno [lindex $pos 0]
2853         set col [lindex $pos 1]
2854         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2855         if {$path eq {}} {
2856                 set last_clicked {}
2857                 return
2858         }
2859
2860         set last_clicked [list $w $lno]
2861         array unset selected_paths
2862         $ui_index tag remove in_sel 0.0 end
2863         $ui_other tag remove in_sel 0.0 end
2864
2865         if {$col == 0} {
2866                 if {$current_diff eq $path} {
2867                         set after {reshow_diff;}
2868                 } else {
2869                         set after {}
2870                 }
2871                 switch -glob -- [lindex $file_states($path) 0] {
2872                 A_ -
2873                 M_ -
2874                 DD -
2875                 DO -
2876                 DM {
2877                         update_indexinfo \
2878                                 "Removing [short_path $path] from commit" \
2879                                 [list $path] \
2880                                 [concat $after {set ui_status_value {Ready.}}]
2881                 }
2882                 ?? {
2883                         update_index \
2884                                 "Adding [short_path $path]" \
2885                                 [list $path] \
2886                                 [concat $after {set ui_status_value {Ready.}}]
2887                 }
2888                 }
2889         } else {
2890                 show_diff $path $w $lno
2891         }
2892 }
2893
2894 proc add_one_to_selection {w x y} {
2895         global file_lists
2896         global last_clicked selected_paths
2897
2898         set pos [split [$w index @$x,$y] .]
2899         set lno [lindex $pos 0]
2900         set col [lindex $pos 1]
2901         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2902         if {$path eq {}} {
2903                 set last_clicked {}
2904                 return
2905         }
2906
2907         set last_clicked [list $w $lno]
2908         if {[catch {set in_sel $selected_paths($path)}]} {
2909                 set in_sel 0
2910         }
2911         if {$in_sel} {
2912                 unset selected_paths($path)
2913                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2914         } else {
2915                 set selected_paths($path) 1
2916                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2917         }
2918 }
2919
2920 proc add_range_to_selection {w x y} {
2921         global file_lists
2922         global last_clicked selected_paths
2923
2924         if {[lindex $last_clicked 0] ne $w} {
2925                 toggle_or_diff $w $x $y
2926                 return
2927         }
2928
2929         set pos [split [$w index @$x,$y] .]
2930         set lno [lindex $pos 0]
2931         set lc [lindex $last_clicked 1]
2932         if {$lc < $lno} {
2933                 set begin $lc
2934                 set end $lno
2935         } else {
2936                 set begin $lno
2937                 set end $lc
2938         }
2939
2940         foreach path [lrange $file_lists($w) \
2941                 [expr {$begin - 1}] \
2942                 [expr {$end - 1}]] {
2943                 set selected_paths($path) 1
2944         }
2945         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2946 }
2947
2948 ######################################################################
2949 ##
2950 ## config defaults
2951
2952 set cursor_ptr arrow
2953 font create font_diff -family Courier -size 10
2954 font create font_ui
2955 catch {
2956         label .dummy
2957         eval font configure font_ui [font actual [.dummy cget -font]]
2958         destroy .dummy
2959 }
2960
2961 font create font_uibold
2962 font create font_diffbold
2963
2964 if {[is_Windows]} {
2965         set M1B Control
2966         set M1T Ctrl
2967 } elseif {[is_MacOSX]} {
2968         set M1B M1
2969         set M1T Cmd
2970 } else {
2971         set M1B M1
2972         set M1T M1
2973 }
2974
2975 proc apply_config {} {
2976         global repo_config font_descs
2977
2978         foreach option $font_descs {
2979                 set name [lindex $option 0]
2980                 set font [lindex $option 1]
2981                 if {[catch {
2982                         foreach {cn cv} $repo_config(gui.$name) {
2983                                 font configure $font $cn $cv
2984                         }
2985                         } err]} {
2986                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2987                 }
2988                 foreach {cn cv} [font configure $font] {
2989                         font configure ${font}bold $cn $cv
2990                 }
2991                 font configure ${font}bold -weight bold
2992         }
2993 }
2994
2995 set default_config(gui.trustmtime) false
2996 set default_config(gui.pullsummary) true
2997 set default_config(gui.partialinclude) false
2998 set default_config(gui.diffcontext) 5
2999 set default_config(gui.fontui) [font configure font_ui]
3000 set default_config(gui.fontdiff) [font configure font_diff]
3001 set font_descs {
3002         {fontui   font_ui   {Main Font}}
3003         {fontdiff font_diff {Diff/Console Font}}
3004 }
3005 load_config 0
3006 apply_config
3007
3008 ######################################################################
3009 ##
3010 ## ui construction
3011
3012 # -- Menu Bar
3013 #
3014 menu .mbar -tearoff 0
3015 .mbar add cascade -label Repository -menu .mbar.repository
3016 .mbar add cascade -label Edit -menu .mbar.edit
3017 if {!$single_commit} {
3018         .mbar add cascade -label Branch -menu .mbar.branch
3019 }
3020 .mbar add cascade -label Commit -menu .mbar.commit
3021 if {!$single_commit} {
3022         .mbar add cascade -label Fetch -menu .mbar.fetch
3023         .mbar add cascade -label Pull -menu .mbar.pull
3024         .mbar add cascade -label Push -menu .mbar.push
3025 }
3026 . configure -menu .mbar
3027
3028 # -- Repository Menu
3029 #
3030 menu .mbar.repository
3031 .mbar.repository add command \
3032         -label {Visualize Current Branch} \
3033         -command {do_gitk {}} \
3034         -font font_ui
3035 if {![is_MacOSX]} {
3036         .mbar.repository add command \
3037                 -label {Visualize All Branches} \
3038                 -command {do_gitk {--all}} \
3039                 -font font_ui
3040 }
3041 .mbar.repository add separator
3042
3043 if {!$single_commit} {
3044         .mbar.repository add command -label {Compress Database} \
3045                 -command do_gc \
3046                 -font font_ui
3047
3048         .mbar.repository add command -label {Verify Database} \
3049                 -command do_fsck_objects \
3050                 -font font_ui
3051
3052         .mbar.repository add separator
3053
3054         if {[is_Windows]} {
3055                 .mbar.repository add command \
3056                         -label {Create Desktop Icon} \
3057                         -command do_windows_shortcut \
3058                         -font font_ui
3059         } elseif {[is_MacOSX]} {
3060                 .mbar.repository add command \
3061                         -label {Create Desktop Icon} \
3062                         -command do_macosx_app \
3063                         -font font_ui
3064         }
3065 }
3066
3067 .mbar.repository add command -label Quit \
3068         -command do_quit \
3069         -accelerator $M1T-Q \
3070         -font font_ui
3071
3072 # -- Edit Menu
3073 #
3074 menu .mbar.edit
3075 .mbar.edit add command -label Undo \
3076         -command {catch {[focus] edit undo}} \
3077         -accelerator $M1T-Z \
3078         -font font_ui
3079 .mbar.edit add command -label Redo \
3080         -command {catch {[focus] edit redo}} \
3081         -accelerator $M1T-Y \
3082         -font font_ui
3083 .mbar.edit add separator
3084 .mbar.edit add command -label Cut \
3085         -command {catch {tk_textCut [focus]}} \
3086         -accelerator $M1T-X \
3087         -font font_ui
3088 .mbar.edit add command -label Copy \
3089         -command {catch {tk_textCopy [focus]}} \
3090         -accelerator $M1T-C \
3091         -font font_ui
3092 .mbar.edit add command -label Paste \
3093         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3094         -accelerator $M1T-V \
3095         -font font_ui
3096 .mbar.edit add command -label Delete \
3097         -command {catch {[focus] delete sel.first sel.last}} \
3098         -accelerator Del \
3099         -font font_ui
3100 .mbar.edit add separator
3101 .mbar.edit add command -label {Select All} \
3102         -command {catch {[focus] tag add sel 0.0 end}} \
3103         -accelerator $M1T-A \
3104         -font font_ui
3105
3106 # -- Branch Menu
3107 #
3108 if {!$single_commit} {
3109         menu .mbar.branch
3110
3111         .mbar.branch add command -label {Create...} \
3112                 -command do_create_branch \
3113                 -font font_ui
3114         lappend disable_on_lock [list .mbar.branch entryconf \
3115                 [.mbar.branch index last] -state]
3116
3117         .mbar.branch add command -label {Delete...} \
3118                 -command do_delete_branch \
3119                 -font font_ui
3120         lappend disable_on_lock [list .mbar.branch entryconf \
3121                 [.mbar.branch index last] -state]
3122 }
3123
3124 # -- Commit Menu
3125 #
3126 menu .mbar.commit
3127
3128 .mbar.commit add radiobutton \
3129         -label {New Commit} \
3130         -command do_select_commit_type \
3131         -variable selected_commit_type \
3132         -value new \
3133         -font font_ui
3134 lappend disable_on_lock \
3135         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3136
3137 .mbar.commit add radiobutton \
3138         -label {Amend Last Commit} \
3139         -command do_select_commit_type \
3140         -variable selected_commit_type \
3141         -value amend \
3142         -font font_ui
3143 lappend disable_on_lock \
3144         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3145
3146 .mbar.commit add separator
3147
3148 .mbar.commit add command -label Rescan \
3149         -command do_rescan \
3150         -accelerator F5 \
3151         -font font_ui
3152 lappend disable_on_lock \
3153         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154
3155 .mbar.commit add command -label {Add To Commit} \
3156         -command do_include_selection \
3157         -font font_ui
3158 lappend disable_on_lock \
3159         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3160
3161 .mbar.commit add command -label {Add All To Commit} \
3162         -command do_include_all \
3163         -accelerator $M1T-I \
3164         -font font_ui
3165 lappend disable_on_lock \
3166         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167
3168 .mbar.commit add command -label {Remove From Commit} \
3169         -command do_remove_selection \
3170         -font font_ui
3171 lappend disable_on_lock \
3172         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173
3174 .mbar.commit add command -label {Revert Changes} \
3175         -command do_revert_selection \
3176         -font font_ui
3177 lappend disable_on_lock \
3178         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179
3180 .mbar.commit add separator
3181
3182 .mbar.commit add command -label {Sign Off} \
3183         -command do_signoff \
3184         -accelerator $M1T-S \
3185         -font font_ui
3186
3187 .mbar.commit add command -label Commit \
3188         -command do_commit \
3189         -accelerator $M1T-Return \
3190         -font font_ui
3191 lappend disable_on_lock \
3192         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3193
3194 # -- Transport menus
3195 #
3196 if {!$single_commit} {
3197         menu .mbar.fetch
3198         menu .mbar.pull
3199         menu .mbar.push
3200 }
3201
3202 if {[is_MacOSX]} {
3203         # -- Apple Menu (Mac OS X only)
3204         #
3205         .mbar add cascade -label Apple -menu .mbar.apple
3206         menu .mbar.apple
3207
3208         .mbar.apple add command -label "About $appname" \
3209                 -command do_about \
3210                 -font font_ui
3211         .mbar.apple add command -label "$appname Options..." \
3212                 -command do_options \
3213                 -font font_ui
3214 } else {
3215         # -- Edit Menu
3216         #
3217         .mbar.edit add separator
3218         .mbar.edit add command -label {Options...} \
3219                 -command do_options \
3220                 -font font_ui
3221
3222         # -- Tools Menu
3223         #
3224         if {[file exists /usr/local/miga/lib/gui-miga]} {
3225         proc do_miga {} {
3226                 global gitdir ui_status_value
3227                 if {![lock_index update]} return
3228                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3229                 set miga_fd [open "|$cmd" r]
3230                 fconfigure $miga_fd -blocking 0
3231                 fileevent $miga_fd readable [list miga_done $miga_fd]
3232                 set ui_status_value {Running miga...}
3233         }
3234         proc miga_done {fd} {
3235                 read $fd 512
3236                 if {[eof $fd]} {
3237                         close $fd
3238                         unlock_index
3239                         rescan [list set ui_status_value {Ready.}]
3240                 }
3241         }
3242         .mbar add cascade -label Tools -menu .mbar.tools
3243         menu .mbar.tools
3244         .mbar.tools add command -label "Migrate" \
3245                 -command do_miga \
3246                 -font font_ui
3247         lappend disable_on_lock \
3248                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3249         }
3250
3251         # -- Help Menu
3252         #
3253         .mbar add cascade -label Help -menu .mbar.help
3254         menu .mbar.help
3255
3256         .mbar.help add command -label "About $appname" \
3257                 -command do_about \
3258                 -font font_ui
3259 }
3260
3261
3262 # -- Branch Control
3263 #
3264 frame .branch \
3265         -borderwidth 1 \
3266         -relief sunken
3267 label .branch.l1 \
3268         -text {Current Branch:} \
3269         -anchor w \
3270         -justify left \
3271         -font font_ui
3272 label .branch.cb \
3273         -textvariable current_branch \
3274         -anchor w \
3275         -justify left \
3276         -font font_ui
3277 pack .branch.l1 -side left
3278 pack .branch.cb -side left -fill x
3279 pack .branch -side top -fill x
3280
3281 # -- Main Window Layout
3282 #
3283 panedwindow .vpane -orient vertical
3284 panedwindow .vpane.files -orient horizontal
3285 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3286 pack .vpane -anchor n -side top -fill both -expand 1
3287
3288 # -- Index File List
3289 #
3290 frame .vpane.files.index -height 100 -width 400
3291 label .vpane.files.index.title -text {Modified Files} \
3292         -background green \
3293         -font font_ui
3294 text $ui_index -background white -borderwidth 0 \
3295         -width 40 -height 10 \
3296         -font font_ui \
3297         -cursor $cursor_ptr \
3298         -yscrollcommand {.vpane.files.index.sb set} \
3299         -state disabled
3300 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3301 pack .vpane.files.index.title -side top -fill x
3302 pack .vpane.files.index.sb -side right -fill y
3303 pack $ui_index -side left -fill both -expand 1
3304 .vpane.files add .vpane.files.index -sticky nsew
3305
3306 # -- Other (Add) File List
3307 #
3308 frame .vpane.files.other -height 100 -width 100
3309 label .vpane.files.other.title -text {Untracked Files} \
3310         -background red \
3311         -font font_ui
3312 text $ui_other -background white -borderwidth 0 \
3313         -width 40 -height 10 \
3314         -font font_ui \
3315         -cursor $cursor_ptr \
3316         -yscrollcommand {.vpane.files.other.sb set} \
3317         -state disabled
3318 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3319 pack .vpane.files.other.title -side top -fill x
3320 pack .vpane.files.other.sb -side right -fill y
3321 pack $ui_other -side left -fill both -expand 1
3322 .vpane.files add .vpane.files.other -sticky nsew
3323
3324 foreach i [list $ui_index $ui_other] {
3325         $i tag conf in_diff -font font_uibold
3326         $i tag conf in_sel \
3327                 -background [$i cget -foreground] \
3328                 -foreground [$i cget -background]
3329 }
3330 unset i
3331
3332 # -- Diff and Commit Area
3333 #
3334 frame .vpane.lower -height 300 -width 400
3335 frame .vpane.lower.commarea
3336 frame .vpane.lower.diff -relief sunken -borderwidth 1
3337 pack .vpane.lower.commarea -side top -fill x
3338 pack .vpane.lower.diff -side bottom -fill both -expand 1
3339 .vpane add .vpane.lower -stick nsew
3340
3341 # -- Commit Area Buttons
3342 #
3343 frame .vpane.lower.commarea.buttons
3344 label .vpane.lower.commarea.buttons.l -text {} \
3345         -anchor w \
3346         -justify left \
3347         -font font_ui
3348 pack .vpane.lower.commarea.buttons.l -side top -fill x
3349 pack .vpane.lower.commarea.buttons -side left -fill y
3350
3351 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3352         -command do_rescan \
3353         -font font_ui
3354 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3355 lappend disable_on_lock \
3356         {.vpane.lower.commarea.buttons.rescan conf -state}
3357
3358 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3359         -command do_include_all \
3360         -font font_ui
3361 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3362 lappend disable_on_lock \
3363         {.vpane.lower.commarea.buttons.incall conf -state}
3364
3365 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3366         -command do_signoff \
3367         -font font_ui
3368 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3369
3370 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3371         -command do_commit \
3372         -font font_ui
3373 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3374 lappend disable_on_lock \
3375         {.vpane.lower.commarea.buttons.commit conf -state}
3376
3377 # -- Commit Message Buffer
3378 #
3379 frame .vpane.lower.commarea.buffer
3380 frame .vpane.lower.commarea.buffer.header
3381 set ui_comm .vpane.lower.commarea.buffer.t
3382 set ui_coml .vpane.lower.commarea.buffer.header.l
3383 radiobutton .vpane.lower.commarea.buffer.header.new \
3384         -text {New Commit} \
3385         -command do_select_commit_type \
3386         -variable selected_commit_type \
3387         -value new \
3388         -font font_ui
3389 lappend disable_on_lock \
3390         [list .vpane.lower.commarea.buffer.header.new conf -state]
3391 radiobutton .vpane.lower.commarea.buffer.header.amend \
3392         -text {Amend Last Commit} \
3393         -command do_select_commit_type \
3394         -variable selected_commit_type \
3395         -value amend \
3396         -font font_ui
3397 lappend disable_on_lock \
3398         [list .vpane.lower.commarea.buffer.header.amend conf -state]
3399 label $ui_coml \
3400         -anchor w \
3401         -justify left \
3402         -font font_ui
3403 proc trace_commit_type {varname args} {
3404         global ui_coml commit_type
3405         switch -glob -- $commit_type {
3406         initial       {set txt {Initial Commit Message:}}
3407         amend         {set txt {Amended Commit Message:}}
3408         amend-initial {set txt {Amended Initial Commit Message:}}
3409         amend-merge   {set txt {Amended Merge Commit Message:}}
3410         merge         {set txt {Merge Commit Message:}}
3411         *             {set txt {Commit Message:}}
3412         }
3413         $ui_coml conf -text $txt
3414 }
3415 trace add variable commit_type write trace_commit_type
3416 pack $ui_coml -side left -fill x
3417 pack .vpane.lower.commarea.buffer.header.amend -side right
3418 pack .vpane.lower.commarea.buffer.header.new -side right
3419
3420 text $ui_comm -background white -borderwidth 1 \
3421         -undo true \
3422         -maxundo 20 \
3423         -autoseparators true \
3424         -relief sunken \
3425         -width 75 -height 9 -wrap none \
3426         -font font_diff \
3427         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3428 scrollbar .vpane.lower.commarea.buffer.sby \
3429         -command [list $ui_comm yview]
3430 pack .vpane.lower.commarea.buffer.header -side top -fill x
3431 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3432 pack $ui_comm -side left -fill y
3433 pack .vpane.lower.commarea.buffer -side left -fill y
3434
3435 # -- Commit Message Buffer Context Menu
3436 #
3437 set ctxm .vpane.lower.commarea.buffer.ctxm
3438 menu $ctxm -tearoff 0
3439 $ctxm add command \
3440         -label {Cut} \
3441         -font font_ui \
3442         -command {tk_textCut $ui_comm}
3443 $ctxm add command \
3444         -label {Copy} \
3445         -font font_ui \
3446         -command {tk_textCopy $ui_comm}
3447 $ctxm add command \
3448         -label {Paste} \
3449         -font font_ui \
3450         -command {tk_textPaste $ui_comm}
3451 $ctxm add command \
3452         -label {Delete} \
3453         -font font_ui \
3454         -command {$ui_comm delete sel.first sel.last}
3455 $ctxm add separator
3456 $ctxm add command \
3457         -label {Select All} \
3458         -font font_ui \
3459         -command {$ui_comm tag add sel 0.0 end}
3460 $ctxm add command \
3461         -label {Copy All} \
3462         -font font_ui \
3463         -command {
3464                 $ui_comm tag add sel 0.0 end
3465                 tk_textCopy $ui_comm
3466                 $ui_comm tag remove sel 0.0 end
3467         }
3468 $ctxm add separator
3469 $ctxm add command \
3470         -label {Sign Off} \
3471         -font font_ui \
3472         -command do_signoff
3473 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3474
3475 # -- Diff Header
3476 #
3477 set current_diff {}
3478 set diff_actions [list]
3479 proc trace_current_diff {varname args} {
3480         global current_diff diff_actions file_states
3481         if {$current_diff eq {}} {
3482                 set s {}
3483                 set f {}
3484                 set p {}
3485                 set o disabled
3486         } else {
3487                 set p $current_diff
3488                 set s [mapdesc [lindex $file_states($p) 0] $p]
3489                 set f {File:}
3490                 set p [escape_path $p]
3491                 set o normal
3492         }
3493
3494         .vpane.lower.diff.header.status configure -text $s
3495         .vpane.lower.diff.header.file configure -text $f
3496         .vpane.lower.diff.header.path configure -text $p
3497         foreach w $diff_actions {
3498                 uplevel #0 $w $o
3499         }
3500 }
3501 trace add variable current_diff write trace_current_diff
3502
3503 frame .vpane.lower.diff.header -background orange
3504 label .vpane.lower.diff.header.status \
3505         -background orange \
3506         -width $max_status_desc \
3507         -anchor w \
3508         -justify left \
3509         -font font_ui
3510 label .vpane.lower.diff.header.file \
3511         -background orange \
3512         -anchor w \
3513         -justify left \
3514         -font font_ui
3515 label .vpane.lower.diff.header.path \
3516         -background orange \
3517         -anchor w \
3518         -justify left \
3519         -font font_ui
3520 pack .vpane.lower.diff.header.status -side left
3521 pack .vpane.lower.diff.header.file -side left
3522 pack .vpane.lower.diff.header.path -fill x
3523 set ctxm .vpane.lower.diff.header.ctxm
3524 menu $ctxm -tearoff 0
3525 $ctxm add command \
3526         -label {Copy} \
3527         -font font_ui \
3528         -command {
3529                 clipboard clear
3530                 clipboard append \
3531                         -format STRING \
3532                         -type STRING \
3533                         -- $current_diff
3534         }
3535 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3536 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3537
3538 # -- Diff Body
3539 #
3540 frame .vpane.lower.diff.body
3541 set ui_diff .vpane.lower.diff.body.t
3542 text $ui_diff -background white -borderwidth 0 \
3543         -width 80 -height 15 -wrap none \
3544         -font font_diff \
3545         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3546         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3547         -state disabled
3548 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3549         -command [list $ui_diff xview]
3550 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3551         -command [list $ui_diff yview]
3552 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3553 pack .vpane.lower.diff.body.sby -side right -fill y
3554 pack $ui_diff -side left -fill both -expand 1
3555 pack .vpane.lower.diff.header -side top -fill x
3556 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3557
3558 $ui_diff tag conf d_@ -font font_diffbold
3559 $ui_diff tag conf d_+  -foreground blue
3560 $ui_diff tag conf d_-  -foreground red
3561 $ui_diff tag conf d_++ -foreground {#00a000}
3562 $ui_diff tag conf d_-- -foreground {#a000a0}
3563 $ui_diff tag conf d_+- \
3564         -foreground red \
3565         -background {light goldenrod yellow}
3566 $ui_diff tag conf d_-+ \
3567         -foreground blue \
3568         -background azure2
3569
3570 # -- Diff Body Context Menu
3571 #
3572 set ctxm .vpane.lower.diff.body.ctxm
3573 menu $ctxm -tearoff 0
3574 $ctxm add command \
3575         -label {Copy} \
3576         -font font_ui \
3577         -command {tk_textCopy $ui_diff}
3578 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3579 $ctxm add command \
3580         -label {Select All} \
3581         -font font_ui \
3582         -command {$ui_diff tag add sel 0.0 end}
3583 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3584 $ctxm add command \
3585         -label {Copy All} \
3586         -font font_ui \
3587         -command {
3588                 $ui_diff tag add sel 0.0 end
3589                 tk_textCopy $ui_diff
3590                 $ui_diff tag remove sel 0.0 end
3591         }
3592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3593 $ctxm add separator
3594 $ctxm add command \
3595         -label {Decrease Font Size} \
3596         -font font_ui \
3597         -command {incr_font_size font_diff -1}
3598 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3599 $ctxm add command \
3600         -label {Increase Font Size} \
3601         -font font_ui \
3602         -command {incr_font_size font_diff 1}
3603 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3604 $ctxm add separator
3605 $ctxm add command \
3606         -label {Show Less Context} \
3607         -font font_ui \
3608         -command {if {$repo_config(gui.diffcontext) >= 2} {
3609                 incr repo_config(gui.diffcontext) -1
3610                 reshow_diff
3611         }}
3612 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3613 $ctxm add command \
3614         -label {Show More Context} \
3615         -font font_ui \
3616         -command {
3617                 incr repo_config(gui.diffcontext)
3618                 reshow_diff
3619         }
3620 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3621 $ctxm add separator
3622 $ctxm add command -label {Options...} \
3623         -font font_ui \
3624         -command do_options
3625 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3626
3627 # -- Status Bar
3628 #
3629 set ui_status_value {Initializing...}
3630 label .status -textvariable ui_status_value \
3631         -anchor w \
3632         -justify left \
3633         -borderwidth 1 \
3634         -relief sunken \
3635         -font font_ui
3636 pack .status -anchor w -side bottom -fill x
3637
3638 # -- Load geometry
3639 #
3640 catch {
3641 set gm $repo_config(gui.geometry)
3642 wm geometry . [lindex $gm 0]
3643 .vpane sash place 0 \
3644         [lindex [.vpane sash coord 0] 0] \
3645         [lindex $gm 1]
3646 .vpane.files sash place 0 \
3647         [lindex $gm 2] \
3648         [lindex [.vpane.files sash coord 0] 1]
3649 unset gm
3650 }
3651
3652 # -- Key Bindings
3653 #
3654 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3655 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3656 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3657 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3658 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3659 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3660 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3661 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3662 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3663 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3664 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3665
3666 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3667 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3668 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3669 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3670 bind $ui_diff <$M1B-Key-v> {break}
3671 bind $ui_diff <$M1B-Key-V> {break}
3672 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3673 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3674 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3675 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3676 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3677 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3678
3679 bind .   <Destroy> do_quit
3680 bind all <Key-F5> do_rescan
3681 bind all <$M1B-Key-r> do_rescan
3682 bind all <$M1B-Key-R> do_rescan
3683 bind .   <$M1B-Key-s> do_signoff
3684 bind .   <$M1B-Key-S> do_signoff
3685 bind .   <$M1B-Key-i> do_include_all
3686 bind .   <$M1B-Key-I> do_include_all
3687 bind .   <$M1B-Key-Return> do_commit
3688 bind all <$M1B-Key-q> do_quit
3689 bind all <$M1B-Key-Q> do_quit
3690 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3691 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3692 foreach i [list $ui_index $ui_other] {
3693         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3694         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3695         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3696 }
3697 unset i
3698
3699 set file_lists($ui_index) [list]
3700 set file_lists($ui_other) [list]
3701
3702 set HEAD {}
3703 set PARENT {}
3704 set MERGE_HEAD [list]
3705 set commit_type {}
3706 set empty_tree {}
3707 set current_branch {}
3708 set current_diff {}
3709 set selected_commit_type new
3710
3711 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3712 focus -force $ui_comm
3713
3714 # -- Warn the user about environmental problems.  Cygwin's Tcl
3715 #    does *not* pass its env array onto any processes it spawns.
3716 #    This means that git processes get none of our environment.
3717 #
3718 if {[is_Windows]} {
3719         set ignored_env 0
3720         set suggest_user {}
3721         set msg "Possible environment issues exist.
3722
3723 The following environment variables are probably
3724 going to be ignored by any Git subprocess run
3725 by $appname:
3726
3727 "
3728         foreach name [array names env] {
3729                 switch -regexp -- $name {
3730                 {^GIT_INDEX_FILE$} -
3731                 {^GIT_OBJECT_DIRECTORY$} -
3732                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3733                 {^GIT_DIFF_OPTS$} -
3734                 {^GIT_EXTERNAL_DIFF$} -
3735                 {^GIT_PAGER$} -
3736                 {^GIT_TRACE$} -
3737                 {^GIT_CONFIG$} -
3738                 {^GIT_CONFIG_LOCAL$} -
3739                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3740                         append msg " - $name\n"
3741                         incr ignored_env
3742                 }
3743                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3744                         append msg " - $name\n"
3745                         incr ignored_env
3746                         set suggest_user $name
3747                 }
3748                 }
3749         }
3750         if {$ignored_env > 0} {
3751                 append msg "
3752 This is due to a known issue with the
3753 Tcl binary distributed by Cygwin."
3754
3755                 if {$suggest_user ne {}} {
3756                         append msg "
3757
3758 A good replacement for $suggest_user
3759 is placing values for the user.name and
3760 user.email settings into your personal
3761 ~/.gitconfig file.
3762 "
3763                 }
3764                 warn_popup $msg
3765         }
3766         unset ignored_env msg suggest_user name
3767 }
3768
3769 # -- Only initialize complex UI if we are going to stay running.
3770 #
3771 if {!$single_commit} {
3772         load_all_remotes
3773         load_all_heads
3774
3775         populate_branch_menu .mbar.branch
3776         populate_fetch_menu .mbar.fetch
3777         populate_pull_menu .mbar.pull
3778         populate_push_menu .mbar.push
3779 }
3780
3781 lock_index begin-read
3782 after 1 do_rescan