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