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