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