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