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