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