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