git.oblomov.eu Git - git/blob - git-gui

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