git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 set appname [lindex [file split $argv0] end]
  11 set gitdir {}
  12
  13 ######################################################################
  14 ##
  15 ## config
  16
  17 set default_config(gui.trustmtime) false
  18
  19 proc is_many_config {name} {
  20         switch -glob -- $name {
  21         remote.*.fetch -
  22         remote.*.push
  23                 {return 1}
  24         *
  25                 {return 0}
  26         }
  27 }
  28
  29 proc load_config {} {
  30         global repo_config global_config default_config
  31
  32         array unset global_config
  33         array unset repo_config
  34         catch {
  35                 set fd_rc [open "| git repo-config --global --list" r]
  36                 while {[gets $fd_rc line] >= 0} {
  37                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  38                                 if {[is_many_config $name]} {
  39                                         lappend global_config($name) $value
  40                                 } else {
  41                                         set global_config($name) $value
  42                                 }
  43                         }
  44                 }
  45                 close $fd_rc
  46         }
  47         catch {
  48                 set fd_rc [open "| git repo-config --list" r]
  49                 while {[gets $fd_rc line] >= 0} {
  50                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  51                                 if {[is_many_config $name]} {
  52                                         lappend repo_config($name) $value
  53                                 } else {
  54                                         set repo_config($name) $value
  55                                 }
  56                         }
  57                 }
  58                 close $fd_rc
  59         }
  60
  61         foreach name [array names default_config] {
  62                 if {[catch {set v $global_config($name)}]} {
  63                         set global_config($name) $default_config($name)
  64                 }
  65                 if {[catch {set v $repo_config($name)}]} {
  66                         set repo_config($name) $default_config($name)
  67                 }
  68         }
  69 }
  70
  71 proc save_config {} {
  72         global repo_config global_config default_config
  73         global repo_config_new global_config_new
  74
  75         foreach name [array names global_config_new] {
  76                 set value $global_config_new($name)
  77                 if {$value != $global_config($name)} {
  78                         if {$value == $default_config($name)} {
  79                                 catch {exec git repo-config --global --unset $name}
  80                         } else {
  81                                 catch {exec git repo-config --global $name $value}
  82                         }
  83                         set global_config($name) $value
  84                         if {$value == $repo_config($name)} {
  85                                 catch {exec git repo-config --unset $name}
  86                                 set repo_config($name) $value
  87                         }
  88                 }
  89         }
  90
  91         foreach name [array names repo_config_new] {
  92                 set value $repo_config_new($name)
  93                 if {$value != $repo_config($name)} {
  94                         if {$value == $global_config($name)} {
  95                                 catch {exec git repo-config --unset $name}
  96                         } else {
  97                                 catch {exec git repo-config $name $value}
  98                         }
  99                         set repo_config($name) $value
 100                 }
 101         }
 102 }
 103
 104 proc error_popup {msg} {
 105         global gitdir appname
 106
 107         set title $appname
 108         if {$gitdir != {}} {
 109                 append title { (}
 110                 append title [lindex \
 111                         [file split [file normalize [file dirname $gitdir]]] \
 112                         end]
 113                 append title {)}
 114         }
 115         tk_messageBox \
 116                 -parent . \
 117                 -icon error \
 118                 -type ok \
 119                 -title "$title: error" \
 120                 -message $msg
 121 }
 122
 123 proc info_popup {msg} {
 124         global gitdir appname
 125
 126         set title $appname
 127         if {$gitdir != {}} {
 128                 append title { (}
 129                 append title [lindex \
 130                         [file split [file normalize [file dirname $gitdir]]] \
 131                         end]
 132                 append title {)}
 133         }
 134         tk_messageBox \
 135                 -parent . \
 136                 -icon error \
 137                 -type ok \
 138                 -title $title \
 139                 -message $msg
 140 }
 141
 142 ######################################################################
 143 ##
 144 ## repository setup
 145
 146 if {   [catch {set cdup [exec git rev-parse --show-cdup]} err]
 147         || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 148         catch {wm withdraw .}
 149         error_popup "Cannot find the git directory:\n\n$err"
 150         exit 1
 151 }
 152 if {$cdup != ""} {
 153         cd $cdup
 154 }
 155 unset cdup
 156
 157 if {$appname == {git-citool}} {
 158         set single_commit 1
 159 }
 160
 161 load_config
 162
 163 ######################################################################
 164 ##
 165 ## task management
 166
 167 set single_commit 0
 168 set status_active 0
 169 set diff_active 0
 170 set update_active 0
 171 set commit_active 0
 172 set update_index_fd {}
 173
 174 set disable_on_lock [list]
 175 set index_lock_type none
 176
 177 set HEAD {}
 178 set PARENT {}
 179 set commit_type {}
 180
 181 proc lock_index {type} {
 182         global index_lock_type disable_on_lock
 183
 184         if {$index_lock_type == {none}} {
 185                 set index_lock_type $type
 186                 foreach w $disable_on_lock {
 187                         uplevel #0 $w disabled
 188                 }
 189                 return 1
 190         } elseif {$index_lock_type == {begin-update} && $type == {update}} {
 191                 set index_lock_type $type
 192                 return 1
 193         }
 194         return 0
 195 }
 196
 197 proc unlock_index {} {
 198         global index_lock_type disable_on_lock
 199
 200         set index_lock_type none
 201         foreach w $disable_on_lock {
 202                 uplevel #0 $w normal
 203         }
 204 }
 205
 206 ######################################################################
 207 ##
 208 ## status
 209
 210 proc repository_state {hdvar ctvar} {
 211         global gitdir
 212         upvar $hdvar hd $ctvar ct
 213
 214         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 215                 set ct initial
 216         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 217                 set ct merge
 218         } else {
 219                 set ct normal
 220         }
 221 }
 222
 223 proc update_status {{final Ready.}} {
 224         global HEAD PARENT commit_type
 225         global ui_index ui_other ui_status_value ui_comm
 226         global status_active file_states
 227         global repo_config
 228
 229         if {$status_active || ![lock_index read]} return
 230
 231         repository_state new_HEAD new_type
 232         if {$commit_type == {amend}
 233                 && $new_type == {normal}
 234                 && $new_HEAD == $HEAD} {
 235         } else {
 236                 set HEAD $new_HEAD
 237                 set PARENT $new_HEAD
 238                 set commit_type $new_type
 239         }
 240
 241         array unset file_states
 242
 243         if {![$ui_comm edit modified]
 244                 || [string trim [$ui_comm get 0.0 end]] == {}} {
 245                 if {[load_message GITGUI_MSG]} {
 246                 } elseif {[load_message MERGE_MSG]} {
 247                 } elseif {[load_message SQUASH_MSG]} {
 248                 }
 249                 $ui_comm edit modified false
 250                 $ui_comm edit reset
 251         }
 252
 253         if {$repo_config(gui.trustmtime) == {true}} {
 254                 update_status_stage2 {} $final
 255         } else {
 256                 set status_active 1
 257                 set ui_status_value {Refreshing file status...}
 258                 set cmd [list git update-index]
 259                 lappend cmd -q
 260                 lappend cmd --unmerged
 261                 lappend cmd --ignore-missing
 262                 lappend cmd --refresh
 263                 set fd_rf [open "| $cmd" r]
 264                 fconfigure $fd_rf -blocking 0 -translation binary
 265                 fileevent $fd_rf readable \
 266                         [list update_status_stage2 $fd_rf $final]
 267         }
 268 }
 269
 270 proc update_status_stage2 {fd final} {
 271         global gitdir PARENT commit_type
 272         global ui_index ui_other ui_status_value ui_comm
 273         global status_active
 274         global buf_rdi buf_rdf buf_rlo
 275
 276         if {$fd != {}} {
 277                 read $fd
 278                 if {![eof $fd]} return
 279                 close $fd
 280         }
 281
 282         set ls_others [list | git ls-files --others -z \
 283                 --exclude-per-directory=.gitignore]
 284         set info_exclude [file join $gitdir info exclude]
 285         if {[file readable $info_exclude]} {
 286                 lappend ls_others "--exclude-from=$info_exclude"
 287         }
 288
 289         set buf_rdi {}
 290         set buf_rdf {}
 291         set buf_rlo {}
 292
 293         set status_active 3
 294         set ui_status_value {Scanning for modified files ...}
 295         set fd_di [open "| git diff-index --cached -z $PARENT" r]
 296         set fd_df [open "| git diff-files -z" r]
 297         set fd_lo [open $ls_others r]
 298
 299         fconfigure $fd_di -blocking 0 -translation binary
 300         fconfigure $fd_df -blocking 0 -translation binary
 301         fconfigure $fd_lo -blocking 0 -translation binary
 302         fileevent $fd_di readable [list read_diff_index $fd_di $final]
 303         fileevent $fd_df readable [list read_diff_files $fd_df $final]
 304         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 305 }
 306
 307 proc load_message {file} {
 308         global gitdir ui_comm
 309
 310         set f [file join $gitdir $file]
 311         if {[file isfile $f]} {
 312                 if {[catch {set fd [open $f r]}]} {
 313                         return 0
 314                 }
 315                 set content [string trim [read $fd]]
 316                 close $fd
 317                 $ui_comm delete 0.0 end
 318                 $ui_comm insert end $content
 319                 return 1
 320         }
 321         return 0
 322 }
 323
 324 proc read_diff_index {fd final} {
 325         global buf_rdi
 326
 327         append buf_rdi [read $fd]
 328         set c 0
 329         set n [string length $buf_rdi]
 330         while {$c < $n} {
 331                 set z1 [string first "\0" $buf_rdi $c]
 332                 if {$z1 == -1} break
 333                 incr z1
 334                 set z2 [string first "\0" $buf_rdi $z1]
 335                 if {$z2 == -1} break
 336
 337                 set c $z2
 338                 incr z2 -1
 339                 display_file \
 340                         [string range $buf_rdi $z1 $z2] \
 341                         [string index $buf_rdi [expr $z1 - 2]]_
 342                 incr c
 343         }
 344         if {$c < $n} {
 345                 set buf_rdi [string range $buf_rdi $c end]
 346         } else {
 347                 set buf_rdi {}
 348         }
 349
 350         status_eof $fd buf_rdi $final
 351 }
 352
 353 proc read_diff_files {fd final} {
 354         global buf_rdf
 355
 356         append buf_rdf [read $fd]
 357         set c 0
 358         set n [string length $buf_rdf]
 359         while {$c < $n} {
 360                 set z1 [string first "\0" $buf_rdf $c]
 361                 if {$z1 == -1} break
 362                 incr z1
 363                 set z2 [string first "\0" $buf_rdf $z1]
 364                 if {$z2 == -1} break
 365
 366                 set c $z2
 367                 incr z2 -1
 368                 display_file \
 369                         [string range $buf_rdf $z1 $z2] \
 370                         _[string index $buf_rdf [expr $z1 - 2]]
 371                 incr c
 372         }
 373         if {$c < $n} {
 374                 set buf_rdf [string range $buf_rdf $c end]
 375         } else {
 376                 set buf_rdf {}
 377         }
 378
 379         status_eof $fd buf_rdf $final
 380 }
 381
 382 proc read_ls_others {fd final} {
 383         global buf_rlo
 384
 385         append buf_rlo [read $fd]
 386         set pck [split $buf_rlo "\0"]
 387         set buf_rlo [lindex $pck end]
 388         foreach p [lrange $pck 0 end-1] {
 389                 display_file $p _O
 390         }
 391         status_eof $fd buf_rlo $final
 392 }
 393
 394 proc status_eof {fd buf final} {
 395         global status_active ui_status_value
 396         upvar $buf to_clear
 397
 398         if {[eof $fd]} {
 399                 set to_clear {}
 400                 close $fd
 401
 402                 if {[incr status_active -1] == 0} {
 403                         display_all_files
 404                         unlock_index
 405                         reshow_diff
 406                         set ui_status_value $final
 407                 }
 408         }
 409 }
 410
 411 ######################################################################
 412 ##
 413 ## diff
 414
 415 proc clear_diff {} {
 416         global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
 417
 418         $ui_diff conf -state normal
 419         $ui_diff delete 0.0 end
 420         $ui_diff conf -state disabled
 421
 422         set ui_fname_value {}
 423         set ui_fstatus_value {}
 424
 425         $ui_index tag remove in_diff 0.0 end
 426         $ui_other tag remove in_diff 0.0 end
 427 }
 428
 429 proc reshow_diff {} {
 430         global ui_fname_value ui_status_value file_states
 431
 432         if {$ui_fname_value == {}
 433                 || [catch {set s $file_states($ui_fname_value)}]} {
 434                 clear_diff
 435         } else {
 436                 show_diff $ui_fname_value
 437         }
 438 }
 439
 440 proc handle_empty_diff {} {
 441         global ui_fname_value file_states file_lists
 442
 443         set path $ui_fname_value
 444         set s $file_states($path)
 445         if {[lindex $s 0] != {_M}} return
 446
 447         info_popup "No differences detected.
 448
 449 [short_path $path] has no changes.
 450
 451 The modification date of this file was updated by another
 452 application and you currently have the Trust File Modification
 453 Timestamps option enabled, so Git did not automatically detect
 454 that there are no content differences in this file.
 455
 456 This file will now be removed from the modified files list, to
 457 prevent possible confusion.
 458 "
 459         if {[catch {exec git update-index -- $path} err]} {
 460                 error_popup "Failed to refresh index:\n\n$err"
 461         }
 462
 463         clear_diff
 464         set old_w [mapcol [lindex $file_states($path) 0] $path]
 465         set lno [lsearch -sorted $file_lists($old_w) $path]
 466         if {$lno >= 0} {
 467                 set file_lists($old_w) \
 468                         [lreplace $file_lists($old_w) $lno $lno]
 469                 incr lno
 470                 $old_w conf -state normal
 471                 $old_w delete $lno.0 [expr $lno + 1].0
 472                 $old_w conf -state disabled
 473         }
 474 }
 475
 476 proc show_diff {path {w {}} {lno {}}} {
 477         global file_states file_lists
 478         global PARENT diff_3way diff_active
 479         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 480
 481         if {$diff_active || ![lock_index read]} return
 482
 483         clear_diff
 484         if {$w == {} || $lno == {}} {
 485                 foreach w [array names file_lists] {
 486                         set lno [lsearch -sorted $file_lists($w) $path]
 487                         if {$lno >= 0} {
 488                                 incr lno
 489                                 break
 490                         }
 491                 }
 492         }
 493         if {$w != {} && $lno >= 1} {
 494                 $w tag add in_diff $lno.0 [expr $lno + 1].0
 495         }
 496
 497         set s $file_states($path)
 498         set m [lindex $s 0]
 499         set diff_3way 0
 500         set diff_active 1
 501         set ui_fname_value [escape_path $path]
 502         set ui_fstatus_value [mapdesc $m $path]
 503         set ui_status_value "Loading diff of [escape_path $path]..."
 504
 505         set cmd [list | git diff-index -p $PARENT -- $path]
 506         switch $m {
 507         MM {
 508                 set cmd [list | git diff-index -p -c $PARENT $path]
 509         }
 510         _O {
 511                 if {[catch {
 512                                 set fd [open $path r]
 513                                 set content [read $fd]
 514                                 close $fd
 515                         } err ]} {
 516                         set diff_active 0
 517                         unlock_index
 518                         set ui_status_value "Unable to display [escape_path $path]"
 519                         error_popup "Error loading file:\n\n$err"
 520                         return
 521                 }
 522                 $ui_diff conf -state normal
 523                 $ui_diff insert end $content
 524                 $ui_diff conf -state disabled
 525                 set diff_active 0
 526                 unlock_index
 527                 set ui_status_value {Ready.}
 528                 return
 529         }
 530         }
 531
 532         if {[catch {set fd [open $cmd r]} err]} {
 533                 set diff_active 0
 534                 unlock_index
 535                 set ui_status_value "Unable to display [escape_path $path]"
 536                 error_popup "Error loading diff:\n\n$err"
 537                 return
 538         }
 539
 540         fconfigure $fd -blocking 0 -translation auto
 541         fileevent $fd readable [list read_diff $fd]
 542 }
 543
 544 proc read_diff {fd} {
 545         global ui_diff ui_status_value diff_3way diff_active
 546         global repo_config
 547
 548         while {[gets $fd line] >= 0} {
 549                 if {[string match {diff --git *} $line]} continue
 550                 if {[string match {diff --combined *} $line]} continue
 551                 if {[string match {--- *} $line]} continue
 552                 if {[string match {+++ *} $line]} continue
 553                 if {[string match index* $line]} {
 554                         if {[string first , $line] >= 0} {
 555                                 set diff_3way 1
 556                         }
 557                 }
 558
 559                 $ui_diff conf -state normal
 560                 if {!$diff_3way} {
 561                         set x [string index $line 0]
 562                         switch -- $x {
 563                         "@" {set tags da}
 564                         "+" {set tags dp}
 565                         "-" {set tags dm}
 566                         default {set tags {}}
 567                         }
 568                 } else {
 569                         set x [string range $line 0 1]
 570                         switch -- $x {
 571                         default {set tags {}}
 572                         "@@" {set tags da}
 573                         "++" {set tags dp; set x " +"}
 574                         " +" {set tags {di bold}; set x "++"}
 575                         "+ " {set tags dni; set x "-+"}
 576                         "--" {set tags dm; set x " -"}
 577                         " -" {set tags {dm bold}; set x "--"}
 578                         "- " {set tags di; set x "+-"}
 579                         default {set tags {}}
 580                         }
 581                         set line [string replace $line 0 1 $x]
 582                 }
 583                 $ui_diff insert end $line $tags
 584                 $ui_diff insert end "\n"
 585                 $ui_diff conf -state disabled
 586         }
 587
 588         if {[eof $fd]} {
 589                 close $fd
 590                 set diff_active 0
 591                 unlock_index
 592                 set ui_status_value {Ready.}
 593
 594                 if {$repo_config(gui.trustmtime) == {true}
 595                         && [$ui_diff index end] == {2.0}} {
 596                         handle_empty_diff
 597                 }
 598         }
 599 }
 600
 601 ######################################################################
 602 ##
 603 ## commit
 604
 605 proc load_last_commit {} {
 606         global HEAD PARENT commit_type ui_comm
 607
 608         if {$commit_type == {amend}} return
 609         if {$commit_type != {normal}} {
 610                 error_popup "Can't amend a $commit_type commit."
 611                 return
 612         }
 613
 614         set msg {}
 615         set parent {}
 616         set parent_count 0
 617         if {[catch {
 618                         set fd [open "| git cat-file commit $HEAD" r]
 619                         while {[gets $fd line] > 0} {
 620                                 if {[string match {parent *} $line]} {
 621                                         set parent [string range $line 7 end]
 622                                         incr parent_count
 623                                 }
 624                         }
 625                         set msg [string trim [read $fd]]
 626                         close $fd
 627                 } err]} {
 628                 error_popup "Error loading commit data for amend:\n\n$err"
 629                 return
 630         }
 631
 632         if {$parent_count == 0} {
 633                 set commit_type amend
 634                 set HEAD {}
 635                 set PARENT {}
 636                 update_status
 637         } elseif {$parent_count == 1} {
 638                 set commit_type amend
 639                 set PARENT $parent
 640                 $ui_comm delete 0.0 end
 641                 $ui_comm insert end $msg
 642                 $ui_comm edit modified false
 643                 $ui_comm edit reset
 644                 update_status
 645         } else {
 646                 error_popup {You can't amend a merge commit.}
 647                 return
 648         }
 649 }
 650
 651 proc commit_tree {} {
 652         global tcl_platform HEAD gitdir commit_type file_states
 653         global commit_active ui_status_value
 654         global ui_comm
 655
 656         if {$commit_active || ![lock_index update]} return
 657
 658         # -- Our in memory state should match the repository.
 659         #
 660         repository_state curHEAD cur_type
 661         if {$commit_type == {amend}
 662                 && $cur_type == {normal}
 663                 && $curHEAD == $HEAD} {
 664         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 665                 error_popup {Last scanned state does not match repository state.
 666
 667 Its highly likely that another Git program modified the
 668 repository since our last scan.  A rescan is required
 669 before committing.
 670 }
 671                 unlock_index
 672                 update_status
 673                 return
 674         }
 675
 676         # -- At least one file should differ in the index.
 677         #
 678         set files_ready 0
 679         foreach path [array names file_states] {
 680                 set s $file_states($path)
 681                 switch -glob -- [lindex $s 0] {
 682                 _? {continue}
 683                 A? -
 684                 D? -
 685                 M? {set files_ready 1; break}
 686                 U? {
 687                         error_popup "Unmerged files cannot be committed.
 688
 689 File [short_path $path] has merge conflicts.
 690 You must resolve them and include the file before committing.
 691 "
 692                         unlock_index
 693                         return
 694                 }
 695                 default {
 696                         error_popup "Unknown file state [lindex $s 0] detected.
 697
 698 File [short_path $path] cannot be committed by this program.
 699 "
 700                 }
 701                 }
 702         }
 703         if {!$files_ready} {
 704                 error_popup {No included files to commit.
 705
 706 You must include at least 1 file before you can commit.
 707 }
 708                 unlock_index
 709                 return
 710         }
 711
 712         # -- A message is required.
 713         #
 714         set msg [string trim [$ui_comm get 1.0 end]]
 715         if {$msg == {}} {
 716                 error_popup {Please supply a commit message.
 717
 718 A good commit message has the following format:
 719
 720 - First line: Describe in one sentance what you did.
 721 - Second line: Blank
 722 - Remaining lines: Describe why this change is good.
 723 }
 724                 unlock_index
 725                 return
 726         }
 727
 728         # -- Ask the pre-commit hook for the go-ahead.
 729         #
 730         set pchook [file join $gitdir hooks pre-commit]
 731         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 732                 set pchook [list sh -c \
 733                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 734         } elseif {[file executable $pchook]} {
 735                 set pchook [list $pchook]
 736         } else {
 737                 set pchook {}
 738         }
 739         if {$pchook != {} && [catch {eval exec $pchook} err]} {
 740                 hook_failed_popup pre-commit $err
 741                 unlock_index
 742                 return
 743         }
 744
 745         # -- Write the tree in the background.
 746         #
 747         set commit_active 1
 748         set ui_status_value {Committing changes...}
 749
 750         set fd_wt [open "| git write-tree" r]
 751         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 752 }
 753
 754 proc commit_stage2 {fd_wt curHEAD msg} {
 755         global single_commit gitdir HEAD PARENT commit_type
 756         global commit_active ui_status_value ui_comm
 757         global file_states
 758
 759         gets $fd_wt tree_id
 760         if {$tree_id == {} || [catch {close $fd_wt} err]} {
 761                 error_popup "write-tree failed:\n\n$err"
 762                 set commit_active 0
 763                 set ui_status_value {Commit failed.}
 764                 unlock_index
 765                 return
 766         }
 767
 768         # -- Create the commit.
 769         #
 770         set cmd [list git commit-tree $tree_id]
 771         if {$PARENT != {}} {
 772                 lappend cmd -p $PARENT
 773         }
 774         if {$commit_type == {merge}} {
 775                 if {[catch {
 776                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 777                                 while {[gets $fd_mh merge_head] >= 0} {
 778                                         lappend cmd -p $merge_head
 779                                 }
 780                                 close $fd_mh
 781                         } err]} {
 782                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 783                         set commit_active 0
 784                         set ui_status_value {Commit failed.}
 785                         unlock_index
 786                         return
 787                 }
 788         }
 789         if {$PARENT == {}} {
 790                 # git commit-tree writes to stderr during initial commit.
 791                 lappend cmd 2>/dev/null
 792         }
 793         lappend cmd << $msg
 794         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 795                 error_popup "commit-tree failed:\n\n$err"
 796                 set commit_active 0
 797                 set ui_status_value {Commit failed.}
 798                 unlock_index
 799                 return
 800         }
 801
 802         # -- Update the HEAD ref.
 803         #
 804         set reflogm commit
 805         if {$commit_type != {normal}} {
 806                 append reflogm " ($commit_type)"
 807         }
 808         set i [string first "\n" $msg]
 809         if {$i >= 0} {
 810                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
 811         } else {
 812                 append reflogm {: } $msg
 813         }
 814         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 815         if {[catch {eval exec $cmd} err]} {
 816                 error_popup "update-ref failed:\n\n$err"
 817                 set commit_active 0
 818                 set ui_status_value {Commit failed.}
 819                 unlock_index
 820                 return
 821         }
 822
 823         # -- Cleanup after ourselves.
 824         #
 825         catch {file delete [file join $gitdir MERGE_HEAD]}
 826         catch {file delete [file join $gitdir MERGE_MSG]}
 827         catch {file delete [file join $gitdir SQUASH_MSG]}
 828         catch {file delete [file join $gitdir GITGUI_MSG]}
 829
 830         # -- Let rerere do its thing.
 831         #
 832         if {[file isdirectory [file join $gitdir rr-cache]]} {
 833                 catch {exec git rerere}
 834         }
 835
 836         $ui_comm delete 0.0 end
 837         $ui_comm edit modified false
 838         $ui_comm edit reset
 839
 840         if {$single_commit} do_quit
 841
 842         # -- Update status without invoking any git commands.
 843         #
 844         set commit_active 0
 845         set commit_type normal
 846         set HEAD $cmt_id
 847         set PARENT $cmt_id
 848
 849         foreach path [array names file_states] {
 850                 set s $file_states($path)
 851                 set m [lindex $s 0]
 852                 switch -glob -- $m {
 853                 A? -
 854                 M? -
 855                 D? {set m _[string index $m 1]}
 856                 }
 857
 858                 if {$m == {__}} {
 859                         unset file_states($path)
 860                 } else {
 861                         lset file_states($path) 0 $m
 862                 }
 863         }
 864
 865         display_all_files
 866         unlock_index
 867         reshow_diff
 868         set ui_status_value \
 869                 "Changes committed as [string range $cmt_id 0 7]."
 870 }
 871
 872 ######################################################################
 873 ##
 874 ## fetch pull push
 875
 876 proc fetch_from {remote} {
 877         set w [new_console "fetch $remote" \
 878                 "Fetching new changes from $remote"]
 879         set cmd [list git fetch]
 880         lappend cmd $remote
 881         console_exec $w $cmd
 882 }
 883
 884 proc pull_remote {remote branch} {
 885         global HEAD commit_type
 886         global file_states
 887
 888         if {![lock_index update]} return
 889
 890         # -- Our in memory state should match the repository.
 891         #
 892         repository_state curHEAD cur_type
 893         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 894                 error_popup {Last scanned state does not match repository state.
 895
 896 Its highly likely that another Git program modified the
 897 repository since our last scan.  A rescan is required
 898 before a pull can be started.
 899 }
 900                 unlock_index
 901                 update_status
 902                 return
 903         }
 904
 905         # -- No differences should exist before a pull.
 906         #
 907         if {[array size file_states] != 0} {
 908                 error_popup {Uncommitted but modified files are present.
 909
 910 You should not perform a pull with unmodified files in your working
 911 directory as Git would be unable to recover from an incorrect merge.
 912
 913 Commit or throw away all changes before starting a pull operation.
 914 }
 915                 unlock_index
 916                 return
 917         }
 918
 919         set w [new_console "pull $remote $branch" \
 920                 "Pulling new changes from branch $branch in $remote"]
 921         set cmd [list git pull]
 922         lappend cmd $remote
 923         lappend cmd $branch
 924         console_exec $w $cmd [list post_pull_remote $remote $branch]
 925 }
 926
 927 proc post_pull_remote {remote branch success} {
 928         global HEAD PARENT commit_type
 929         global ui_status_value
 930
 931         unlock_index
 932         if {$success} {
 933                 repository_state HEAD commit_type
 934                 set PARENT $HEAD
 935                 set $ui_status_value {Ready.}
 936         } else {
 937                 update_status \
 938                         "Conflicts detected while pulling $branch from $remote."
 939         }
 940 }
 941
 942 proc push_to {remote} {
 943         set w [new_console "push $remote" \
 944                 "Pushing changes to $remote"]
 945         set cmd [list git push]
 946         lappend cmd $remote
 947         console_exec $w $cmd
 948 }
 949
 950 ######################################################################
 951 ##
 952 ## ui helpers
 953
 954 proc mapcol {state path} {
 955         global all_cols ui_other
 956
 957         if {[catch {set r $all_cols($state)}]} {
 958                 puts "error: no column for state={$state} $path"
 959                 return $ui_other
 960         }
 961         return $r
 962 }
 963
 964 proc mapicon {state path} {
 965         global all_icons
 966
 967         if {[catch {set r $all_icons($state)}]} {
 968                 puts "error: no icon for state={$state} $path"
 969                 return file_plain
 970         }
 971         return $r
 972 }
 973
 974 proc mapdesc {state path} {
 975         global all_descs
 976
 977         if {[catch {set r $all_descs($state)}]} {
 978                 puts "error: no desc for state={$state} $path"
 979                 return $state
 980         }
 981         return $r
 982 }
 983
 984 proc escape_path {path} {
 985         regsub -all "\n" $path "\\n" path
 986         return $path
 987 }
 988
 989 proc short_path {path} {
 990         return [escape_path [lindex [file split $path] end]]
 991 }
 992
 993 set next_icon_id 0
 994
 995 proc merge_state {path new_state} {
 996         global file_states next_icon_id
 997
 998         set s0 [string index $new_state 0]
 999         set s1 [string index $new_state 1]
1000
1001         if {[catch {set info $file_states($path)}]} {
1002                 set state __
1003                 set icon n[incr next_icon_id]
1004         } else {
1005                 set state [lindex $info 0]
1006                 set icon [lindex $info 1]
1007         }
1008
1009         if {$s0 == {_}} {
1010                 set s0 [string index $state 0]
1011         } elseif {$s0 == {*}} {
1012                 set s0 _
1013         }
1014
1015         if {$s1 == {_}} {
1016                 set s1 [string index $state 1]
1017         } elseif {$s1 == {*}} {
1018                 set s1 _
1019         }
1020
1021         set file_states($path) [list $s0$s1 $icon]
1022         return $state
1023 }
1024
1025 proc display_file {path state} {
1026         global file_states file_lists status_active
1027
1028         set old_m [merge_state $path $state]
1029         if {$status_active} return
1030
1031         set s $file_states($path)
1032         set new_m [lindex $s 0]
1033         set new_w [mapcol $new_m $path]
1034         set old_w [mapcol $old_m $path]
1035         set new_icon [mapicon $new_m $path]
1036
1037         if {$new_w != $old_w} {
1038                 set lno [lsearch -sorted $file_lists($old_w) $path]
1039                 if {$lno >= 0} {
1040                         incr lno
1041                         $old_w conf -state normal
1042                         $old_w delete $lno.0 [expr $lno + 1].0
1043                         $old_w conf -state disabled
1044                 }
1045
1046                 lappend file_lists($new_w) $path
1047                 set file_lists($new_w) [lsort $file_lists($new_w)]
1048                 set lno [lsearch -sorted $file_lists($new_w) $path]
1049                 incr lno
1050                 $new_w conf -state normal
1051                 $new_w image create $lno.0 \
1052                         -align center -padx 5 -pady 1 \
1053                         -name [lindex $s 1] \
1054                         -image $new_icon
1055                 $new_w insert $lno.1 "[escape_path $path]\n"
1056                 $new_w conf -state disabled
1057         } elseif {$new_icon != [mapicon $old_m $path]} {
1058                 $new_w conf -state normal
1059                 $new_w image conf [lindex $s 1] -image $new_icon
1060                 $new_w conf -state disabled
1061         }
1062 }
1063
1064 proc display_all_files {} {
1065         global ui_index ui_other file_states file_lists
1066
1067         $ui_index conf -state normal
1068         $ui_other conf -state normal
1069
1070         $ui_index delete 0.0 end
1071         $ui_other delete 0.0 end
1072
1073         set file_lists($ui_index) [list]
1074         set file_lists($ui_other) [list]
1075
1076         foreach path [lsort [array names file_states]] {
1077                 set s $file_states($path)
1078                 set m [lindex $s 0]
1079                 set w [mapcol $m $path]
1080                 lappend file_lists($w) $path
1081                 $w image create end \
1082                         -align center -padx 5 -pady 1 \
1083                         -name [lindex $s 1] \
1084                         -image [mapicon $m $path]
1085                 $w insert end "[escape_path $path]\n"
1086         }
1087
1088         $ui_index conf -state disabled
1089         $ui_other conf -state disabled
1090 }
1091
1092 proc with_update_index {body} {
1093         global update_index_fd
1094
1095         if {$update_index_fd == {}} {
1096                 if {![lock_index update]} return
1097                 set update_index_fd [open \
1098                         "| git update-index --add --remove -z --stdin" \
1099                         w]
1100                 fconfigure $update_index_fd -translation binary
1101                 uplevel 1 $body
1102                 close $update_index_fd
1103                 set update_index_fd {}
1104                 unlock_index
1105         } else {
1106                 uplevel 1 $body
1107         }
1108 }
1109
1110 proc update_index {path} {
1111         global update_index_fd
1112
1113         if {$update_index_fd == {}} {
1114                 error {not in with_update_index}
1115         } else {
1116                 puts -nonewline $update_index_fd "$path\0"
1117         }
1118 }
1119
1120 proc toggle_mode {path} {
1121         global file_states ui_fname_value
1122
1123         set s $file_states($path)
1124         set m [lindex $s 0]
1125
1126         switch -- $m {
1127         AM -
1128         _O {set new A*}
1129         _M -
1130         MM {set new M*}
1131         AD -
1132         _D {set new D*}
1133         default {return}
1134         }
1135
1136         with_update_index {update_index $path}
1137         display_file $path $new
1138         if {$ui_fname_value == $path} {
1139                 show_diff $path
1140         }
1141 }
1142
1143 ######################################################################
1144 ##
1145 ## remote management
1146
1147 proc load_all_remotes {} {
1148         global gitdir all_remotes repo_config
1149
1150         set all_remotes [list]
1151         set rm_dir [file join $gitdir remotes]
1152         if {[file isdirectory $rm_dir]} {
1153                 set all_remotes [concat $all_remotes [glob \
1154                         -types f \
1155                         -tails \
1156                         -nocomplain \
1157                         -directory $rm_dir *]]
1158         }
1159
1160         foreach line [array names repo_config remote.*.url] {
1161                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1162                         lappend all_remotes $name
1163                 }
1164         }
1165
1166         set all_remotes [lsort -unique $all_remotes]
1167 }
1168
1169 proc populate_remote_menu {m pfx op} {
1170         global all_remotes
1171
1172         foreach remote $all_remotes {
1173                 $m add command -label "$pfx $remote..." \
1174                         -command [list $op $remote] \
1175                         -font font_ui
1176         }
1177 }
1178
1179 proc populate_pull_menu {m} {
1180         global gitdir repo_config all_remotes disable_on_lock
1181
1182         foreach remote $all_remotes {
1183                 set rb {}
1184                 if {[array get repo_config remote.$remote.url] != {}} {
1185                         if {[array get repo_config remote.$remote.fetch] != {}} {
1186                                 regexp {^([^:]+):} \
1187                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1188                                         line rb
1189                         }
1190                 } else {
1191                         catch {
1192                                 set fd [open [file join $gitdir remotes $remote] r]
1193                                 while {[gets $fd line] >= 0} {
1194                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1195                                                 break
1196                                         }
1197                                 }
1198                                 close $fd
1199                         }
1200                 }
1201
1202                 set rb_short $rb
1203                 regsub ^refs/heads/ $rb {} rb_short
1204                 if {$rb_short != {}} {
1205                         $m add command \
1206                                 -label "Branch $rb_short from $remote..." \
1207                                 -command [list pull_remote $remote $rb] \
1208                                 -font font_ui
1209                         lappend disable_on_lock \
1210                                 [list $m entryconf [$m index last] -state]
1211                 }
1212         }
1213 }
1214
1215 ######################################################################
1216 ##
1217 ## icons
1218
1219 set filemask {
1220 #define mask_width 14
1221 #define mask_height 15
1222 static unsigned char mask_bits[] = {
1223    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1224    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1225    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1226 }
1227
1228 image create bitmap file_plain -background white -foreground black -data {
1229 #define plain_width 14
1230 #define plain_height 15
1231 static unsigned char plain_bits[] = {
1232    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1233    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1234    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1235 } -maskdata $filemask
1236
1237 image create bitmap file_mod -background white -foreground blue -data {
1238 #define mod_width 14
1239 #define mod_height 15
1240 static unsigned char mod_bits[] = {
1241    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1242    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1243    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1244 } -maskdata $filemask
1245
1246 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1247 #define file_fulltick_width 14
1248 #define file_fulltick_height 15
1249 static unsigned char file_fulltick_bits[] = {
1250    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1251    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1252    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1253 } -maskdata $filemask
1254
1255 image create bitmap file_parttick -background white -foreground "#005050" -data {
1256 #define parttick_width 14
1257 #define parttick_height 15
1258 static unsigned char parttick_bits[] = {
1259    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1260    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1261    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1262 } -maskdata $filemask
1263
1264 image create bitmap file_question -background white -foreground black -data {
1265 #define file_question_width 14
1266 #define file_question_height 15
1267 static unsigned char file_question_bits[] = {
1268    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1269    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1270    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1271 } -maskdata $filemask
1272
1273 image create bitmap file_removed -background white -foreground red -data {
1274 #define file_removed_width 14
1275 #define file_removed_height 15
1276 static unsigned char file_removed_bits[] = {
1277    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1278    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1279    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1280 } -maskdata $filemask
1281
1282 image create bitmap file_merge -background white -foreground blue -data {
1283 #define file_merge_width 14
1284 #define file_merge_height 15
1285 static unsigned char file_merge_bits[] = {
1286    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1287    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1288    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1290
1291 set ui_index .vpane.files.index.list
1292 set ui_other .vpane.files.other.list
1293 set max_status_desc 0
1294 foreach i {
1295                 {__ i plain    "Unmodified"}
1296                 {_M i mod      "Modified"}
1297                 {M_ i fulltick "Checked in"}
1298                 {MM i parttick "Partially included"}
1299
1300                 {_O o plain    "Untracked"}
1301                 {A_ o fulltick "Added"}
1302                 {AM o parttick "Partially added"}
1303                 {AD o question "Added (but now gone)"}
1304
1305                 {_D i question "Missing"}
1306                 {D_ i removed  "Removed"}
1307                 {DD i removed  "Removed"}
1308                 {DO i removed  "Removed (still exists)"}
1309
1310                 {UM i merge    "Merge conflicts"}
1311                 {U_ i merge    "Merge conflicts"}
1312         } {
1313         if {$max_status_desc < [string length [lindex $i 3]]} {
1314                 set max_status_desc [string length [lindex $i 3]]
1315         }
1316         if {[lindex $i 1] == {i}} {
1317                 set all_cols([lindex $i 0]) $ui_index
1318         } else {
1319                 set all_cols([lindex $i 0]) $ui_other
1320         }
1321         set all_icons([lindex $i 0]) file_[lindex $i 2]
1322         set all_descs([lindex $i 0]) [lindex $i 3]
1323 }
1324 unset filemask i
1325
1326 ######################################################################
1327 ##
1328 ## util
1329
1330 proc is_MacOSX {} {
1331         global tcl_platform tk_library
1332         if {$tcl_platform(platform) == {unix}
1333                 && $tcl_platform(os) == {Darwin}
1334                 && [string match /Library/Frameworks/* $tk_library]} {
1335                 return 1
1336         }
1337         return 0
1338 }
1339
1340 proc bind_button3 {w cmd} {
1341         bind $w <Any-Button-3> $cmd
1342         if {[is_MacOSX]} {
1343                 bind $w <Control-Button-1> $cmd
1344         }
1345 }
1346
1347 proc incr_font_size {font {amt 1}} {
1348         set sz [font configure $font -size]
1349         incr sz $amt
1350         font configure $font -size $sz
1351         font configure ${font}bold -size $sz
1352 }
1353
1354 proc hook_failed_popup {hook msg} {
1355         global gitdir appname
1356
1357         set w .hookfail
1358         toplevel $w
1359
1360         frame $w.m
1361         label $w.m.l1 -text "$hook hook failed:" \
1362                 -anchor w \
1363                 -justify left \
1364                 -font font_uibold
1365         text $w.m.t \
1366                 -background white -borderwidth 1 \
1367                 -relief sunken \
1368                 -width 80 -height 10 \
1369                 -font font_diff \
1370                 -yscrollcommand [list $w.m.sby set]
1371         label $w.m.l2 \
1372                 -text {You must correct the above errors before committing.} \
1373                 -anchor w \
1374                 -justify left \
1375                 -font font_uibold
1376         scrollbar $w.m.sby -command [list $w.m.t yview]
1377         pack $w.m.l1 -side top -fill x
1378         pack $w.m.l2 -side bottom -fill x
1379         pack $w.m.sby -side right -fill y
1380         pack $w.m.t -side left -fill both -expand 1
1381         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1382
1383         $w.m.t insert 1.0 $msg
1384         $w.m.t conf -state disabled
1385
1386         button $w.ok -text OK \
1387                 -width 15 \
1388                 -font font_ui \
1389                 -command "destroy $w"
1390         pack $w.ok -side bottom
1391
1392         bind $w <Visibility> "grab $w; focus $w"
1393         bind $w <Key-Return> "destroy $w"
1394         wm title $w "$appname ([lindex [file split \
1395                 [file normalize [file dirname $gitdir]]] \
1396                 end]): error"
1397         tkwait window $w
1398 }
1399
1400 set next_console_id 0
1401
1402 proc new_console {short_title long_title} {
1403         global next_console_id console_data
1404         set w .console[incr next_console_id]
1405         set console_data($w) [list $short_title $long_title]
1406         return [console_init $w]
1407 }
1408
1409 proc console_init {w} {
1410         global console_cr console_data
1411         global gitdir appname M1B
1412
1413         set console_cr($w) 1.0
1414         toplevel $w
1415         frame $w.m
1416         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1417                 -anchor w \
1418                 -justify left \
1419                 -font font_uibold
1420         text $w.m.t \
1421                 -background white -borderwidth 1 \
1422                 -relief sunken \
1423                 -width 80 -height 10 \
1424                 -font font_diff \
1425                 -state disabled \
1426                 -yscrollcommand [list $w.m.sby set]
1427         label $w.m.s -anchor w \
1428                 -justify left \
1429                 -font font_uibold
1430         scrollbar $w.m.sby -command [list $w.m.t yview]
1431         pack $w.m.l1 -side top -fill x
1432         pack $w.m.s -side bottom -fill x
1433         pack $w.m.sby -side right -fill y
1434         pack $w.m.t -side left -fill both -expand 1
1435         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1436
1437         menu $w.ctxm -tearoff 0
1438         $w.ctxm add command -label "Copy" \
1439                 -font font_ui \
1440                 -command "tk_textCopy $w.m.t"
1441         $w.ctxm add command -label "Select All" \
1442                 -font font_ui \
1443                 -command "$w.m.t tag add sel 0.0 end"
1444         $w.ctxm add command -label "Copy All" \
1445                 -font font_ui \
1446                 -command "
1447                         $w.m.t tag add sel 0.0 end
1448                         tk_textCopy $w.m.t
1449                         $w.m.t tag remove sel 0.0 end
1450                 "
1451
1452         button $w.ok -text {Running...} \
1453                 -width 15 \
1454                 -font font_ui \
1455                 -state disabled \
1456                 -command "destroy $w"
1457         pack $w.ok -side bottom
1458
1459         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1460         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1461         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1462         bind $w <Visibility> "focus $w"
1463         wm title $w "$appname ([lindex [file split \
1464                 [file normalize [file dirname $gitdir]]] \
1465                 end]): [lindex $console_data($w) 0]"
1466         return $w
1467 }
1468
1469 proc console_exec {w cmd {after {}}} {
1470         global tcl_platform
1471
1472         # -- Windows tosses the enviroment when we exec our child.
1473         #    But most users need that so we have to relogin. :-(
1474         #
1475         if {$tcl_platform(platform) == {windows}} {
1476                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1477         }
1478
1479         # -- Tcl won't let us redirect both stdout and stderr to
1480         #    the same pipe.  So pass it through cat...
1481         #
1482         set cmd [concat | $cmd |& cat]
1483
1484         set fd_f [open $cmd r]
1485         fconfigure $fd_f -blocking 0 -translation binary
1486         fileevent $fd_f readable [list console_read $w $fd_f $after]
1487 }
1488
1489 proc console_read {w fd after} {
1490         global console_cr console_data
1491
1492         set buf [read $fd]
1493         if {$buf != {}} {
1494                 if {![winfo exists $w]} {console_init $w}
1495                 $w.m.t conf -state normal
1496                 set c 0
1497                 set n [string length $buf]
1498                 while {$c < $n} {
1499                         set cr [string first "\r" $buf $c]
1500                         set lf [string first "\n" $buf $c]
1501                         if {$cr < 0} {set cr [expr $n + 1]}
1502                         if {$lf < 0} {set lf [expr $n + 1]}
1503
1504                         if {$lf < $cr} {
1505                                 $w.m.t insert end [string range $buf $c $lf]
1506                                 set console_cr($w) [$w.m.t index {end -1c}]
1507                                 set c $lf
1508                                 incr c
1509                         } else {
1510                                 $w.m.t delete $console_cr($w) end
1511                                 $w.m.t insert end "\n"
1512                                 $w.m.t insert end [string range $buf $c $cr]
1513                                 set c $cr
1514                                 incr c
1515                         }
1516                 }
1517                 $w.m.t conf -state disabled
1518                 $w.m.t see end
1519         }
1520
1521         fconfigure $fd -blocking 1
1522         if {[eof $fd]} {
1523                 if {[catch {close $fd}]} {
1524                         if {![winfo exists $w]} {console_init $w}
1525                         $w.m.s conf -background red -text {Error: Command Failed}
1526                         $w.ok conf -text Close
1527                         $w.ok conf -state normal
1528                         set ok 0
1529                 } elseif {[winfo exists $w]} {
1530                         $w.m.s conf -background green -text {Success}
1531                         $w.ok conf -text Close
1532                         $w.ok conf -state normal
1533                         set ok 1
1534                 }
1535                 array unset console_cr $w
1536                 array unset console_data $w
1537                 if {$after != {}} {
1538                         uplevel #0 $after $ok
1539                 }
1540                 return
1541         }
1542         fconfigure $fd -blocking 0
1543 }
1544
1545 ######################################################################
1546 ##
1547 ## ui commands
1548
1549 set starting_gitk_msg {Please wait... Starting gitk...}
1550
1551 proc do_gitk {} {
1552         global tcl_platform ui_status_value starting_gitk_msg
1553
1554         set ui_status_value $starting_gitk_msg
1555         after 10000 {
1556                 if {$ui_status_value == $starting_gitk_msg} {
1557                         set ui_status_value {Ready.}
1558                 }
1559         }
1560
1561         if {$tcl_platform(platform) == {windows}} {
1562                 exec sh -c gitk &
1563         } else {
1564                 exec gitk &
1565         }
1566 }
1567
1568 proc do_repack {} {
1569         set w [new_console "repack" "Repacking the object database"]
1570         set cmd [list git repack]
1571         lappend cmd -a
1572         lappend cmd -d
1573         console_exec $w $cmd
1574 }
1575
1576 set is_quitting 0
1577
1578 proc do_quit {} {
1579         global gitdir ui_comm is_quitting repo_config
1580
1581         if {$is_quitting} return
1582         set is_quitting 1
1583
1584         # -- Stash our current commit buffer.
1585         #
1586         set save [file join $gitdir GITGUI_MSG]
1587         set msg [string trim [$ui_comm get 0.0 end]]
1588         if {[$ui_comm edit modified] && $msg != {}} {
1589                 catch {
1590                         set fd [open $save w]
1591                         puts $fd [string trim [$ui_comm get 0.0 end]]
1592                         close $fd
1593                 }
1594         } elseif {$msg == {} && [file exists $save]} {
1595                 file delete $save
1596         }
1597
1598         # -- Stash our current window geometry into this repository.
1599         #
1600         set cfg_geometry [list]
1601         lappend cfg_geometry [wm geometry .]
1602         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1603         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1604         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1605                 set rc_geometry {}
1606         }
1607         if {$cfg_geometry != $rc_geometry} {
1608                 catch {exec git repo-config gui.geometry $cfg_geometry}
1609         }
1610
1611         destroy .
1612 }
1613
1614 proc do_rescan {} {
1615         update_status
1616 }
1617
1618 proc do_include_all {} {
1619         global update_active ui_status_value
1620
1621         if {$update_active || ![lock_index begin-update]} return
1622
1623         set update_active 1
1624         set ui_status_value {Including all modified files...}
1625         after 1 {
1626                 with_update_index {
1627                         foreach path [array names file_states] {
1628                                 set s $file_states($path)
1629                                 set m [lindex $s 0]
1630                                 switch -- $m {
1631                                 AM -
1632                                 MM -
1633                                 _M -
1634                                 _D {toggle_mode $path}
1635                                 }
1636                         }
1637                 }
1638                 set update_active 0
1639                 set ui_status_value {Ready.}
1640         }
1641 }
1642
1643 set GIT_COMMITTER_IDENT {}
1644
1645 proc do_signoff {} {
1646         global ui_comm GIT_COMMITTER_IDENT
1647
1648         if {$GIT_COMMITTER_IDENT == {}} {
1649                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1650                         error_popup "Unable to obtain your identity:\n\n$err"
1651                         return
1652                 }
1653                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1654                         $me me GIT_COMMITTER_IDENT]} {
1655                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1656                         return
1657                 }
1658         }
1659
1660         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1661         set last [$ui_comm get {end -1c linestart} {end -1c}]
1662         if {$last != $sob} {
1663                 $ui_comm edit separator
1664                 if {$last != {}
1665                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1666                         $ui_comm insert end "\n"
1667                 }
1668                 $ui_comm insert end "\n$sob"
1669                 $ui_comm edit separator
1670                 $ui_comm see end
1671         }
1672 }
1673
1674 proc do_amend_last {} {
1675         load_last_commit
1676 }
1677
1678 proc do_commit {} {
1679         commit_tree
1680 }
1681
1682 proc do_options {} {
1683         global appname gitdir
1684         global repo_config global_config
1685         global repo_config_new global_config_new
1686
1687         load_config
1688         array unset repo_config_new
1689         array unset global_config_new
1690         foreach name [array names repo_config] {
1691                 set repo_config_new($name) $repo_config($name)
1692         }
1693         foreach name [array names global_config] {
1694                 set global_config_new($name) $global_config($name)
1695         }
1696
1697         set w .options_editor
1698         toplevel $w
1699
1700         label $w.header -text "$appname Options" \
1701                 -font font_uibold
1702         pack $w.header -side top -fill x
1703
1704         frame $w.buttons
1705         button $w.buttons.save -text Save \
1706                 -font font_ui \
1707                 -command "save_config; destroy $w"
1708         pack $w.buttons.save -side right
1709         button $w.buttons.cancel -text {Cancel} \
1710                 -font font_ui \
1711                 -command "destroy $w"
1712         pack $w.buttons.cancel -side right
1713         pack $w.buttons -side bottom -anchor e -pady 10 -padx 10
1714
1715         labelframe $w.repo -text {This Repository} \
1716                 -relief raised -borderwidth 2
1717         labelframe $w.global -text {Global (All Repositories)} \
1718                 -relief raised -borderwidth 2
1719         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1720         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1721
1722         foreach option {
1723                 {trustmtime {Trust File Modification Timestamps}}
1724                 } {
1725                 set name [lindex $option 0]
1726                 set text [lindex $option 1]
1727                 foreach f {repo global} {
1728                         checkbutton $w.$f.$name -text $text \
1729                                 -variable ${f}_config_new(gui.$name) \
1730                                 -onvalue true \
1731                                 -offvalue false \
1732                                 -font font_ui
1733                         pack $w.$f.$name -side top -anchor w
1734                 }
1735         }
1736
1737         bind $w <Visibility> "grab $w; focus $w"
1738         bind $w <Key-Escape> "destroy $w"
1739         wm title $w "$appname ([lindex [file split \
1740                 [file normalize [file dirname $gitdir]]] \
1741                 end]): Options"
1742         tkwait window $w
1743 }
1744
1745 # shift == 1: left click
1746 #          3: right click
1747 proc click {w x y shift wx wy} {
1748         global ui_index ui_other file_lists
1749
1750         set pos [split [$w index @$x,$y] .]
1751         set lno [lindex $pos 0]
1752         set col [lindex $pos 1]
1753         set path [lindex $file_lists($w) [expr $lno - 1]]
1754         if {$path == {}} return
1755
1756         if {$col > 0 && $shift == 1} {
1757                 show_diff $path $w $lno
1758         }
1759 }
1760
1761 proc unclick {w x y} {
1762         global file_lists
1763
1764         set pos [split [$w index @$x,$y] .]
1765         set lno [lindex $pos 0]
1766         set col [lindex $pos 1]
1767         set path [lindex $file_lists($w) [expr $lno - 1]]
1768         if {$path == {}} return
1769
1770         if {$col == 0} {
1771                 toggle_mode $path
1772         }
1773 }
1774
1775 ######################################################################
1776 ##
1777 ## ui init
1778
1779 set cursor_ptr arrow
1780 font create font_diff -family Courier -size 10
1781 font create font_ui
1782 catch {
1783         label .dummy
1784         eval font configure font_ui [font actual [.dummy cget -font]]
1785         destroy .dummy
1786 }
1787
1788 eval font create font_uibold [font configure font_ui]
1789 font configure font_uibold -weight bold
1790 eval font create font_diffbold [font configure font_diff]
1791 font configure font_diffbold -weight bold
1792
1793 set M1B M1
1794 set M1T M1
1795 if {$tcl_platform(platform) == {windows}} {
1796         set M1B Control
1797         set M1T Ctrl
1798 } elseif {[is_MacOSX]} {
1799         set M1B M1
1800         set M1T Cmd
1801 }
1802
1803 # -- Menu Bar
1804 menu .mbar -tearoff 0
1805 .mbar add cascade -label Project -menu .mbar.project
1806 .mbar add cascade -label Edit -menu .mbar.edit
1807 .mbar add cascade -label Commit -menu .mbar.commit
1808 .mbar add cascade -label Fetch -menu .mbar.fetch
1809 .mbar add cascade -label Pull -menu .mbar.pull
1810 .mbar add cascade -label Push -menu .mbar.push
1811 . configure -menu .mbar
1812
1813 # -- Project Menu
1814 menu .mbar.project
1815 .mbar.project add command -label Visualize \
1816         -command do_gitk \
1817         -font font_ui
1818 .mbar.project add command -label {Repack Database} \
1819         -command do_repack \
1820         -font font_ui
1821 .mbar.project add command -label Quit \
1822         -command do_quit \
1823         -accelerator $M1T-Q \
1824         -font font_ui
1825
1826 # -- Edit Menu
1827 #
1828 menu .mbar.edit
1829 .mbar.edit add command -label Undo \
1830         -command {catch {[focus] edit undo}} \
1831         -accelerator $M1T-Z \
1832         -font font_ui
1833 .mbar.edit add command -label Redo \
1834         -command {catch {[focus] edit redo}} \
1835         -accelerator $M1T-Y \
1836         -font font_ui
1837 .mbar.edit add separator
1838 .mbar.edit add command -label Cut \
1839         -command {catch {tk_textCut [focus]}} \
1840         -accelerator $M1T-X \
1841         -font font_ui
1842 .mbar.edit add command -label Copy \
1843         -command {catch {tk_textCopy [focus]}} \
1844         -accelerator $M1T-C \
1845         -font font_ui
1846 .mbar.edit add command -label Paste \
1847         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1848         -accelerator $M1T-V \
1849         -font font_ui
1850 .mbar.edit add command -label Delete \
1851         -command {catch {[focus] delete sel.first sel.last}} \
1852         -accelerator Del \
1853         -font font_ui
1854 .mbar.edit add separator
1855 .mbar.edit add command -label {Select All} \
1856         -command {catch {[focus] tag add sel 0.0 end}} \
1857         -accelerator $M1T-A \
1858         -font font_ui
1859 .mbar.edit add separator
1860 .mbar.edit add command -label {Options...} \
1861         -command do_options \
1862         -font font_ui
1863
1864 # -- Commit Menu
1865 menu .mbar.commit
1866 .mbar.commit add command -label Rescan \
1867         -command do_rescan \
1868         -accelerator F5 \
1869         -font font_ui
1870 lappend disable_on_lock \
1871         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1872 .mbar.commit add command -label {Amend Last Commit} \
1873         -command do_amend_last \
1874         -font font_ui
1875 lappend disable_on_lock \
1876         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1877 .mbar.commit add command -label {Include All Files} \
1878         -command do_include_all \
1879         -accelerator $M1T-I \
1880         -font font_ui
1881 lappend disable_on_lock \
1882         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1883 .mbar.commit add command -label {Sign Off} \
1884         -command do_signoff \
1885         -accelerator $M1T-S \
1886         -font font_ui
1887 .mbar.commit add command -label Commit \
1888         -command do_commit \
1889         -accelerator $M1T-Return \
1890         -font font_ui
1891 lappend disable_on_lock \
1892         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1893
1894 # -- Fetch Menu
1895 menu .mbar.fetch
1896
1897 # -- Pull Menu
1898 menu .mbar.pull
1899
1900 # -- Push Menu
1901 menu .mbar.push
1902
1903 # -- Main Window Layout
1904 panedwindow .vpane -orient vertical
1905 panedwindow .vpane.files -orient horizontal
1906 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1907 pack .vpane -anchor n -side top -fill both -expand 1
1908
1909 # -- Index File List
1910 frame .vpane.files.index -height 100 -width 400
1911 label .vpane.files.index.title -text {Modified Files} \
1912         -background green \
1913         -font font_ui
1914 text $ui_index -background white -borderwidth 0 \
1915         -width 40 -height 10 \
1916         -font font_ui \
1917         -cursor $cursor_ptr \
1918         -yscrollcommand {.vpane.files.index.sb set} \
1919         -state disabled
1920 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1921 pack .vpane.files.index.title -side top -fill x
1922 pack .vpane.files.index.sb -side right -fill y
1923 pack $ui_index -side left -fill both -expand 1
1924 .vpane.files add .vpane.files.index -sticky nsew
1925
1926 # -- Other (Add) File List
1927 frame .vpane.files.other -height 100 -width 100
1928 label .vpane.files.other.title -text {Untracked Files} \
1929         -background red \
1930         -font font_ui
1931 text $ui_other -background white -borderwidth 0 \
1932         -width 40 -height 10 \
1933         -font font_ui \
1934         -cursor $cursor_ptr \
1935         -yscrollcommand {.vpane.files.other.sb set} \
1936         -state disabled
1937 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1938 pack .vpane.files.other.title -side top -fill x
1939 pack .vpane.files.other.sb -side right -fill y
1940 pack $ui_other -side left -fill both -expand 1
1941 .vpane.files add .vpane.files.other -sticky nsew
1942
1943 $ui_index tag conf in_diff -font font_uibold
1944 $ui_other tag conf in_diff -font font_uibold
1945
1946 # -- Diff and Commit Area
1947 frame .vpane.lower -height 400 -width 400
1948 frame .vpane.lower.commarea
1949 frame .vpane.lower.diff -relief sunken -borderwidth 1
1950 pack .vpane.lower.commarea -side top -fill x
1951 pack .vpane.lower.diff -side bottom -fill both -expand 1
1952 .vpane add .vpane.lower -stick nsew
1953
1954 # -- Commit Area Buttons
1955 frame .vpane.lower.commarea.buttons
1956 label .vpane.lower.commarea.buttons.l -text {} \
1957         -anchor w \
1958         -justify left \
1959         -font font_ui
1960 pack .vpane.lower.commarea.buttons.l -side top -fill x
1961 pack .vpane.lower.commarea.buttons -side left -fill y
1962
1963 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1964         -command do_rescan \
1965         -font font_ui
1966 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1967 lappend disable_on_lock \
1968         {.vpane.lower.commarea.buttons.rescan conf -state}
1969
1970 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1971         -command do_amend_last \
1972         -font font_ui
1973 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1974 lappend disable_on_lock \
1975         {.vpane.lower.commarea.buttons.amend conf -state}
1976
1977 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1978         -command do_include_all \
1979         -font font_ui
1980 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1981 lappend disable_on_lock \
1982         {.vpane.lower.commarea.buttons.incall conf -state}
1983
1984 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1985         -command do_signoff \
1986         -font font_ui
1987 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1988
1989 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1990         -command do_commit \
1991         -font font_ui
1992 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1993 lappend disable_on_lock \
1994         {.vpane.lower.commarea.buttons.commit conf -state}
1995
1996 # -- Commit Message Buffer
1997 frame .vpane.lower.commarea.buffer
1998 set ui_comm .vpane.lower.commarea.buffer.t
1999 set ui_coml .vpane.lower.commarea.buffer.l
2000 label $ui_coml -text {Commit Message:} \
2001         -anchor w \
2002         -justify left \
2003         -font font_ui
2004 trace add variable commit_type write {uplevel #0 {
2005         switch -glob $commit_type \
2006         initial {$ui_coml conf -text {Initial Commit Message:}} \
2007         amend   {$ui_coml conf -text {Amended Commit Message:}} \
2008         merge   {$ui_coml conf -text {Merge Commit Message:}} \
2009         *       {$ui_coml conf -text {Commit Message:}}
2010 }}
2011 text $ui_comm -background white -borderwidth 1 \
2012         -undo true \
2013         -maxundo 20 \
2014         -autoseparators true \
2015         -relief sunken \
2016         -width 75 -height 9 -wrap none \
2017         -font font_diff \
2018         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2019 scrollbar .vpane.lower.commarea.buffer.sby \
2020         -command [list $ui_comm yview]
2021 pack $ui_coml -side top -fill x
2022 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2023 pack $ui_comm -side left -fill y
2024 pack .vpane.lower.commarea.buffer -side left -fill y
2025
2026 # -- Commit Message Buffer Context Menu
2027 #
2028 menu $ui_comm.ctxm -tearoff 0
2029 $ui_comm.ctxm add command -label "Cut" \
2030         -font font_ui \
2031         -command "tk_textCut $ui_comm"
2032 $ui_comm.ctxm add command -label "Copy" \
2033         -font font_ui \
2034         -command "tk_textCopy $ui_comm"
2035 $ui_comm.ctxm add command -label "Paste" \
2036         -font font_ui \
2037         -command "tk_textPaste $ui_comm"
2038 $ui_comm.ctxm add command -label "Delete" \
2039         -font font_ui \
2040         -command "$ui_comm delete sel.first sel.last"
2041 $ui_comm.ctxm add separator
2042 $ui_comm.ctxm add command -label "Select All" \
2043         -font font_ui \
2044         -command "$ui_comm tag add sel 0.0 end"
2045 $ui_comm.ctxm add command -label "Copy All" \
2046         -font font_ui \
2047         -command "
2048                 $ui_comm tag add sel 0.0 end
2049                 tk_textCopy $ui_comm
2050                 $ui_comm tag remove sel 0.0 end
2051         "
2052 $ui_comm.ctxm add separator
2053 $ui_comm.ctxm add command -label "Sign Off" \
2054         -font font_ui \
2055         -command do_signoff
2056 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2057
2058 # -- Diff Header
2059 set ui_fname_value {}
2060 set ui_fstatus_value {}
2061 frame .vpane.lower.diff.header -background orange
2062 label .vpane.lower.diff.header.l1 -text {File:} \
2063         -background orange \
2064         -font font_ui
2065 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2066         -background orange \
2067         -anchor w \
2068         -justify left \
2069         -font font_ui
2070 label .vpane.lower.diff.header.l3 -text {Status:} \
2071         -background orange \
2072         -font font_ui
2073 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2074         -background orange \
2075         -width $max_status_desc \
2076         -anchor w \
2077         -justify left \
2078         -font font_ui
2079 pack .vpane.lower.diff.header.l1 -side left
2080 pack .vpane.lower.diff.header.l2 -side left -fill x
2081 pack .vpane.lower.diff.header.l4 -side right
2082 pack .vpane.lower.diff.header.l3 -side right
2083
2084 # -- Diff Body
2085 frame .vpane.lower.diff.body
2086 set ui_diff .vpane.lower.diff.body.t
2087 text $ui_diff -background white -borderwidth 0 \
2088         -width 80 -height 15 -wrap none \
2089         -font font_diff \
2090         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2091         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2092         -state disabled
2093 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2094         -command [list $ui_diff xview]
2095 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2096         -command [list $ui_diff yview]
2097 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2098 pack .vpane.lower.diff.body.sby -side right -fill y
2099 pack $ui_diff -side left -fill both -expand 1
2100 pack .vpane.lower.diff.header -side top -fill x
2101 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2102
2103 $ui_diff tag conf dm -foreground red
2104 $ui_diff tag conf dp -foreground blue
2105 $ui_diff tag conf di -foreground {#00a000}
2106 $ui_diff tag conf dni -foreground {#a000a0}
2107 $ui_diff tag conf da -font font_diffbold
2108 $ui_diff tag conf bold -font font_diffbold
2109
2110 # -- Diff Body Context Menu
2111 #
2112 menu $ui_diff.ctxm -tearoff 0
2113 $ui_diff.ctxm add command -label "Copy" \
2114         -font font_ui \
2115         -command "tk_textCopy $ui_diff"
2116 $ui_diff.ctxm add command -label "Select All" \
2117         -font font_ui \
2118         -command "$ui_diff tag add sel 0.0 end"
2119 $ui_diff.ctxm add command -label "Copy All" \
2120         -font font_ui \
2121         -command "
2122                 $ui_diff tag add sel 0.0 end
2123                 tk_textCopy $ui_diff
2124                 $ui_diff tag remove sel 0.0 end
2125         "
2126 $ui_diff.ctxm add separator
2127 $ui_diff.ctxm add command -label "Decrease Font Size" \
2128         -font font_ui \
2129         -command {incr_font_size font_diff -1}
2130 $ui_diff.ctxm add command -label "Increase Font Size" \
2131         -font font_ui \
2132         -command {incr_font_size font_diff 1}
2133 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2134
2135 # -- Status Bar
2136 set ui_status_value {Initializing...}
2137 label .status -textvariable ui_status_value \
2138         -anchor w \
2139         -justify left \
2140         -borderwidth 1 \
2141         -relief sunken \
2142         -font font_ui
2143 pack .status -anchor w -side bottom -fill x
2144
2145 # -- Load geometry
2146 catch {
2147 set gm $repo_config(gui.geometry)
2148 wm geometry . [lindex $gm 0]
2149 .vpane sash place 0 \
2150         [lindex [.vpane sash coord 0] 0] \
2151         [lindex $gm 1]
2152 .vpane.files sash place 0 \
2153         [lindex $gm 2] \
2154         [lindex [.vpane.files sash coord 0] 1]
2155 unset gm
2156 }
2157
2158 # -- Key Bindings
2159 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2160 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2161 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2162 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2163 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2164 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2165 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2166 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2167 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2168 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2169 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2170
2171 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2172 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2173 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2174 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2175 bind $ui_diff <$M1B-Key-v> {break}
2176 bind $ui_diff <$M1B-Key-V> {break}
2177 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2178 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2179 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2180 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2181 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2182 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2183
2184 bind .   <Destroy> do_quit
2185 bind all <Key-F5> do_rescan
2186 bind all <$M1B-Key-r> do_rescan
2187 bind all <$M1B-Key-R> do_rescan
2188 bind .   <$M1B-Key-s> do_signoff
2189 bind .   <$M1B-Key-S> do_signoff
2190 bind .   <$M1B-Key-i> do_include_all
2191 bind .   <$M1B-Key-I> do_include_all
2192 bind .   <$M1B-Key-Return> do_commit
2193 bind all <$M1B-Key-q> do_quit
2194 bind all <$M1B-Key-Q> do_quit
2195 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2196 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2197 foreach i [list $ui_index $ui_other] {
2198         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2199         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2200         bind_button3 $i {click %W %x %y 3 %X %Y; break}
2201 }
2202 unset i
2203
2204 set file_lists($ui_index) [list]
2205 set file_lists($ui_other) [list]
2206
2207 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2208 focus -force $ui_comm
2209 load_all_remotes
2210 populate_remote_menu .mbar.fetch From fetch_from
2211 populate_remote_menu .mbar.push To push_to
2212 populate_pull_menu .mbar.pull
2213 update_status