git-gui

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