git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 set appname [lindex [file split $argv0] end]
  11 set gitdir {}
  12
  13 ######################################################################
  14 ##
  15 ## config
  16
  17 proc is_many_config {name} {
  18         switch -glob -- $name {
  19         remote.*.fetch -
  20         remote.*.push
  21                 {return 1}
  22         *
  23                 {return 0}
  24         }
  25 }
  26
  27 proc load_config {include_global} {
  28         global repo_config global_config default_config
  29
  30         array unset global_config
  31         if {$include_global} {
  32                 catch {
  33                         set fd_rc [open "| git repo-config --global --list" r]
  34                         while {[gets $fd_rc line] >= 0} {
  35                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                         if {[is_many_config $name]} {
  37                                                 lappend global_config($name) $value
  38                                         } else {
  39                                                 set global_config($name) $value
  40                                         }
  41                                 }
  42                         }
  43                         close $fd_rc
  44                 }
  45         }
  46
  47         array unset repo_config
  48         catch {
  49                 set fd_rc [open "| git repo-config --list" r]
  50                 while {[gets $fd_rc line] >= 0} {
  51                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                 if {[is_many_config $name]} {
  53                                         lappend repo_config($name) $value
  54                                 } else {
  55                                         set repo_config($name) $value
  56                                 }
  57                         }
  58                 }
  59                 close $fd_rc
  60         }
  61
  62         foreach name [array names default_config] {
  63                 if {[catch {set v $global_config($name)}]} {
  64                         set global_config($name) $default_config($name)
  65                 }
  66                 if {[catch {set v $repo_config($name)}]} {
  67                         set repo_config($name) $default_config($name)
  68                 }
  69         }
  70 }
  71
  72 proc save_config {} {
  73         global default_config font_descs
  74         global repo_config global_config
  75         global repo_config_new global_config_new
  76
  77         foreach option $font_descs {
  78                 set name [lindex $option 0]
  79                 set font [lindex $option 1]
  80                 font configure $font \
  81                         -family $global_config_new(gui.$font^^family) \
  82                         -size $global_config_new(gui.$font^^size)
  83                 font configure ${font}bold \
  84                         -family $global_config_new(gui.$font^^family) \
  85                         -size $global_config_new(gui.$font^^size)
  86                 set global_config_new(gui.$name) [font configure $font]
  87                 unset global_config_new(gui.$font^^family)
  88                 unset global_config_new(gui.$font^^size)
  89         }
  90
  91         foreach name [array names default_config] {
  92                 set value $global_config_new($name)
  93                 if {$value ne $global_config($name)} {
  94                         if {$value eq $default_config($name)} {
  95                                 catch {exec git repo-config --global --unset $name}
  96                         } else {
  97                                 regsub -all "\[{}\]" $value {"} value
  98                                 exec git repo-config --global $name $value
  99                         }
 100                         set global_config($name) $value
 101                         if {$value eq $repo_config($name)} {
 102                                 catch {exec git repo-config --unset $name}
 103                                 set repo_config($name) $value
 104                         }
 105                 }
 106         }
 107
 108         foreach name [array names default_config] {
 109                 set value $repo_config_new($name)
 110                 if {$value ne $repo_config($name)} {
 111                         if {$value eq $global_config($name)} {
 112                                 catch {exec git repo-config --unset $name}
 113                         } else {
 114                                 regsub -all "\[{}\]" $value {"} value
 115                                 exec git repo-config $name $value
 116                         }
 117                         set repo_config($name) $value
 118                 }
 119         }
 120 }
 121
 122 proc error_popup {msg} {
 123         global gitdir appname
 124
 125         set title $appname
 126         if {$gitdir ne {}} {
 127                 append title { (}
 128                 append title [lindex \
 129                         [file split [file normalize [file dirname $gitdir]]] \
 130                         end]
 131                 append title {)}
 132         }
 133         set cmd [list tk_messageBox \
 134                 -icon error \
 135                 -type ok \
 136                 -title "$title: error" \
 137                 -message $msg]
 138         if {[winfo ismapped .]} {
 139                 lappend cmd -parent .
 140         }
 141         eval $cmd
 142 }
 143
 144 proc info_popup {msg} {
 145         global gitdir appname
 146
 147         set title $appname
 148         if {$gitdir ne {}} {
 149                 append title { (}
 150                 append title [lindex \
 151                         [file split [file normalize [file dirname $gitdir]]] \
 152                         end]
 153                 append title {)}
 154         }
 155         tk_messageBox \
 156                 -parent . \
 157                 -icon error \
 158                 -type ok \
 159                 -title $title \
 160                 -message $msg
 161 }
 162
 163 ######################################################################
 164 ##
 165 ## repository setup
 166
 167 if {   [catch {set gitdir $env(GIT_DIR)}]
 168         && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 169         catch {wm withdraw .}
 170         error_popup "Cannot find the git directory:\n\n$err"
 171         exit 1
 172 }
 173 if {![file isdirectory $gitdir]} {
 174         catch {wm withdraw .}
 175         error_popup "Git directory not found:\n\n$gitdir"
 176         exit 1
 177 }
 178 if {[lindex [file split $gitdir] end] ne {.git}} {
 179         catch {wm withdraw .}
 180         error_popup "Cannot use funny .git directory:\n\n$gitdir"
 181         exit 1
 182 }
 183 if {[catch {cd [file dirname $gitdir]} err]} {
 184         catch {wm withdraw .}
 185         error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 186         exit 1
 187 }
 188
 189 set single_commit 0
 190 if {$appname eq {git-citool}} {
 191         set single_commit 1
 192 }
 193
 194 ######################################################################
 195 ##
 196 ## task management
 197
 198 set rescan_active 0
 199 set diff_active 0
 200 set last_clicked {}
 201
 202 set disable_on_lock [list]
 203 set index_lock_type none
 204
 205 proc lock_index {type} {
 206         global index_lock_type disable_on_lock
 207
 208         if {$index_lock_type eq {none}} {
 209                 set index_lock_type $type
 210                 foreach w $disable_on_lock {
 211                         uplevel #0 $w disabled
 212                 }
 213                 return 1
 214         } elseif {$index_lock_type eq "begin-$type"} {
 215                 set index_lock_type $type
 216                 return 1
 217         }
 218         return 0
 219 }
 220
 221 proc unlock_index {} {
 222         global index_lock_type disable_on_lock
 223
 224         set index_lock_type none
 225         foreach w $disable_on_lock {
 226                 uplevel #0 $w normal
 227         }
 228 }
 229
 230 ######################################################################
 231 ##
 232 ## status
 233
 234 proc repository_state {hdvar ctvar} {
 235         global gitdir
 236         upvar $hdvar hd $ctvar ct
 237
 238         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 239                 set hd {}
 240                 set ct initial
 241         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 242                 set ct merge
 243         } else {
 244                 set ct normal
 245         }
 246 }
 247
 248 proc PARENT {} {
 249         global PARENT empty_tree
 250
 251         if {$PARENT ne {}} {
 252                 return $PARENT
 253         }
 254         if {$empty_tree eq {}} {
 255                 set empty_tree [exec git mktree << {}]
 256         }
 257         return $empty_tree
 258 }
 259
 260 proc rescan {after} {
 261         global HEAD PARENT commit_type
 262         global ui_index ui_other ui_status_value ui_comm
 263         global rescan_active file_states
 264         global repo_config
 265
 266         if {$rescan_active > 0 || ![lock_index read]} return
 267
 268         repository_state new_HEAD new_type
 269         if {[string match amend* $commit_type]
 270                 && $new_type eq {normal}
 271                 && $new_HEAD eq $HEAD} {
 272         } else {
 273                 set HEAD $new_HEAD
 274                 set PARENT $new_HEAD
 275                 set commit_type $new_type
 276         }
 277
 278         array unset file_states
 279
 280         if {![$ui_comm edit modified]
 281                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 282                 if {[load_message GITGUI_MSG]} {
 283                 } elseif {[load_message MERGE_MSG]} {
 284                 } elseif {[load_message SQUASH_MSG]} {
 285                 }
 286                 $ui_comm edit modified false
 287                 $ui_comm edit reset
 288         }
 289
 290         if {$repo_config(gui.trustmtime) eq {true}} {
 291                 rescan_stage2 {} $after
 292         } else {
 293                 set rescan_active 1
 294                 set ui_status_value {Refreshing file status...}
 295                 set cmd [list git update-index]
 296                 lappend cmd -q
 297                 lappend cmd --unmerged
 298                 lappend cmd --ignore-missing
 299                 lappend cmd --refresh
 300                 set fd_rf [open "| $cmd" r]
 301                 fconfigure $fd_rf -blocking 0 -translation binary
 302                 fileevent $fd_rf readable \
 303                         [list rescan_stage2 $fd_rf $after]
 304         }
 305 }
 306
 307 proc rescan_stage2 {fd after} {
 308         global gitdir ui_status_value
 309         global rescan_active buf_rdi buf_rdf buf_rlo
 310
 311         if {$fd ne {}} {
 312                 read $fd
 313                 if {![eof $fd]} return
 314                 close $fd
 315         }
 316
 317         set ls_others [list | git ls-files --others -z \
 318                 --exclude-per-directory=.gitignore]
 319         set info_exclude [file join $gitdir info exclude]
 320         if {[file readable $info_exclude]} {
 321                 lappend ls_others "--exclude-from=$info_exclude"
 322         }
 323
 324         set buf_rdi {}
 325         set buf_rdf {}
 326         set buf_rlo {}
 327
 328         set rescan_active 3
 329         set ui_status_value {Scanning for modified files ...}
 330         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 331         set fd_df [open "| git diff-files -z" r]
 332         set fd_lo [open $ls_others r]
 333
 334         fconfigure $fd_di -blocking 0 -translation binary
 335         fconfigure $fd_df -blocking 0 -translation binary
 336         fconfigure $fd_lo -blocking 0 -translation binary
 337         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 338         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 339         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 340 }
 341
 342 proc load_message {file} {
 343         global gitdir ui_comm
 344
 345         set f [file join $gitdir $file]
 346         if {[file isfile $f]} {
 347                 if {[catch {set fd [open $f r]}]} {
 348                         return 0
 349                 }
 350                 set content [string trim [read $fd]]
 351                 close $fd
 352                 $ui_comm delete 0.0 end
 353                 $ui_comm insert end $content
 354                 return 1
 355         }
 356         return 0
 357 }
 358
 359 proc read_diff_index {fd after} {
 360         global buf_rdi
 361
 362         append buf_rdi [read $fd]
 363         set c 0
 364         set n [string length $buf_rdi]
 365         while {$c < $n} {
 366                 set z1 [string first "\0" $buf_rdi $c]
 367                 if {$z1 == -1} break
 368                 incr z1
 369                 set z2 [string first "\0" $buf_rdi $z1]
 370                 if {$z2 == -1} break
 371
 372                 set c $z2
 373                 incr z2 -1
 374                 display_file \
 375                         [string range $buf_rdi $z1 $z2] \
 376                         [string index $buf_rdi [expr {$z1 - 2}]]?
 377                 incr c
 378         }
 379         if {$c < $n} {
 380                 set buf_rdi [string range $buf_rdi $c end]
 381         } else {
 382                 set buf_rdi {}
 383         }
 384
 385         rescan_done $fd buf_rdi $after
 386 }
 387
 388 proc read_diff_files {fd after} {
 389         global buf_rdf
 390
 391         append buf_rdf [read $fd]
 392         set c 0
 393         set n [string length $buf_rdf]
 394         while {$c < $n} {
 395                 set z1 [string first "\0" $buf_rdf $c]
 396                 if {$z1 == -1} break
 397                 incr z1
 398                 set z2 [string first "\0" $buf_rdf $z1]
 399                 if {$z2 == -1} break
 400
 401                 set c $z2
 402                 incr z2 -1
 403                 display_file \
 404                         [string range $buf_rdf $z1 $z2] \
 405                         ?[string index $buf_rdf [expr {$z1 - 2}]]
 406                 incr c
 407         }
 408         if {$c < $n} {
 409                 set buf_rdf [string range $buf_rdf $c end]
 410         } else {
 411                 set buf_rdf {}
 412         }
 413
 414         rescan_done $fd buf_rdf $after
 415 }
 416
 417 proc read_ls_others {fd after} {
 418         global buf_rlo
 419
 420         append buf_rlo [read $fd]
 421         set pck [split $buf_rlo "\0"]
 422         set buf_rlo [lindex $pck end]
 423         foreach p [lrange $pck 0 end-1] {
 424                 display_file $p ?O
 425         }
 426         rescan_done $fd buf_rlo $after
 427 }
 428
 429 proc rescan_done {fd buf after} {
 430         global rescan_active
 431         global file_states repo_config
 432         upvar $buf to_clear
 433
 434         if {![eof $fd]} return
 435         set to_clear {}
 436         close $fd
 437         if {[incr rescan_active -1] > 0} return
 438
 439         prune_selection
 440         unlock_index
 441         display_all_files
 442
 443         if {$repo_config(gui.partialinclude) ne {true}} {
 444                 set pathList [list]
 445                 foreach path [array names file_states] {
 446                         switch -- [lindex $file_states($path) 0] {
 447                         AM -
 448                         MM {lappend pathList $path}
 449                         }
 450                 }
 451                 if {$pathList ne {}} {
 452                         update_index \
 453                                 "Updating included files" \
 454                                 $pathList \
 455                                 [concat {reshow_diff;} $after]
 456                         return
 457                 }
 458         }
 459
 460         reshow_diff
 461         uplevel #0 $after
 462 }
 463
 464 proc prune_selection {} {
 465         global file_states selected_paths
 466
 467         foreach path [array names selected_paths] {
 468                 if {[catch {set still_here $file_states($path)}]} {
 469                         unset selected_paths($path)
 470                 }
 471         }
 472 }
 473
 474 ######################################################################
 475 ##
 476 ## diff
 477
 478 proc clear_diff {} {
 479         global ui_diff current_diff ui_index ui_other
 480
 481         $ui_diff conf -state normal
 482         $ui_diff delete 0.0 end
 483         $ui_diff conf -state disabled
 484
 485         set current_diff {}
 486
 487         $ui_index tag remove in_diff 0.0 end
 488         $ui_other tag remove in_diff 0.0 end
 489 }
 490
 491 proc reshow_diff {} {
 492         global current_diff ui_status_value file_states
 493
 494         if {$current_diff eq {}
 495                 || [catch {set s $file_states($current_diff)}]} {
 496                 clear_diff
 497         } else {
 498                 show_diff $current_diff
 499         }
 500 }
 501
 502 proc handle_empty_diff {} {
 503         global current_diff file_states file_lists
 504
 505         set path $current_diff
 506         set s $file_states($path)
 507         if {[lindex $s 0] ne {_M}} return
 508
 509         info_popup "No differences detected.
 510
 511 [short_path $path] has no changes.
 512
 513 The modification date of this file was updated
 514 by another application and you currently have
 515 the Trust File Modification Timestamps option
 516 enabled, so Git did not automatically detect
 517 that there are no content differences in this
 518 file.
 519
 520 This file will now be removed from the modified
 521 files list, to prevent possible confusion.
 522 "
 523         if {[catch {exec git update-index -- $path} err]} {
 524                 error_popup "Failed to refresh index:\n\n$err"
 525         }
 526
 527         clear_diff
 528         set old_w [mapcol [lindex $file_states($path) 0] $path]
 529         set lno [lsearch -sorted $file_lists($old_w) $path]
 530         if {$lno >= 0} {
 531                 set file_lists($old_w) \
 532                         [lreplace $file_lists($old_w) $lno $lno]
 533                 incr lno
 534                 $old_w conf -state normal
 535                 $old_w delete $lno.0 [expr {$lno + 1}].0
 536                 $old_w conf -state disabled
 537         }
 538 }
 539
 540 proc show_diff {path {w {}} {lno {}}} {
 541         global file_states file_lists
 542         global diff_3way diff_active repo_config
 543         global ui_diff current_diff ui_status_value
 544
 545         if {$diff_active || ![lock_index read]} return
 546
 547         clear_diff
 548         if {$w eq {} || $lno == {}} {
 549                 foreach w [array names file_lists] {
 550                         set lno [lsearch -sorted $file_lists($w) $path]
 551                         if {$lno >= 0} {
 552                                 incr lno
 553                                 break
 554                         }
 555                 }
 556         }
 557         if {$w ne {} && $lno >= 1} {
 558                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 559         }
 560
 561         set s $file_states($path)
 562         set m [lindex $s 0]
 563         set diff_3way 0
 564         set diff_active 1
 565         set current_diff $path
 566         set ui_status_value "Loading diff of [escape_path $path]..."
 567
 568         set cmd [list | git diff-index]
 569         lappend cmd --no-color
 570         if {$repo_config(gui.diffcontext) > 0} {
 571                 lappend cmd "-U$repo_config(gui.diffcontext)"
 572         }
 573         lappend cmd -p
 574
 575         switch $m {
 576         MM {
 577                 lappend cmd -c
 578         }
 579         _O {
 580                 if {[catch {
 581                                 set fd [open $path r]
 582                                 set content [read $fd]
 583                                 close $fd
 584                         } err ]} {
 585                         set diff_active 0
 586                         unlock_index
 587                         set ui_status_value "Unable to display [escape_path $path]"
 588                         error_popup "Error loading file:\n\n$err"
 589                         return
 590                 }
 591                 $ui_diff conf -state normal
 592                 $ui_diff insert end $content
 593                 $ui_diff conf -state disabled
 594                 set diff_active 0
 595                 unlock_index
 596                 set ui_status_value {Ready.}
 597                 return
 598         }
 599         }
 600
 601         lappend cmd [PARENT]
 602         lappend cmd --
 603         lappend cmd $path
 604
 605         if {[catch {set fd [open $cmd r]} err]} {
 606                 set diff_active 0
 607                 unlock_index
 608                 set ui_status_value "Unable to display [escape_path $path]"
 609                 error_popup "Error loading diff:\n\n$err"
 610                 return
 611         }
 612
 613         fconfigure $fd -blocking 0 -translation auto
 614         fileevent $fd readable [list read_diff $fd]
 615 }
 616
 617 proc read_diff {fd} {
 618         global ui_diff ui_status_value diff_3way diff_active
 619         global repo_config
 620
 621         while {[gets $fd line] >= 0} {
 622                 if {[string match {diff --git *} $line]} continue
 623                 if {[string match {diff --combined *} $line]} continue
 624                 if {[string match {--- *} $line]} continue
 625                 if {[string match {+++ *} $line]} continue
 626                 if {[string match index* $line]} {
 627                         if {[string first , $line] >= 0} {
 628                                 set diff_3way 1
 629                         }
 630                 }
 631
 632                 $ui_diff conf -state normal
 633                 if {!$diff_3way} {
 634                         set x [string index $line 0]
 635                         switch -- $x {
 636                         "@" {set tags da}
 637                         "+" {set tags dp}
 638                         "-" {set tags dm}
 639                         default {set tags {}}
 640                         }
 641                 } else {
 642                         set x [string range $line 0 1]
 643                         switch -- $x {
 644                         default {set tags {}}
 645                         "@@" {set tags da}
 646                         "++" {set tags dp; set x " +"}
 647                         " +" {set tags {di bold}; set x "++"}
 648                         "+ " {set tags dni; set x "-+"}
 649                         "--" {set tags dm; set x " -"}
 650                         " -" {set tags {dm bold}; set x "--"}
 651                         "- " {set tags di; set x "+-"}
 652                         default {set tags {}}
 653                         }
 654                         set line [string replace $line 0 1 $x]
 655                 }
 656                 $ui_diff insert end $line $tags
 657                 $ui_diff insert end "\n"
 658                 $ui_diff conf -state disabled
 659         }
 660
 661         if {[eof $fd]} {
 662                 close $fd
 663                 set diff_active 0
 664                 unlock_index
 665                 set ui_status_value {Ready.}
 666
 667                 if {$repo_config(gui.trustmtime) eq {true}
 668                         && [$ui_diff index end] eq {2.0}} {
 669                         handle_empty_diff
 670                 }
 671         }
 672 }
 673
 674 ######################################################################
 675 ##
 676 ## commit
 677
 678 proc load_last_commit {} {
 679         global HEAD PARENT commit_type ui_comm
 680
 681         if {[string match amend* $commit_type]} return
 682         if {$commit_type ne {normal}} {
 683                 error_popup "Can't amend a $commit_type commit."
 684                 return
 685         }
 686
 687         set msg {}
 688         set parent {}
 689         set parent_count 0
 690         if {[catch {
 691                         set fd [open "| git cat-file commit $HEAD" r]
 692                         while {[gets $fd line] > 0} {
 693                                 if {[string match {parent *} $line]} {
 694                                         set parent [string range $line 7 end]
 695                                         incr parent_count
 696                                 }
 697                         }
 698                         set msg [string trim [read $fd]]
 699                         close $fd
 700                 } err]} {
 701                 error_popup "Error loading commit data for amend:\n\n$err"
 702                 return
 703         }
 704
 705         if {$parent_count > 1} {
 706                 error_popup {Can't amend a merge commit.}
 707                 return
 708         }
 709
 710         if {$parent_count == 0} {
 711                 set commit_type amend-initial
 712                 set PARENT {}
 713         } elseif {$parent_count == 1} {
 714                 set commit_type amend
 715                 set PARENT $parent
 716         }
 717
 718         $ui_comm delete 0.0 end
 719         $ui_comm insert end $msg
 720         $ui_comm edit modified false
 721         $ui_comm edit reset
 722         rescan {set ui_status_value {Ready.}}
 723 }
 724
 725 proc commit_tree {} {
 726         global HEAD commit_type file_states ui_comm repo_config
 727
 728         if {![lock_index update]} return
 729
 730         # -- Our in memory state should match the repository.
 731         #
 732         repository_state curHEAD cur_type
 733         if {[string match amend* $commit_type]
 734                 && $cur_type eq {normal}
 735                 && $curHEAD eq $HEAD} {
 736         } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 737                 error_popup {Last scanned state does not match repository state.
 738
 739 Its highly likely that another Git program modified the
 740 repository since the last scan.  A rescan is required
 741 before committing.
 742
 743 A rescan will be automatically started now.
 744 }
 745                 unlock_index
 746                 rescan {set ui_status_value {Ready.}}
 747                 return
 748         }
 749
 750         # -- At least one file should differ in the index.
 751         #
 752         set files_ready 0
 753         foreach path [array names file_states] {
 754                 switch -glob -- [lindex $file_states($path) 0] {
 755                 _? {continue}
 756                 A? -
 757                 D? -
 758                 M? {set files_ready 1; break}
 759                 U? {
 760                         error_popup "Unmerged files cannot be committed.
 761
 762 File [short_path $path] has merge conflicts.
 763 You must resolve them and include the file before committing.
 764 "
 765                         unlock_index
 766                         return
 767                 }
 768                 default {
 769                         error_popup "Unknown file state [lindex $s 0] detected.
 770
 771 File [short_path $path] cannot be committed by this program.
 772 "
 773                 }
 774                 }
 775         }
 776         if {!$files_ready} {
 777                 error_popup {No included files to commit.
 778
 779 You must include at least 1 file before you can commit.
 780 }
 781                 unlock_index
 782                 return
 783         }
 784
 785         # -- A message is required.
 786         #
 787         set msg [string trim [$ui_comm get 1.0 end]]
 788         if {$msg eq {}} {
 789                 error_popup {Please supply a commit message.
 790
 791 A good commit message has the following format:
 792
 793 - First line: Describe in one sentance what you did.
 794 - Second line: Blank
 795 - Remaining lines: Describe why this change is good.
 796 }
 797                 unlock_index
 798                 return
 799         }
 800
 801         # -- Update included files if partialincludes are off.
 802         #
 803         if {$repo_config(gui.partialinclude) ne {true}} {
 804                 set pathList [list]
 805                 foreach path [array names file_states] {
 806                         switch -glob -- [lindex $file_states($path) 0] {
 807                         A? -
 808                         M? {lappend pathList $path}
 809                         }
 810                 }
 811                 if {$pathList ne {}} {
 812                         unlock_index
 813                         update_index \
 814                                 "Updating included files" \
 815                                 $pathList \
 816                                 [concat {lock_index update;} \
 817                                         [list commit_prehook $curHEAD $msg]]
 818                         return
 819                 }
 820         }
 821
 822         commit_prehook $curHEAD $msg
 823 }
 824
 825 proc commit_prehook {curHEAD msg} {
 826         global tcl_platform gitdir ui_status_value pch_error
 827
 828         # On Cygwin [file executable] might lie so we need to ask
 829         # the shell if the hook is executable.  Yes that's annoying.
 830
 831         set pchook [file join $gitdir hooks pre-commit]
 832         if {$tcl_platform(platform) eq {windows}
 833                 && [file isfile $pchook]} {
 834                 set pchook [list sh -c [concat \
 835                         "if test -x \"$pchook\";" \
 836                         "then exec \"$pchook\" 2>&1;" \
 837                         "fi"]]
 838         } elseif {[file executable $pchook]} {
 839                 set pchook [list $pchook |& cat]
 840         } else {
 841                 commit_writetree $curHEAD $msg
 842                 return
 843         }
 844
 845         set ui_status_value {Calling pre-commit hook...}
 846         set pch_error {}
 847         set fd_ph [open "| $pchook" r]
 848         fconfigure $fd_ph -blocking 0 -translation binary
 849         fileevent $fd_ph readable \
 850                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 851 }
 852
 853 proc commit_prehook_wait {fd_ph curHEAD msg} {
 854         global pch_error ui_status_value
 855
 856         append pch_error [read $fd_ph]
 857         fconfigure $fd_ph -blocking 1
 858         if {[eof $fd_ph]} {
 859                 if {[catch {close $fd_ph}]} {
 860                         set ui_status_value {Commit declined by pre-commit hook.}
 861                         hook_failed_popup pre-commit $pch_error
 862                         unlock_index
 863                 } else {
 864                         commit_writetree $curHEAD $msg
 865                 }
 866                 set pch_error {}
 867                 return
 868         }
 869         fconfigure $fd_ph -blocking 0
 870 }
 871
 872 proc commit_writetree {curHEAD msg} {
 873         global ui_status_value
 874
 875         set ui_status_value {Committing changes...}
 876         set fd_wt [open "| git write-tree" r]
 877         fileevent $fd_wt readable \
 878                 [list commit_committree $fd_wt $curHEAD $msg]
 879 }
 880
 881 proc commit_committree {fd_wt curHEAD msg} {
 882         global single_commit gitdir HEAD PARENT commit_type tcl_platform
 883         global ui_status_value ui_comm
 884         global file_states selected_paths
 885
 886         gets $fd_wt tree_id
 887         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 888                 error_popup "write-tree failed:\n\n$err"
 889                 set ui_status_value {Commit failed.}
 890                 unlock_index
 891                 return
 892         }
 893
 894         # -- Create the commit.
 895         #
 896         set cmd [list git commit-tree $tree_id]
 897         if {$PARENT ne {}} {
 898                 lappend cmd -p $PARENT
 899         }
 900         if {$commit_type eq {merge}} {
 901                 if {[catch {
 902                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 903                                 while {[gets $fd_mh merge_head] >= 0} {
 904                                         lappend cmd -p $merge_head
 905                                 }
 906                                 close $fd_mh
 907                         } err]} {
 908                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 909                         set ui_status_value {Commit failed.}
 910                         unlock_index
 911                         return
 912                 }
 913         }
 914         if {$PARENT eq {}} {
 915                 # git commit-tree writes to stderr during initial commit.
 916                 lappend cmd 2>/dev/null
 917         }
 918         lappend cmd << $msg
 919         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 920                 error_popup "commit-tree failed:\n\n$err"
 921                 set ui_status_value {Commit failed.}
 922                 unlock_index
 923                 return
 924         }
 925
 926         # -- Update the HEAD ref.
 927         #
 928         set reflogm commit
 929         if {$commit_type ne {normal}} {
 930                 append reflogm " ($commit_type)"
 931         }
 932         set i [string first "\n" $msg]
 933         if {$i >= 0} {
 934                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 935         } else {
 936                 append reflogm {: } $msg
 937         }
 938         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 939         if {[catch {eval exec $cmd} err]} {
 940                 error_popup "update-ref failed:\n\n$err"
 941                 set ui_status_value {Commit failed.}
 942                 unlock_index
 943                 return
 944         }
 945
 946         # -- Cleanup after ourselves.
 947         #
 948         catch {file delete [file join $gitdir MERGE_HEAD]}
 949         catch {file delete [file join $gitdir MERGE_MSG]}
 950         catch {file delete [file join $gitdir SQUASH_MSG]}
 951         catch {file delete [file join $gitdir GITGUI_MSG]}
 952
 953         # -- Let rerere do its thing.
 954         #
 955         if {[file isdirectory [file join $gitdir rr-cache]]} {
 956                 catch {exec git rerere}
 957         }
 958
 959         # -- Run the post-commit hook.
 960         #
 961         set pchook [file join $gitdir hooks post-commit]
 962         if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
 963                 set pchook [list sh -c [concat \
 964                         "if test -x \"$pchook\";" \
 965                         "then exec \"$pchook\";" \
 966                         "fi"]]
 967         } elseif {![file executable $pchook]} {
 968                 set pchook {}
 969         }
 970         if {$pchook ne {}} {
 971                 catch {exec $pchook &}
 972         }
 973
 974         $ui_comm delete 0.0 end
 975         $ui_comm edit modified false
 976         $ui_comm edit reset
 977
 978         if {$single_commit} do_quit
 979
 980         # -- Update status without invoking any git commands.
 981         #
 982         set commit_type normal
 983         set HEAD $cmt_id
 984         set PARENT $cmt_id
 985
 986         foreach path [array names file_states] {
 987                 set s $file_states($path)
 988                 set m [lindex $s 0]
 989                 switch -glob -- $m {
 990                 A? -
 991                 M? -
 992                 D? {set m _[string index $m 1]}
 993                 }
 994
 995                 if {$m eq {__}} {
 996                         unset file_states($path)
 997                         catch {unset selected_paths($path)}
 998                 } else {
 999                         lset file_states($path) 0 $m
1000                 }
1001         }
1002
1003         display_all_files
1004         unlock_index
1005         reshow_diff
1006         set ui_status_value \
1007                 "Changes committed as [string range $cmt_id 0 7]."
1008 }
1009
1010 ######################################################################
1011 ##
1012 ## fetch pull push
1013
1014 proc fetch_from {remote} {
1015         set w [new_console "fetch $remote" \
1016                 "Fetching new changes from $remote"]
1017         set cmd [list git fetch]
1018         lappend cmd $remote
1019         console_exec $w $cmd
1020 }
1021
1022 proc pull_remote {remote branch} {
1023         global HEAD commit_type file_states repo_config
1024
1025         if {![lock_index update]} return
1026
1027         # -- Our in memory state should match the repository.
1028         #
1029         repository_state curHEAD cur_type
1030         if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1031                 error_popup {Last scanned state does not match repository state.
1032
1033 Its highly likely that another Git program modified the
1034 repository since our last scan.  A rescan is required
1035 before a pull can be started.
1036 }
1037                 unlock_index
1038                 rescan {set ui_status_value {Ready.}}
1039                 return
1040         }
1041
1042         # -- No differences should exist before a pull.
1043         #
1044         if {[array size file_states] != 0} {
1045                 error_popup {Uncommitted but modified files are present.
1046
1047 You should not perform a pull with unmodified files in your working
1048 directory as Git would be unable to recover from an incorrect merge.
1049
1050 Commit or throw away all changes before starting a pull operation.
1051 }
1052                 unlock_index
1053                 return
1054         }
1055
1056         set w [new_console "pull $remote $branch" \
1057                 "Pulling new changes from branch $branch in $remote"]
1058         set cmd [list git pull]
1059         if {$repo_config(gui.pullsummary) eq {false}} {
1060                 lappend cmd --no-summary
1061         }
1062         lappend cmd $remote
1063         lappend cmd $branch
1064         console_exec $w $cmd [list post_pull_remote $remote $branch]
1065 }
1066
1067 proc post_pull_remote {remote branch success} {
1068         global HEAD PARENT commit_type
1069         global ui_status_value
1070
1071         unlock_index
1072         if {$success} {
1073                 repository_state HEAD commit_type
1074                 set PARENT $HEAD
1075                 set $ui_status_value "Pulling $branch from $remote complete."
1076         } else {
1077                 set m "Conflicts detected while pulling $branch from $remote."
1078                 rescan "set ui_status_value {$m}"
1079         }
1080 }
1081
1082 proc push_to {remote} {
1083         set w [new_console "push $remote" \
1084                 "Pushing changes to $remote"]
1085         set cmd [list git push]
1086         lappend cmd $remote
1087         console_exec $w $cmd
1088 }
1089
1090 ######################################################################
1091 ##
1092 ## ui helpers
1093
1094 proc mapcol {state path} {
1095         global all_cols ui_other
1096
1097         if {[catch {set r $all_cols($state)}]} {
1098                 puts "error: no column for state={$state} $path"
1099                 return $ui_other
1100         }
1101         return $r
1102 }
1103
1104 proc mapicon {state path} {
1105         global all_icons
1106
1107         if {[catch {set r $all_icons($state)}]} {
1108                 puts "error: no icon for state={$state} $path"
1109                 return file_plain
1110         }
1111         return $r
1112 }
1113
1114 proc mapdesc {state path} {
1115         global all_descs
1116
1117         if {[catch {set r $all_descs($state)}]} {
1118                 puts "error: no desc for state={$state} $path"
1119                 return $state
1120         }
1121         return $r
1122 }
1123
1124 proc escape_path {path} {
1125         regsub -all "\n" $path "\\n" path
1126         return $path
1127 }
1128
1129 proc short_path {path} {
1130         return [escape_path [lindex [file split $path] end]]
1131 }
1132
1133 set next_icon_id 0
1134
1135 proc merge_state {path new_state} {
1136         global file_states next_icon_id
1137
1138         set s0 [string index $new_state 0]
1139         set s1 [string index $new_state 1]
1140
1141         if {[catch {set info $file_states($path)}]} {
1142                 set state __
1143                 set icon n[incr next_icon_id]
1144         } else {
1145                 set state [lindex $info 0]
1146                 set icon [lindex $info 1]
1147         }
1148
1149         if {$s0 eq {?}} {
1150                 set s0 [string index $state 0]
1151         } elseif {$s0 eq {_}} {
1152                 set s0 _
1153         }
1154
1155         if {$s1 eq {?}} {
1156                 set s1 [string index $state 1]
1157         } elseif {$s1 eq {_}} {
1158                 set s1 _
1159         }
1160
1161         set file_states($path) [list $s0$s1 $icon]
1162         return $state
1163 }
1164
1165 proc display_file {path state} {
1166         global file_states file_lists selected_paths rescan_active
1167
1168         set old_m [merge_state $path $state]
1169         if {$rescan_active > 0} return
1170
1171         set s $file_states($path)
1172         set new_m [lindex $s 0]
1173         set new_w [mapcol $new_m $path]
1174         set old_w [mapcol $old_m $path]
1175         set new_icon [mapicon $new_m $path]
1176
1177         if {$new_w ne $old_w} {
1178                 set lno [lsearch -sorted $file_lists($old_w) $path]
1179                 if {$lno >= 0} {
1180                         incr lno
1181                         $old_w conf -state normal
1182                         $old_w delete $lno.0 [expr {$lno + 1}].0
1183                         $old_w conf -state disabled
1184                 }
1185
1186                 lappend file_lists($new_w) $path
1187                 set file_lists($new_w) [lsort $file_lists($new_w)]
1188                 set lno [lsearch -sorted $file_lists($new_w) $path]
1189                 incr lno
1190                 $new_w conf -state normal
1191                 $new_w image create $lno.0 \
1192                         -align center -padx 5 -pady 1 \
1193                         -name [lindex $s 1] \
1194                         -image $new_icon
1195                 $new_w insert $lno.1 "[escape_path $path]\n"
1196                 if {[catch {set in_sel $selected_paths($path)}]} {
1197                         set in_sel 0
1198                 }
1199                 if {$in_sel} {
1200                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1201                 }
1202                 $new_w conf -state disabled
1203         } elseif {$new_icon ne [mapicon $old_m $path]} {
1204                 $new_w conf -state normal
1205                 $new_w image conf [lindex $s 1] -image $new_icon
1206                 $new_w conf -state disabled
1207         }
1208 }
1209
1210 proc display_all_files {} {
1211         global ui_index ui_other
1212         global file_states file_lists
1213         global last_clicked selected_paths
1214
1215         $ui_index conf -state normal
1216         $ui_other conf -state normal
1217
1218         $ui_index delete 0.0 end
1219         $ui_other delete 0.0 end
1220         set last_clicked {}
1221
1222         set file_lists($ui_index) [list]
1223         set file_lists($ui_other) [list]
1224
1225         foreach path [lsort [array names file_states]] {
1226                 set s $file_states($path)
1227                 set m [lindex $s 0]
1228                 set w [mapcol $m $path]
1229                 lappend file_lists($w) $path
1230                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1231                 $w image create end \
1232                         -align center -padx 5 -pady 1 \
1233                         -name [lindex $s 1] \
1234                         -image [mapicon $m $path]
1235                 $w insert end "[escape_path $path]\n"
1236                 if {[catch {set in_sel $selected_paths($path)}]} {
1237                         set in_sel 0
1238                 }
1239                 if {$in_sel} {
1240                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1241                 }
1242         }
1243
1244         $ui_index conf -state disabled
1245         $ui_other conf -state disabled
1246 }
1247
1248 proc update_index {msg pathList after} {
1249         global update_index_cp ui_status_value
1250
1251         if {![lock_index update]} return
1252
1253         set update_index_cp 0
1254         set pathList [lsort $pathList]
1255         set totalCnt [llength $pathList]
1256         set batch [expr {int($totalCnt * .01) + 1}]
1257         if {$batch > 25} {set batch 25}
1258
1259         set ui_status_value [format \
1260                 "$msg... %i/%i files (%.2f%%)" \
1261                 $update_index_cp \
1262                 $totalCnt \
1263                 0.0]
1264         set fd [open "| git update-index --add --remove -z --stdin" w]
1265         fconfigure $fd \
1266                 -blocking 0 \
1267                 -buffering full \
1268                 -buffersize 512 \
1269                 -translation binary
1270         fileevent $fd writable [list \
1271                 write_update_index \
1272                 $fd \
1273                 $pathList \
1274                 $totalCnt \
1275                 $batch \
1276                 $msg \
1277                 $after \
1278                 ]
1279 }
1280
1281 proc write_update_index {fd pathList totalCnt batch msg after} {
1282         global update_index_cp ui_status_value
1283         global file_states current_diff
1284
1285         if {$update_index_cp >= $totalCnt} {
1286                 close $fd
1287                 unlock_index
1288                 uplevel #0 $after
1289                 return
1290         }
1291
1292         for {set i $batch} \
1293                 {$update_index_cp < $totalCnt && $i > 0} \
1294                 {incr i -1} {
1295                 set path [lindex $pathList $update_index_cp]
1296                 incr update_index_cp
1297
1298                 switch -glob -- [lindex $file_states($path) 0] {
1299                 AD -
1300                 MD -
1301                 _D {set new D_}
1302
1303                 _M -
1304                 MM -
1305                 M_ {set new M_}
1306
1307                 _O -
1308                 AM -
1309                 A_ {set new A_}
1310
1311                 ?? {continue}
1312                 }
1313
1314                 puts -nonewline $fd $path
1315                 puts -nonewline $fd "\0"
1316                 display_file $path $new
1317         }
1318
1319         set ui_status_value [format \
1320                 "$msg... %i/%i files (%.2f%%)" \
1321                 $update_index_cp \
1322                 $totalCnt \
1323                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1324 }
1325
1326 ######################################################################
1327 ##
1328 ## remote management
1329
1330 proc load_all_remotes {} {
1331         global gitdir all_remotes repo_config
1332
1333         set all_remotes [list]
1334         set rm_dir [file join $gitdir remotes]
1335         if {[file isdirectory $rm_dir]} {
1336                 set all_remotes [concat $all_remotes [glob \
1337                         -types f \
1338                         -tails \
1339                         -nocomplain \
1340                         -directory $rm_dir *]]
1341         }
1342
1343         foreach line [array names repo_config remote.*.url] {
1344                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1345                         lappend all_remotes $name
1346                 }
1347         }
1348
1349         set all_remotes [lsort -unique $all_remotes]
1350 }
1351
1352 proc populate_fetch_menu {m} {
1353         global gitdir all_remotes repo_config
1354
1355         foreach r $all_remotes {
1356                 set enable 0
1357                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1358                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1359                                 set enable 1
1360                         }
1361                 } else {
1362                         catch {
1363                                 set fd [open [file join $gitdir remotes $r] r]
1364                                 while {[gets $fd n] >= 0} {
1365                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1366                                                 set enable 1
1367                                                 break
1368                                         }
1369                                 }
1370                                 close $fd
1371                         }
1372                 }
1373
1374                 if {$enable} {
1375                         $m add command \
1376                                 -label "Fetch from $r..." \
1377                                 -command [list fetch_from $r] \
1378                                 -font font_ui
1379                 }
1380         }
1381 }
1382
1383 proc populate_push_menu {m} {
1384         global gitdir all_remotes repo_config
1385
1386         foreach r $all_remotes {
1387                 set enable 0
1388                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1389                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1390                                 set enable 1
1391                         }
1392                 } else {
1393                         catch {
1394                                 set fd [open [file join $gitdir remotes $r] r]
1395                                 while {[gets $fd n] >= 0} {
1396                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1397                                                 set enable 1
1398                                                 break
1399                                         }
1400                                 }
1401                                 close $fd
1402                         }
1403                 }
1404
1405                 if {$enable} {
1406                         $m add command \
1407                                 -label "Push to $r..." \
1408                                 -command [list push_to $r] \
1409                                 -font font_ui
1410                 }
1411         }
1412 }
1413
1414 proc populate_pull_menu {m} {
1415         global gitdir repo_config all_remotes disable_on_lock
1416
1417         foreach remote $all_remotes {
1418                 set rb {}
1419                 if {[array get repo_config remote.$remote.url] ne {}} {
1420                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1421                                 regexp {^([^:]+):} \
1422                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1423                                         line rb
1424                         }
1425                 } else {
1426                         catch {
1427                                 set fd [open [file join $gitdir remotes $remote] r]
1428                                 while {[gets $fd line] >= 0} {
1429                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1430                                                 break
1431                                         }
1432                                 }
1433                                 close $fd
1434                         }
1435                 }
1436
1437                 set rb_short $rb
1438                 regsub ^refs/heads/ $rb {} rb_short
1439                 if {$rb_short ne {}} {
1440                         $m add command \
1441                                 -label "Branch $rb_short from $remote..." \
1442                                 -command [list pull_remote $remote $rb] \
1443                                 -font font_ui
1444                         lappend disable_on_lock \
1445                                 [list $m entryconf [$m index last] -state]
1446                 }
1447         }
1448 }
1449
1450 ######################################################################
1451 ##
1452 ## icons
1453
1454 set filemask {
1455 #define mask_width 14
1456 #define mask_height 15
1457 static unsigned char mask_bits[] = {
1458    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1459    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1460    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1461 }
1462
1463 image create bitmap file_plain -background white -foreground black -data {
1464 #define plain_width 14
1465 #define plain_height 15
1466 static unsigned char plain_bits[] = {
1467    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1468    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1469    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1470 } -maskdata $filemask
1471
1472 image create bitmap file_mod -background white -foreground blue -data {
1473 #define mod_width 14
1474 #define mod_height 15
1475 static unsigned char mod_bits[] = {
1476    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1477    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1478    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1479 } -maskdata $filemask
1480
1481 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1482 #define file_fulltick_width 14
1483 #define file_fulltick_height 15
1484 static unsigned char file_fulltick_bits[] = {
1485    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1486    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1487    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1488 } -maskdata $filemask
1489
1490 image create bitmap file_parttick -background white -foreground "#005050" -data {
1491 #define parttick_width 14
1492 #define parttick_height 15
1493 static unsigned char parttick_bits[] = {
1494    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1495    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1496    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1497 } -maskdata $filemask
1498
1499 image create bitmap file_question -background white -foreground black -data {
1500 #define file_question_width 14
1501 #define file_question_height 15
1502 static unsigned char file_question_bits[] = {
1503    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1504    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1505    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1506 } -maskdata $filemask
1507
1508 image create bitmap file_removed -background white -foreground red -data {
1509 #define file_removed_width 14
1510 #define file_removed_height 15
1511 static unsigned char file_removed_bits[] = {
1512    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1513    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1514    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1515 } -maskdata $filemask
1516
1517 image create bitmap file_merge -background white -foreground blue -data {
1518 #define file_merge_width 14
1519 #define file_merge_height 15
1520 static unsigned char file_merge_bits[] = {
1521    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1522    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1523    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1524 } -maskdata $filemask
1525
1526 set ui_index .vpane.files.index.list
1527 set ui_other .vpane.files.other.list
1528 set max_status_desc 0
1529 foreach i {
1530                 {__ i plain    "Unmodified"}
1531                 {_M i mod      "Modified"}
1532                 {M_ i fulltick "Included in commit"}
1533                 {MM i parttick "Partially included"}
1534
1535                 {_O o plain    "Untracked"}
1536                 {A_ o fulltick "Added by commit"}
1537                 {AM o parttick "Partially added"}
1538                 {AD o question "Added (but now gone)"}
1539
1540                 {_D i question "Missing"}
1541                 {D_ i removed  "Removed by commit"}
1542                 {DD i removed  "Removed by commit"}
1543                 {DO i removed  "Removed (still exists)"}
1544
1545                 {UM i merge    "Merge conflicts"}
1546                 {U_ i merge    "Merge conflicts"}
1547         } {
1548         if {$max_status_desc < [string length [lindex $i 3]]} {
1549                 set max_status_desc [string length [lindex $i 3]]
1550         }
1551         if {[lindex $i 1] eq {i}} {
1552                 set all_cols([lindex $i 0]) $ui_index
1553         } else {
1554                 set all_cols([lindex $i 0]) $ui_other
1555         }
1556         set all_icons([lindex $i 0]) file_[lindex $i 2]
1557         set all_descs([lindex $i 0]) [lindex $i 3]
1558 }
1559 unset filemask i
1560
1561 ######################################################################
1562 ##
1563 ## util
1564
1565 proc is_MacOSX {} {
1566         global tcl_platform tk_library
1567         if {$tcl_platform(platform) eq {unix}
1568                 && $tcl_platform(os) eq {Darwin}
1569                 && [string match /Library/Frameworks/* $tk_library]} {
1570                 return 1
1571         }
1572         return 0
1573 }
1574
1575 proc bind_button3 {w cmd} {
1576         bind $w <Any-Button-3> $cmd
1577         if {[is_MacOSX]} {
1578                 bind $w <Control-Button-1> $cmd
1579         }
1580 }
1581
1582 proc incr_font_size {font {amt 1}} {
1583         set sz [font configure $font -size]
1584         incr sz $amt
1585         font configure $font -size $sz
1586         font configure ${font}bold -size $sz
1587 }
1588
1589 proc hook_failed_popup {hook msg} {
1590         global gitdir appname
1591
1592         set w .hookfail
1593         toplevel $w
1594
1595         frame $w.m
1596         label $w.m.l1 -text "$hook hook failed:" \
1597                 -anchor w \
1598                 -justify left \
1599                 -font font_uibold
1600         text $w.m.t \
1601                 -background white -borderwidth 1 \
1602                 -relief sunken \
1603                 -width 80 -height 10 \
1604                 -font font_diff \
1605                 -yscrollcommand [list $w.m.sby set]
1606         label $w.m.l2 \
1607                 -text {You must correct the above errors before committing.} \
1608                 -anchor w \
1609                 -justify left \
1610                 -font font_uibold
1611         scrollbar $w.m.sby -command [list $w.m.t yview]
1612         pack $w.m.l1 -side top -fill x
1613         pack $w.m.l2 -side bottom -fill x
1614         pack $w.m.sby -side right -fill y
1615         pack $w.m.t -side left -fill both -expand 1
1616         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1617
1618         $w.m.t insert 1.0 $msg
1619         $w.m.t conf -state disabled
1620
1621         button $w.ok -text OK \
1622                 -width 15 \
1623                 -font font_ui \
1624                 -command "destroy $w"
1625         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1626
1627         bind $w <Visibility> "grab $w; focus $w"
1628         bind $w <Key-Return> "destroy $w"
1629         wm title $w "$appname ([lindex [file split \
1630                 [file normalize [file dirname $gitdir]]] \
1631                 end]): error"
1632         tkwait window $w
1633 }
1634
1635 set next_console_id 0
1636
1637 proc new_console {short_title long_title} {
1638         global next_console_id console_data
1639         set w .console[incr next_console_id]
1640         set console_data($w) [list $short_title $long_title]
1641         return [console_init $w]
1642 }
1643
1644 proc console_init {w} {
1645         global console_cr console_data
1646         global gitdir appname M1B
1647
1648         set console_cr($w) 1.0
1649         toplevel $w
1650         frame $w.m
1651         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1652                 -anchor w \
1653                 -justify left \
1654                 -font font_uibold
1655         text $w.m.t \
1656                 -background white -borderwidth 1 \
1657                 -relief sunken \
1658                 -width 80 -height 10 \
1659                 -font font_diff \
1660                 -state disabled \
1661                 -yscrollcommand [list $w.m.sby set]
1662         label $w.m.s -text {Working... please wait...} \
1663                 -anchor w \
1664                 -justify left \
1665                 -font font_uibold
1666         scrollbar $w.m.sby -command [list $w.m.t yview]
1667         pack $w.m.l1 -side top -fill x
1668         pack $w.m.s -side bottom -fill x
1669         pack $w.m.sby -side right -fill y
1670         pack $w.m.t -side left -fill both -expand 1
1671         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1672
1673         menu $w.ctxm -tearoff 0
1674         $w.ctxm add command -label "Copy" \
1675                 -font font_ui \
1676                 -command "tk_textCopy $w.m.t"
1677         $w.ctxm add command -label "Select All" \
1678                 -font font_ui \
1679                 -command "$w.m.t tag add sel 0.0 end"
1680         $w.ctxm add command -label "Copy All" \
1681                 -font font_ui \
1682                 -command "
1683                         $w.m.t tag add sel 0.0 end
1684                         tk_textCopy $w.m.t
1685                         $w.m.t tag remove sel 0.0 end
1686                 "
1687
1688         button $w.ok -text {Close} \
1689                 -font font_ui \
1690                 -state disabled \
1691                 -command "destroy $w"
1692         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1693
1694         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1695         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1696         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1697         bind $w <Visibility> "focus $w"
1698         wm title $w "$appname ([lindex [file split \
1699                 [file normalize [file dirname $gitdir]]] \
1700                 end]): [lindex $console_data($w) 0]"
1701         return $w
1702 }
1703
1704 proc console_exec {w cmd {after {}}} {
1705         global tcl_platform
1706
1707         # -- Windows tosses the enviroment when we exec our child.
1708         #    But most users need that so we have to relogin. :-(
1709         #
1710         if {$tcl_platform(platform) eq {windows}} {
1711                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1712         }
1713
1714         # -- Tcl won't let us redirect both stdout and stderr to
1715         #    the same pipe.  So pass it through cat...
1716         #
1717         set cmd [concat | $cmd |& cat]
1718
1719         set fd_f [open $cmd r]
1720         fconfigure $fd_f -blocking 0 -translation binary
1721         fileevent $fd_f readable [list console_read $w $fd_f $after]
1722 }
1723
1724 proc console_read {w fd after} {
1725         global console_cr console_data
1726
1727         set buf [read $fd]
1728         if {$buf ne {}} {
1729                 if {![winfo exists $w]} {console_init $w}
1730                 $w.m.t conf -state normal
1731                 set c 0
1732                 set n [string length $buf]
1733                 while {$c < $n} {
1734                         set cr [string first "\r" $buf $c]
1735                         set lf [string first "\n" $buf $c]
1736                         if {$cr < 0} {set cr [expr {$n + 1}]}
1737                         if {$lf < 0} {set lf [expr {$n + 1}]}
1738
1739                         if {$lf < $cr} {
1740                                 $w.m.t insert end [string range $buf $c $lf]
1741                                 set console_cr($w) [$w.m.t index {end -1c}]
1742                                 set c $lf
1743                                 incr c
1744                         } else {
1745                                 $w.m.t delete $console_cr($w) end
1746                                 $w.m.t insert end "\n"
1747                                 $w.m.t insert end [string range $buf $c $cr]
1748                                 set c $cr
1749                                 incr c
1750                         }
1751                 }
1752                 $w.m.t conf -state disabled
1753                 $w.m.t see end
1754         }
1755
1756         fconfigure $fd -blocking 1
1757         if {[eof $fd]} {
1758                 if {[catch {close $fd}]} {
1759                         if {![winfo exists $w]} {console_init $w}
1760                         $w.m.s conf -background red -text {Error: Command Failed}
1761                         $w.ok conf -state normal
1762                         set ok 0
1763                 } elseif {[winfo exists $w]} {
1764                         $w.m.s conf -background green -text {Success}
1765                         $w.ok conf -state normal
1766                         set ok 1
1767                 }
1768                 array unset console_cr $w
1769                 array unset console_data $w
1770                 if {$after ne {}} {
1771                         uplevel #0 $after $ok
1772                 }
1773                 return
1774         }
1775         fconfigure $fd -blocking 0
1776 }
1777
1778 ######################################################################
1779 ##
1780 ## ui commands
1781
1782 set starting_gitk_msg {Please wait... Starting gitk...}
1783
1784 proc do_gitk {} {
1785         global tcl_platform ui_status_value starting_gitk_msg
1786
1787         set ui_status_value $starting_gitk_msg
1788         after 10000 {
1789                 if {$ui_status_value eq $starting_gitk_msg} {
1790                         set ui_status_value {Ready.}
1791                 }
1792         }
1793
1794         if {$tcl_platform(platform) eq {windows}} {
1795                 exec sh -c gitk &
1796         } else {
1797                 exec gitk &
1798         }
1799 }
1800
1801 proc do_repack {} {
1802         set w [new_console "repack" "Repacking the object database"]
1803         set cmd [list git repack]
1804         lappend cmd -a
1805         lappend cmd -d
1806         console_exec $w $cmd
1807 }
1808
1809 set is_quitting 0
1810
1811 proc do_quit {} {
1812         global gitdir ui_comm is_quitting repo_config
1813
1814         if {$is_quitting} return
1815         set is_quitting 1
1816
1817         # -- Stash our current commit buffer.
1818         #
1819         set save [file join $gitdir GITGUI_MSG]
1820         set msg [string trim [$ui_comm get 0.0 end]]
1821         if {[$ui_comm edit modified] && $msg ne {}} {
1822                 catch {
1823                         set fd [open $save w]
1824                         puts $fd [string trim [$ui_comm get 0.0 end]]
1825                         close $fd
1826                 }
1827         } elseif {$msg eq {} && [file exists $save]} {
1828                 file delete $save
1829         }
1830
1831         # -- Stash our current window geometry into this repository.
1832         #
1833         set cfg_geometry [list]
1834         lappend cfg_geometry [wm geometry .]
1835         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1836         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1837         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1838                 set rc_geometry {}
1839         }
1840         if {$cfg_geometry ne $rc_geometry} {
1841                 catch {exec git repo-config gui.geometry $cfg_geometry}
1842         }
1843
1844         destroy .
1845 }
1846
1847 proc do_rescan {} {
1848         rescan {set ui_status_value {Ready.}}
1849 }
1850
1851 proc include_helper {txt paths} {
1852         global file_states current_diff
1853
1854         if {![lock_index begin-update]} return
1855
1856         set pathList [list]
1857         set after {}
1858         foreach path $paths {
1859                 switch -- [lindex $file_states($path) 0] {
1860                 AM -
1861                 MM -
1862                 _M -
1863                 _D {
1864                         lappend pathList $path
1865                         if {$path eq $current_diff} {
1866                                 set after {reshow_diff;}
1867                         }
1868                 }
1869                 }
1870         }
1871         if {$pathList eq {}} {
1872                 unlock_index
1873         } else {
1874                 update_index \
1875                         $txt \
1876                         $pathList \
1877                         [concat $after {set ui_status_value {Ready to commit.}}]
1878         }
1879 }
1880
1881 proc do_include_selection {} {
1882         global current_diff selected_paths
1883
1884         if {[array size selected_paths] > 0} {
1885                 include_helper \
1886                         {Including selected files} \
1887                         [array names selected_paths]
1888         } elseif {$current_diff ne {}} {
1889                 include_helper \
1890                         "Including [short_path $current_diff]" \
1891                         [list $current_diff]
1892         }
1893 }
1894
1895 proc do_include_all {} {
1896         global file_states
1897         include_helper \
1898                 {Including all modified files} \
1899                 [array names file_states]
1900 }
1901
1902 set GIT_COMMITTER_IDENT {}
1903
1904 proc do_signoff {} {
1905         global ui_comm GIT_COMMITTER_IDENT
1906
1907         if {$GIT_COMMITTER_IDENT eq {}} {
1908                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1909                         error_popup "Unable to obtain your identity:\n\n$err"
1910                         return
1911                 }
1912                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1913                         $me me GIT_COMMITTER_IDENT]} {
1914                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1915                         return
1916                 }
1917         }
1918
1919         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1920         set last [$ui_comm get {end -1c linestart} {end -1c}]
1921         if {$last ne $sob} {
1922                 $ui_comm edit separator
1923                 if {$last ne {}
1924                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1925                         $ui_comm insert end "\n"
1926                 }
1927                 $ui_comm insert end "\n$sob"
1928                 $ui_comm edit separator
1929                 $ui_comm see end
1930         }
1931 }
1932
1933 proc do_amend_last {} {
1934         load_last_commit
1935 }
1936
1937 proc do_commit {} {
1938         commit_tree
1939 }
1940
1941 proc do_options {} {
1942         global appname gitdir font_descs
1943         global repo_config global_config
1944         global repo_config_new global_config_new
1945
1946         array unset repo_config_new
1947         array unset global_config_new
1948         foreach name [array names repo_config] {
1949                 set repo_config_new($name) $repo_config($name)
1950         }
1951         load_config 1
1952         foreach name [array names repo_config] {
1953                 switch -- $name {
1954                 gui.diffcontext {continue}
1955                 }
1956                 set repo_config_new($name) $repo_config($name)
1957         }
1958         foreach name [array names global_config] {
1959                 set global_config_new($name) $global_config($name)
1960         }
1961         set reponame [lindex [file split \
1962                 [file normalize [file dirname $gitdir]]] \
1963                 end]
1964
1965         set w .options_editor
1966         toplevel $w
1967         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1968
1969         label $w.header -text "$appname Options" \
1970                 -font font_uibold
1971         pack $w.header -side top -fill x
1972
1973         frame $w.buttons
1974         button $w.buttons.restore -text {Restore Defaults} \
1975                 -font font_ui \
1976                 -command do_restore_defaults
1977         pack $w.buttons.restore -side left
1978         button $w.buttons.save -text Save \
1979                 -font font_ui \
1980                 -command [list do_save_config $w]
1981         pack $w.buttons.save -side right
1982         button $w.buttons.cancel -text {Cancel} \
1983                 -font font_ui \
1984                 -command [list destroy $w]
1985         pack $w.buttons.cancel -side right
1986         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1987
1988         labelframe $w.repo -text "$reponame Repository" \
1989                 -font font_ui \
1990                 -relief raised -borderwidth 2
1991         labelframe $w.global -text {Global (All Repositories)} \
1992                 -font font_ui \
1993                 -relief raised -borderwidth 2
1994         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1995         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1996
1997         foreach option {
1998                 {b partialinclude {Allow Partially Included Files}}
1999                 {b pullsummary {Show Pull Summary}}
2000                 {b trustmtime  {Trust File Modification Timestamps}}
2001                 {i diffcontext {Number of Diff Context Lines}}
2002                 } {
2003                 set type [lindex $option 0]
2004                 set name [lindex $option 1]
2005                 set text [lindex $option 2]
2006                 foreach f {repo global} {
2007                         switch $type {
2008                         b {
2009                                 checkbutton $w.$f.$name -text $text \
2010                                         -variable ${f}_config_new(gui.$name) \
2011                                         -onvalue true \
2012                                         -offvalue false \
2013                                         -font font_ui
2014                                 pack $w.$f.$name -side top -anchor w
2015                         }
2016                         i {
2017                                 frame $w.$f.$name
2018                                 label $w.$f.$name.l -text "$text:" -font font_ui
2019                                 pack $w.$f.$name.l -side left -anchor w -fill x
2020                                 spinbox $w.$f.$name.v \
2021                                         -textvariable ${f}_config_new(gui.$name) \
2022                                         -from 1 -to 99 -increment 1 \
2023                                         -width 3 \
2024                                         -font font_ui
2025                                 pack $w.$f.$name.v -side right -anchor e
2026                                 pack $w.$f.$name -side top -anchor w -fill x
2027                         }
2028                         }
2029                 }
2030         }
2031
2032         set all_fonts [lsort [font families]]
2033         foreach option $font_descs {
2034                 set name [lindex $option 0]
2035                 set font [lindex $option 1]
2036                 set text [lindex $option 2]
2037
2038                 set global_config_new(gui.$font^^family) \
2039                         [font configure $font -family]
2040                 set global_config_new(gui.$font^^size) \
2041                         [font configure $font -size]
2042
2043                 frame $w.global.$name
2044                 label $w.global.$name.l -text "$text:" -font font_ui
2045                 pack $w.global.$name.l -side left -anchor w -fill x
2046                 eval tk_optionMenu $w.global.$name.family \
2047                         global_config_new(gui.$font^^family) \
2048                         $all_fonts
2049                 spinbox $w.global.$name.size \
2050                         -textvariable global_config_new(gui.$font^^size) \
2051                         -from 2 -to 80 -increment 1 \
2052                         -width 3 \
2053                         -font font_ui
2054                 pack $w.global.$name.size -side right -anchor e
2055                 pack $w.global.$name.family -side right -anchor e
2056                 pack $w.global.$name -side top -anchor w -fill x
2057         }
2058
2059         bind $w <Visibility> "grab $w; focus $w"
2060         bind $w <Key-Escape> "destroy $w"
2061         wm title $w "$appname ($reponame): Options"
2062         tkwait window $w
2063 }
2064
2065 proc do_restore_defaults {} {
2066         global font_descs default_config repo_config
2067         global repo_config_new global_config_new
2068
2069         foreach name [array names default_config] {
2070                 set repo_config_new($name) $default_config($name)
2071                 set global_config_new($name) $default_config($name)
2072         }
2073
2074         foreach option $font_descs {
2075                 set name [lindex $option 0]
2076                 set repo_config(gui.$name) $default_config(gui.$name)
2077         }
2078         apply_config
2079
2080         foreach option $font_descs {
2081                 set name [lindex $option 0]
2082                 set font [lindex $option 1]
2083                 set global_config_new(gui.$font^^family) \
2084                         [font configure $font -family]
2085                 set global_config_new(gui.$font^^size) \
2086                         [font configure $font -size]
2087         }
2088 }
2089
2090 proc do_save_config {w} {
2091         if {[catch {save_config} err]} {
2092                 error_popup "Failed to completely save options:\n\n$err"
2093         }
2094         reshow_diff
2095         destroy $w
2096 }
2097
2098 proc do_windows_shortcut {} {
2099         global gitdir appname argv0
2100
2101         set reponame [lindex [file split \
2102                 [file normalize [file dirname $gitdir]]] \
2103                 end]
2104
2105         if {[catch {
2106                 set desktop [exec cygpath \
2107                         --windows \
2108                         --absolute \
2109                         --long-name \
2110                         --desktop]
2111                 }]} {
2112                         set desktop .
2113         }
2114         set fn [tk_getSaveFile \
2115                 -parent . \
2116                 -title "$appname ($reponame): Create Desktop Icon" \
2117                 -initialdir $desktop \
2118                 -initialfile "Git $reponame.bat"]
2119         if {$fn != {}} {
2120                 if {[catch {
2121                                 set fd [open $fn w]
2122                                 set sh [exec cygpath \
2123                                         --windows \
2124                                         --absolute \
2125                                         --long-name \
2126                                         /bin/sh]
2127                                 set me [exec cygpath \
2128                                         --unix \
2129                                         --absolute \
2130                                         $argv0]
2131                                 set gd [exec cygpath \
2132                                         --unix \
2133                                         --absolute \
2134                                         $gitdir]
2135                                 regsub -all ' $me "'\\''" me
2136                                 regsub -all ' $gd "'\\''" gd
2137                                 puts -nonewline $fd "\"$sh\" --login -c \""
2138                                 puts -nonewline $fd "GIT_DIR='$gd'"
2139                                 puts -nonewline $fd " '$me'"
2140                                 puts $fd "&\""
2141                                 close $fd
2142                         } err]} {
2143                         error_popup "Cannot write script:\n\n$err"
2144                 }
2145         }
2146 }
2147
2148 proc do_macosx_app {} {
2149         global gitdir appname argv0 env
2150
2151         set reponame [lindex [file split \
2152                 [file normalize [file dirname $gitdir]]] \
2153                 end]
2154
2155         set fn [tk_getSaveFile \
2156                 -parent . \
2157                 -title "$appname ($reponame): Create Desktop Icon" \
2158                 -initialdir [file join $env(HOME) Desktop] \
2159                 -initialfile "Git $reponame.app"]
2160         if {$fn != {}} {
2161                 if {[catch {
2162                                 set Contents [file join $fn Contents]
2163                                 set MacOS [file join $Contents MacOS]
2164                                 set exe [file join $MacOS git-gui]
2165
2166                                 file mkdir $MacOS
2167
2168                                 set fd [open [file join $Contents PkgInfo] w]
2169                                 puts -nonewline $fd {APPL????}
2170                                 close $fd
2171
2172                                 set fd [open [file join $Contents Info.plist] w]
2173                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2174 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2175 <plist version="1.0">
2176 <dict>
2177         <key>CFBundleDevelopmentRegion</key>
2178         <string>English</string>
2179         <key>CFBundleExecutable</key>
2180         <string>git-gui</string>
2181         <key>CFBundleIdentifier</key>
2182         <string>org.spearce.git-gui</string>
2183         <key>CFBundleInfoDictionaryVersion</key>
2184         <string>6.0</string>
2185         <key>CFBundlePackageType</key>
2186         <string>APPL</string>
2187         <key>CFBundleSignature</key>
2188         <string>????</string>
2189         <key>CFBundleVersion</key>
2190         <string>1.0</string>
2191         <key>NSPrincipalClass</key>
2192         <string>NSApplication</string>
2193 </dict>
2194 </plist>}
2195                                 close $fd
2196
2197                                 set fd [open $exe w]
2198                                 set gd [file normalize $gitdir]
2199                                 set ep [file normalize [exec git --exec-path]]
2200                                 regsub -all ' $gd "'\\''" gd
2201                                 regsub -all ' $ep "'\\''" ep
2202                                 puts $fd "#!/bin/sh"
2203                                 foreach name [array names env] {
2204                                         if {[string match GIT_* $name]} {
2205                                                 regsub -all ' $env($name) "'\\''" v
2206                                                 puts $fd "export $name='$v'"
2207                                         }
2208                                 }
2209                                 puts $fd "export PATH='$ep':\$PATH"
2210                                 puts $fd "export GIT_DIR='$gd'"
2211                                 puts $fd "exec [file normalize $argv0]"
2212                                 close $fd
2213
2214                                 file attributes $exe -permissions u+x,g+x,o+x
2215                         } err]} {
2216                         error_popup "Cannot write icon:\n\n$err"
2217                 }
2218         }
2219 }
2220
2221 proc toggle_or_diff {w x y} {
2222         global file_lists current_diff ui_index ui_other
2223         global last_clicked selected_paths
2224
2225         set pos [split [$w index @$x,$y] .]
2226         set lno [lindex $pos 0]
2227         set col [lindex $pos 1]
2228         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2229         if {$path eq {}} {
2230                 set last_clicked {}
2231                 return
2232         }
2233
2234         set last_clicked [list $w $lno]
2235         array unset selected_paths
2236         $ui_index tag remove in_sel 0.0 end
2237         $ui_other tag remove in_sel 0.0 end
2238
2239         if {$col == 0} {
2240                 if {$current_diff eq $path} {
2241                         set after {reshow_diff;}
2242                 } else {
2243                         set after {}
2244                 }
2245                 update_index \
2246                         "Including [short_path $path]" \
2247                         [list $path] \
2248                         [concat $after {set ui_status_value {Ready.}}]
2249         } else {
2250                 show_diff $path $w $lno
2251         }
2252 }
2253
2254 proc add_one_to_selection {w x y} {
2255         global file_lists
2256         global last_clicked selected_paths
2257
2258         set pos [split [$w index @$x,$y] .]
2259         set lno [lindex $pos 0]
2260         set col [lindex $pos 1]
2261         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2262         if {$path eq {}} {
2263                 set last_clicked {}
2264                 return
2265         }
2266
2267         set last_clicked [list $w $lno]
2268         if {[catch {set in_sel $selected_paths($path)}]} {
2269                 set in_sel 0
2270         }
2271         if {$in_sel} {
2272                 unset selected_paths($path)
2273                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2274         } else {
2275                 set selected_paths($path) 1
2276                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2277         }
2278 }
2279
2280 proc add_range_to_selection {w x y} {
2281         global file_lists
2282         global last_clicked selected_paths
2283
2284         if {[lindex $last_clicked 0] ne $w} {
2285                 toggle_or_diff $w $x $y
2286                 return
2287         }
2288
2289         set pos [split [$w index @$x,$y] .]
2290         set lno [lindex $pos 0]
2291         set lc [lindex $last_clicked 1]
2292         if {$lc < $lno} {
2293                 set begin $lc
2294                 set end $lno
2295         } else {
2296                 set begin $lno
2297                 set end $lc
2298         }
2299
2300         foreach path [lrange $file_lists($w) \
2301                 [expr {$begin - 1}] \
2302                 [expr {$end - 1}]] {
2303                 set selected_paths($path) 1
2304         }
2305         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2306 }
2307
2308 ######################################################################
2309 ##
2310 ## config defaults
2311
2312 set cursor_ptr arrow
2313 font create font_diff -family Courier -size 10
2314 font create font_ui
2315 catch {
2316         label .dummy
2317         eval font configure font_ui [font actual [.dummy cget -font]]
2318         destroy .dummy
2319 }
2320
2321 font create font_uibold
2322 font create font_diffbold
2323
2324 set M1B M1
2325 set M1T M1
2326 if {$tcl_platform(platform) eq {windows}} {
2327         set M1B Control
2328         set M1T Ctrl
2329 } elseif {[is_MacOSX]} {
2330         set M1B M1
2331         set M1T Cmd
2332 }
2333
2334 proc apply_config {} {
2335         global repo_config font_descs
2336
2337         foreach option $font_descs {
2338                 set name [lindex $option 0]
2339                 set font [lindex $option 1]
2340                 if {[catch {
2341                         foreach {cn cv} $repo_config(gui.$name) {
2342                                 font configure $font $cn $cv
2343                         }
2344                         } err]} {
2345                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2346                 }
2347                 foreach {cn cv} [font configure $font] {
2348                         font configure ${font}bold $cn $cv
2349                 }
2350                 font configure ${font}bold -weight bold
2351         }
2352 }
2353
2354 set default_config(gui.trustmtime) false
2355 set default_config(gui.pullsummary) true
2356 set default_config(gui.partialinclude) false
2357 set default_config(gui.diffcontext) 5
2358 set default_config(gui.fontui) [font configure font_ui]
2359 set default_config(gui.fontdiff) [font configure font_diff]
2360 set font_descs {
2361         {fontui   font_ui   {Main Font}}
2362         {fontdiff font_diff {Diff/Console Font}}
2363 }
2364 load_config 0
2365 apply_config
2366
2367 ######################################################################
2368 ##
2369 ## ui construction
2370
2371 # -- Menu Bar
2372 #
2373 menu .mbar -tearoff 0
2374 .mbar add cascade -label Project -menu .mbar.project
2375 .mbar add cascade -label Edit -menu .mbar.edit
2376 .mbar add cascade -label Commit -menu .mbar.commit
2377 if {!$single_commit} {
2378         .mbar add cascade -label Fetch -menu .mbar.fetch
2379         .mbar add cascade -label Pull -menu .mbar.pull
2380         .mbar add cascade -label Push -menu .mbar.push
2381 }
2382 . configure -menu .mbar
2383
2384 # -- Project Menu
2385 #
2386 menu .mbar.project
2387 .mbar.project add command -label Visualize \
2388         -command do_gitk \
2389         -font font_ui
2390 if {!$single_commit} {
2391         .mbar.project add command -label {Repack Database} \
2392                 -command do_repack \
2393                 -font font_ui
2394
2395         if {$tcl_platform(platform) eq {windows}} {
2396                 .mbar.project add command \
2397                         -label {Create Desktop Icon} \
2398                         -command do_windows_shortcut \
2399                         -font font_ui
2400         } elseif {[is_MacOSX]} {
2401                 .mbar.project add command \
2402                         -label {Create Desktop Icon} \
2403                         -command do_macosx_app \
2404                         -font font_ui
2405         }
2406 }
2407 .mbar.project add command -label Quit \
2408         -command do_quit \
2409         -accelerator $M1T-Q \
2410         -font font_ui
2411
2412 # -- Edit Menu
2413 #
2414 menu .mbar.edit
2415 .mbar.edit add command -label Undo \
2416         -command {catch {[focus] edit undo}} \
2417         -accelerator $M1T-Z \
2418         -font font_ui
2419 .mbar.edit add command -label Redo \
2420         -command {catch {[focus] edit redo}} \
2421         -accelerator $M1T-Y \
2422         -font font_ui
2423 .mbar.edit add separator
2424 .mbar.edit add command -label Cut \
2425         -command {catch {tk_textCut [focus]}} \
2426         -accelerator $M1T-X \
2427         -font font_ui
2428 .mbar.edit add command -label Copy \
2429         -command {catch {tk_textCopy [focus]}} \
2430         -accelerator $M1T-C \
2431         -font font_ui
2432 .mbar.edit add command -label Paste \
2433         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2434         -accelerator $M1T-V \
2435         -font font_ui
2436 .mbar.edit add command -label Delete \
2437         -command {catch {[focus] delete sel.first sel.last}} \
2438         -accelerator Del \
2439         -font font_ui
2440 .mbar.edit add separator
2441 .mbar.edit add command -label {Select All} \
2442         -command {catch {[focus] tag add sel 0.0 end}} \
2443         -accelerator $M1T-A \
2444         -font font_ui
2445 .mbar.edit add separator
2446 .mbar.edit add command -label {Options...} \
2447         -command do_options \
2448         -font font_ui
2449
2450 # -- Commit Menu
2451 #
2452 menu .mbar.commit
2453 .mbar.commit add command -label Rescan \
2454         -command do_rescan \
2455         -accelerator F5 \
2456         -font font_ui
2457 lappend disable_on_lock \
2458         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2459 .mbar.commit add command -label {Amend Last Commit} \
2460         -command do_amend_last \
2461         -font font_ui
2462 lappend disable_on_lock \
2463         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2464 .mbar.commit add command -label {Include Selected Files} \
2465         -command do_include_selection \
2466         -font font_ui
2467 lappend disable_on_lock \
2468         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2469 .mbar.commit add command -label {Include All Files} \
2470         -command do_include_all \
2471         -accelerator $M1T-I \
2472         -font font_ui
2473 lappend disable_on_lock \
2474         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2475 .mbar.commit add command -label {Sign Off} \
2476         -command do_signoff \
2477         -accelerator $M1T-S \
2478         -font font_ui
2479 .mbar.commit add command -label Commit \
2480         -command do_commit \
2481         -accelerator $M1T-Return \
2482         -font font_ui
2483 lappend disable_on_lock \
2484         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2485
2486 # -- Transport menus
2487 #
2488 if {!$single_commit} {
2489         menu .mbar.fetch
2490         menu .mbar.pull
2491         menu .mbar.push
2492 }
2493
2494 # -- Main Window Layout
2495 #
2496 panedwindow .vpane -orient vertical
2497 panedwindow .vpane.files -orient horizontal
2498 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2499 pack .vpane -anchor n -side top -fill both -expand 1
2500
2501 # -- Index File List
2502 #
2503 frame .vpane.files.index -height 100 -width 400
2504 label .vpane.files.index.title -text {Modified Files} \
2505         -background green \
2506         -font font_ui
2507 text $ui_index -background white -borderwidth 0 \
2508         -width 40 -height 10 \
2509         -font font_ui \
2510         -cursor $cursor_ptr \
2511         -yscrollcommand {.vpane.files.index.sb set} \
2512         -state disabled
2513 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2514 pack .vpane.files.index.title -side top -fill x
2515 pack .vpane.files.index.sb -side right -fill y
2516 pack $ui_index -side left -fill both -expand 1
2517 .vpane.files add .vpane.files.index -sticky nsew
2518
2519 # -- Other (Add) File List
2520 #
2521 frame .vpane.files.other -height 100 -width 100
2522 label .vpane.files.other.title -text {Untracked Files} \
2523         -background red \
2524         -font font_ui
2525 text $ui_other -background white -borderwidth 0 \
2526         -width 40 -height 10 \
2527         -font font_ui \
2528         -cursor $cursor_ptr \
2529         -yscrollcommand {.vpane.files.other.sb set} \
2530         -state disabled
2531 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2532 pack .vpane.files.other.title -side top -fill x
2533 pack .vpane.files.other.sb -side right -fill y
2534 pack $ui_other -side left -fill both -expand 1
2535 .vpane.files add .vpane.files.other -sticky nsew
2536
2537 foreach i [list $ui_index $ui_other] {
2538         $i tag conf in_diff -font font_uibold
2539         $i tag conf in_sel \
2540                 -background [$i cget -foreground] \
2541                 -foreground [$i cget -background]
2542 }
2543 unset i
2544
2545 # -- Diff and Commit Area
2546 #
2547 frame .vpane.lower -height 300 -width 400
2548 frame .vpane.lower.commarea
2549 frame .vpane.lower.diff -relief sunken -borderwidth 1
2550 pack .vpane.lower.commarea -side top -fill x
2551 pack .vpane.lower.diff -side bottom -fill both -expand 1
2552 .vpane add .vpane.lower -stick nsew
2553
2554 # -- Commit Area Buttons
2555 #
2556 frame .vpane.lower.commarea.buttons
2557 label .vpane.lower.commarea.buttons.l -text {} \
2558         -anchor w \
2559         -justify left \
2560         -font font_ui
2561 pack .vpane.lower.commarea.buttons.l -side top -fill x
2562 pack .vpane.lower.commarea.buttons -side left -fill y
2563
2564 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2565         -command do_rescan \
2566         -font font_ui
2567 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2568 lappend disable_on_lock \
2569         {.vpane.lower.commarea.buttons.rescan conf -state}
2570
2571 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2572         -command do_amend_last \
2573         -font font_ui
2574 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2575 lappend disable_on_lock \
2576         {.vpane.lower.commarea.buttons.amend conf -state}
2577
2578 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2579         -command do_include_all \
2580         -font font_ui
2581 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2582 lappend disable_on_lock \
2583         {.vpane.lower.commarea.buttons.incall conf -state}
2584
2585 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2586         -command do_signoff \
2587         -font font_ui
2588 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2589
2590 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2591         -command do_commit \
2592         -font font_ui
2593 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2594 lappend disable_on_lock \
2595         {.vpane.lower.commarea.buttons.commit conf -state}
2596
2597 # -- Commit Message Buffer
2598 #
2599 frame .vpane.lower.commarea.buffer
2600 set ui_comm .vpane.lower.commarea.buffer.t
2601 set ui_coml .vpane.lower.commarea.buffer.l
2602 label $ui_coml \
2603         -anchor w \
2604         -justify left \
2605         -font font_ui
2606 proc trace_commit_type {varname args} {
2607         global ui_coml commit_type
2608         switch -glob -- $commit_type {
2609         initial       {set txt {Initial Commit Message:}}
2610         amend         {set txt {Amended Commit Message:}}
2611         amend-initial {set txt {Amended Initial Commit Message:}}
2612         merge         {set txt {Merge Commit Message:}}
2613         *             {set txt {Commit Message:}}
2614         }
2615         $ui_coml conf -text $txt
2616 }
2617 trace add variable commit_type write trace_commit_type
2618 text $ui_comm -background white -borderwidth 1 \
2619         -undo true \
2620         -maxundo 20 \
2621         -autoseparators true \
2622         -relief sunken \
2623         -width 75 -height 9 -wrap none \
2624         -font font_diff \
2625         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2626 scrollbar .vpane.lower.commarea.buffer.sby \
2627         -command [list $ui_comm yview]
2628 pack $ui_coml -side top -fill x
2629 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2630 pack $ui_comm -side left -fill y
2631 pack .vpane.lower.commarea.buffer -side left -fill y
2632
2633 # -- Commit Message Buffer Context Menu
2634 #
2635 set ctxm .vpane.lower.commarea.buffer.ctxm
2636 menu $ctxm -tearoff 0
2637 $ctxm add command \
2638         -label {Cut} \
2639         -font font_ui \
2640         -command {tk_textCut $ui_comm}
2641 $ctxm add command \
2642         -label {Copy} \
2643         -font font_ui \
2644         -command {tk_textCopy $ui_comm}
2645 $ctxm add command \
2646         -label {Paste} \
2647         -font font_ui \
2648         -command {tk_textPaste $ui_comm}
2649 $ctxm add command \
2650         -label {Delete} \
2651         -font font_ui \
2652         -command {$ui_comm delete sel.first sel.last}
2653 $ctxm add separator
2654 $ctxm add command \
2655         -label {Select All} \
2656         -font font_ui \
2657         -command {$ui_comm tag add sel 0.0 end}
2658 $ctxm add command \
2659         -label {Copy All} \
2660         -font font_ui \
2661         -command {
2662                 $ui_comm tag add sel 0.0 end
2663                 tk_textCopy $ui_comm
2664                 $ui_comm tag remove sel 0.0 end
2665         }
2666 $ctxm add separator
2667 $ctxm add command \
2668         -label {Sign Off} \
2669         -font font_ui \
2670         -command do_signoff
2671 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2672
2673 # -- Diff Header
2674 #
2675 set current_diff {}
2676 set diff_actions [list]
2677 proc trace_current_diff {varname args} {
2678         global current_diff diff_actions file_states
2679         if {$current_diff eq {}} {
2680                 set s {}
2681                 set f {}
2682                 set p {}
2683                 set o disabled
2684         } else {
2685                 set p $current_diff
2686                 set s [mapdesc [lindex $file_states($p) 0] $p]
2687                 set f {File:}
2688                 set p [escape_path $p]
2689                 set o normal
2690         }
2691
2692         .vpane.lower.diff.header.status configure -text $s
2693         .vpane.lower.diff.header.file configure -text $f
2694         .vpane.lower.diff.header.path configure -text $p
2695         foreach w $diff_actions {
2696                 uplevel #0 $w $o
2697         }
2698 }
2699 trace add variable current_diff write trace_current_diff
2700
2701 frame .vpane.lower.diff.header -background orange
2702 label .vpane.lower.diff.header.status \
2703         -background orange \
2704         -width $max_status_desc \
2705         -anchor w \
2706         -justify left \
2707         -font font_ui
2708 label .vpane.lower.diff.header.file \
2709         -background orange \
2710         -anchor w \
2711         -justify left \
2712         -font font_ui
2713 label .vpane.lower.diff.header.path \
2714         -background orange \
2715         -anchor w \
2716         -justify left \
2717         -font font_ui
2718 pack .vpane.lower.diff.header.status -side left
2719 pack .vpane.lower.diff.header.file -side left
2720 pack .vpane.lower.diff.header.path -fill x
2721 set ctxm .vpane.lower.diff.header.ctxm
2722 menu $ctxm -tearoff 0
2723 $ctxm add command \
2724         -label {Copy} \
2725         -font font_ui \
2726         -command {
2727                 clipboard clear
2728                 clipboard append \
2729                         -format STRING \
2730                         -type STRING \
2731                         -- $current_diff
2732         }
2733 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2734 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2735
2736 # -- Diff Body
2737 #
2738 frame .vpane.lower.diff.body
2739 set ui_diff .vpane.lower.diff.body.t
2740 text $ui_diff -background white -borderwidth 0 \
2741         -width 80 -height 15 -wrap none \
2742         -font font_diff \
2743         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2744         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2745         -state disabled
2746 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2747         -command [list $ui_diff xview]
2748 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2749         -command [list $ui_diff yview]
2750 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2751 pack .vpane.lower.diff.body.sby -side right -fill y
2752 pack $ui_diff -side left -fill both -expand 1
2753 pack .vpane.lower.diff.header -side top -fill x
2754 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2755
2756 $ui_diff tag conf dm -foreground red
2757 $ui_diff tag conf dp -foreground blue
2758 $ui_diff tag conf di -foreground {#00a000}
2759 $ui_diff tag conf dni -foreground {#a000a0}
2760 $ui_diff tag conf da -font font_diffbold
2761 $ui_diff tag conf bold -font font_diffbold
2762
2763 # -- Diff Body Context Menu
2764 #
2765 set ctxm .vpane.lower.diff.body.ctxm
2766 menu $ctxm -tearoff 0
2767 $ctxm add command \
2768         -label {Copy} \
2769         -font font_ui \
2770         -command {tk_textCopy $ui_diff}
2771 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2772 $ctxm add command \
2773         -label {Select All} \
2774         -font font_ui \
2775         -command {$ui_diff tag add sel 0.0 end}
2776 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2777 $ctxm add command \
2778         -label {Copy All} \
2779         -font font_ui \
2780         -command {
2781                 $ui_diff tag add sel 0.0 end
2782                 tk_textCopy $ui_diff
2783                 $ui_diff tag remove sel 0.0 end
2784         }
2785 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2786 $ctxm add separator
2787 $ctxm add command \
2788         -label {Decrease Font Size} \
2789         -font font_ui \
2790         -command {incr_font_size font_diff -1}
2791 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2792 $ctxm add command \
2793         -label {Increase Font Size} \
2794         -font font_ui \
2795         -command {incr_font_size font_diff 1}
2796 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2797 $ctxm add separator
2798 $ctxm add command \
2799         -label {Show Less Context} \
2800         -font font_ui \
2801         -command {if {$repo_config(gui.diffcontext) >= 2} {
2802                 incr repo_config(gui.diffcontext) -1
2803                 reshow_diff
2804         }}
2805 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2806 $ctxm add command \
2807         -label {Show More Context} \
2808         -font font_ui \
2809         -command {
2810                 incr repo_config(gui.diffcontext)
2811                 reshow_diff
2812         }
2813 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2814 $ctxm add separator
2815 $ctxm add command -label {Options...} \
2816         -font font_ui \
2817         -command do_options
2818 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2819
2820 # -- Status Bar
2821 #
2822 set ui_status_value {Initializing...}
2823 label .status -textvariable ui_status_value \
2824         -anchor w \
2825         -justify left \
2826         -borderwidth 1 \
2827         -relief sunken \
2828         -font font_ui
2829 pack .status -anchor w -side bottom -fill x
2830
2831 # -- Load geometry
2832 #
2833 catch {
2834 set gm $repo_config(gui.geometry)
2835 wm geometry . [lindex $gm 0]
2836 .vpane sash place 0 \
2837         [lindex [.vpane sash coord 0] 0] \
2838         [lindex $gm 1]
2839 .vpane.files sash place 0 \
2840         [lindex $gm 2] \
2841         [lindex [.vpane.files sash coord 0] 1]
2842 unset gm
2843 }
2844
2845 # -- Key Bindings
2846 #
2847 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2848 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2849 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2850 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2851 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2852 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2853 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2854 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2855 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2856 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2857 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2858
2859 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2860 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2861 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2862 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2863 bind $ui_diff <$M1B-Key-v> {break}
2864 bind $ui_diff <$M1B-Key-V> {break}
2865 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2866 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2867 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2868 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2869 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2870 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2871
2872 bind .   <Destroy> do_quit
2873 bind all <Key-F5> do_rescan
2874 bind all <$M1B-Key-r> do_rescan
2875 bind all <$M1B-Key-R> do_rescan
2876 bind .   <$M1B-Key-s> do_signoff
2877 bind .   <$M1B-Key-S> do_signoff
2878 bind .   <$M1B-Key-i> do_include_all
2879 bind .   <$M1B-Key-I> do_include_all
2880 bind .   <$M1B-Key-Return> do_commit
2881 bind all <$M1B-Key-q> do_quit
2882 bind all <$M1B-Key-Q> do_quit
2883 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2884 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2885 foreach i [list $ui_index $ui_other] {
2886         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2887         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2888         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2889 }
2890 unset i
2891
2892 set file_lists($ui_index) [list]
2893 set file_lists($ui_other) [list]
2894
2895 set HEAD {}
2896 set PARENT {}
2897 set commit_type {}
2898 set empty_tree {}
2899 set current_diff {}
2900
2901 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2902 focus -force $ui_comm
2903 if {!$single_commit} {
2904         load_all_remotes
2905         populate_fetch_menu .mbar.fetch
2906         populate_pull_menu .mbar.pull
2907         populate_push_menu .mbar.push
2908 }
2909 lock_index begin-read
2910 after 1 do_rescan