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