git-gui

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