git-gui

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