git-gui

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