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

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 set appname [lindex [file split $argv0] end]
  11 set gitdir {}
  12
  13 ######################################################################
  14 ##
  15 ## config
  16
  17 proc is_many_config {name} {
  18         switch -glob -- $name {
  19         remote.*.fetch -
  20         remote.*.push
  21                 {return 1}
  22         *
  23                 {return 0}
  24         }
  25 }
  26
  27 proc load_config {include_global} {
  28         global repo_config global_config default_config
  29
  30         array unset global_config
  31         if {$include_global} {
  32                 catch {
  33                         set fd_rc [open "| git repo-config --global --list" r]
  34                         while {[gets $fd_rc line] >= 0} {
  35                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                         if {[is_many_config $name]} {
  37                                                 lappend global_config($name) $value
  38                                         } else {
  39                                                 set global_config($name) $value
  40                                         }
  41                                 }
  42                         }
  43                         close $fd_rc
  44                 }
  45         }
  46
  47         array unset repo_config
  48         catch {
  49                 set fd_rc [open "| git repo-config --list" r]
  50                 while {[gets $fd_rc line] >= 0} {
  51                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                 if {[is_many_config $name]} {
  53                                         lappend repo_config($name) $value
  54                                 } else {
  55                                         set repo_config($name) $value
  56                                 }
  57                         }
  58                 }
  59                 close $fd_rc
  60         }
  61
  62         foreach name [array names default_config] {
  63                 if {[catch {set v $global_config($name)}]} {
  64                         set global_config($name) $default_config($name)
  65                 }
  66                 if {[catch {set v $repo_config($name)}]} {
  67                         set repo_config($name) $default_config($name)
  68                 }
  69         }
  70 }
  71
  72 proc save_config {} {
  73         global default_config font_descs
  74         global repo_config global_config
  75         global repo_config_new global_config_new
  76
  77         foreach option $font_descs {
  78                 set name [lindex $option 0]
  79                 set font [lindex $option 1]
  80                 font configure $font \
  81                         -family $global_config_new(gui.$font^^family) \
  82                         -size $global_config_new(gui.$font^^size)
  83                 font configure ${font}bold \
  84                         -family $global_config_new(gui.$font^^family) \
  85                         -size $global_config_new(gui.$font^^size)
  86                 set global_config_new(gui.$name) [font configure $font]
  87                 unset global_config_new(gui.$font^^family)
  88                 unset global_config_new(gui.$font^^size)
  89         }
  90
  91         foreach name [array names default_config] {
  92                 set value $global_config_new($name)
  93                 if {$value 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                                 regsub -all ' $me "'\\''" me
2053                                 regsub -all ' $gd "'\\''" gd
2054                                 puts -nonewline $fd "\"$sh\" --login -c \""
2055                                 puts -nonewline $fd "GIT_DIR='$gd'"
2056                                 puts -nonewline $fd " '$me'"
2057                                 puts $fd "&\""
2058                                 close $fd
2059                         } err]} {
2060                         error_popup "Cannot write script:\n\n$err"
2061                 }
2062         }
2063 }
2064
2065 proc toggle_or_diff {w x y} {
2066         global file_lists ui_index ui_other
2067         global last_clicked selected_paths
2068
2069         set pos [split [$w index @$x,$y] .]
2070         set lno [lindex $pos 0]
2071         set col [lindex $pos 1]
2072         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2073         if {$path eq {}} {
2074                 set last_clicked {}
2075                 return
2076         }
2077
2078         set last_clicked [list $w $lno]
2079         array unset selected_paths
2080         $ui_index tag remove in_sel 0.0 end
2081         $ui_other tag remove in_sel 0.0 end
2082
2083         if {$col == 0} {
2084                 update_index \
2085                         "Including [short_path $path]" \
2086                         [list $path] \
2087                         {set ui_status_value {Ready.}}
2088         } else {
2089                 show_diff $path $w $lno
2090         }
2091 }
2092
2093 proc add_one_to_selection {w x y} {
2094         global file_lists
2095         global last_clicked selected_paths
2096
2097         set pos [split [$w index @$x,$y] .]
2098         set lno [lindex $pos 0]
2099         set col [lindex $pos 1]
2100         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2101         if {$path eq {}} {
2102                 set last_clicked {}
2103                 return
2104         }
2105
2106         set last_clicked [list $w $lno]
2107         if {[catch {set in_sel $selected_paths($path)}]} {
2108                 set in_sel 0
2109         }
2110         if {$in_sel} {
2111                 unset selected_paths($path)
2112                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2113         } else {
2114                 set selected_paths($path) 1
2115                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2116         }
2117 }
2118
2119 proc add_range_to_selection {w x y} {
2120         global file_lists
2121         global last_clicked selected_paths
2122
2123         if {[lindex $last_clicked 0] ne $w} {
2124                 toggle_or_diff $w $x $y
2125                 return
2126         }
2127
2128         set pos [split [$w index @$x,$y] .]
2129         set lno [lindex $pos 0]
2130         set lc [lindex $last_clicked 1]
2131         if {$lc < $lno} {
2132                 set begin $lc
2133                 set end $lno
2134         } else {
2135                 set begin $lno
2136                 set end $lc
2137         }
2138
2139         foreach path [lrange $file_lists($w) \
2140                 [expr {$begin - 1}] \
2141                 [expr {$end - 1}]] {
2142                 set selected_paths($path) 1
2143         }
2144         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2145 }
2146
2147 ######################################################################
2148 ##
2149 ## config defaults
2150
2151 set cursor_ptr arrow
2152 font create font_diff -family Courier -size 10
2153 font create font_ui
2154 catch {
2155         label .dummy
2156         eval font configure font_ui [font actual [.dummy cget -font]]
2157         destroy .dummy
2158 }
2159
2160 font create font_uibold
2161 font create font_diffbold
2162
2163 set M1B M1
2164 set M1T M1
2165 if {$tcl_platform(platform) eq {windows}} {
2166         set M1B Control
2167         set M1T Ctrl
2168 } elseif {[is_MacOSX]} {
2169         set M1B M1
2170         set M1T Cmd
2171 }
2172
2173 proc apply_config {} {
2174         global repo_config font_descs
2175
2176         foreach option $font_descs {
2177                 set name [lindex $option 0]
2178                 set font [lindex $option 1]
2179                 if {[catch {
2180                         foreach {cn cv} $repo_config(gui.$name) {
2181                                 font configure $font $cn $cv
2182                         }
2183                         } err]} {
2184                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2185                 }
2186                 foreach {cn cv} [font configure $font] {
2187                         font configure ${font}bold $cn $cv
2188                 }
2189                 font configure ${font}bold -weight bold
2190         }
2191 }
2192
2193 set default_config(gui.trustmtime) false
2194 set default_config(gui.pullsummary) true
2195 set default_config(gui.partialinclude) false
2196 set default_config(gui.diffcontext) 5
2197 set default_config(gui.fontui) [font configure font_ui]
2198 set default_config(gui.fontdiff) [font configure font_diff]
2199 set font_descs {
2200         {fontui   font_ui   {Main Font}}
2201         {fontdiff font_diff {Diff/Console Font}}
2202 }
2203 load_config 0
2204 apply_config
2205
2206 ######################################################################
2207 ##
2208 ## ui construction
2209
2210 # -- Menu Bar
2211 menu .mbar -tearoff 0
2212 .mbar add cascade -label Project -menu .mbar.project
2213 .mbar add cascade -label Edit -menu .mbar.edit
2214 .mbar add cascade -label Commit -menu .mbar.commit
2215 if {!$single_commit} {
2216         .mbar add cascade -label Fetch -menu .mbar.fetch
2217         .mbar add cascade -label Pull -menu .mbar.pull
2218         .mbar add cascade -label Push -menu .mbar.push
2219 }
2220 . configure -menu .mbar
2221
2222 # -- Project Menu
2223 menu .mbar.project
2224 .mbar.project add command -label Visualize \
2225         -command do_gitk \
2226         -font font_ui
2227 if {!$single_commit} {
2228         .mbar.project add command -label {Repack Database} \
2229                 -command do_repack \
2230                 -font font_ui
2231
2232         if {$tcl_platform(platform) eq {windows}} {
2233                 .mbar.project add command \
2234                         -label {Create Desktop Icon} \
2235                         -command do_windows_shortcut \
2236                         -font font_ui
2237         }
2238 }
2239 .mbar.project add command -label Quit \
2240         -command do_quit \
2241         -accelerator $M1T-Q \
2242         -font font_ui
2243
2244 # -- Edit Menu
2245 #
2246 menu .mbar.edit
2247 .mbar.edit add command -label Undo \
2248         -command {catch {[focus] edit undo}} \
2249         -accelerator $M1T-Z \
2250         -font font_ui
2251 .mbar.edit add command -label Redo \
2252         -command {catch {[focus] edit redo}} \
2253         -accelerator $M1T-Y \
2254         -font font_ui
2255 .mbar.edit add separator
2256 .mbar.edit add command -label Cut \
2257         -command {catch {tk_textCut [focus]}} \
2258         -accelerator $M1T-X \
2259         -font font_ui
2260 .mbar.edit add command -label Copy \
2261         -command {catch {tk_textCopy [focus]}} \
2262         -accelerator $M1T-C \
2263         -font font_ui
2264 .mbar.edit add command -label Paste \
2265         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2266         -accelerator $M1T-V \
2267         -font font_ui
2268 .mbar.edit add command -label Delete \
2269         -command {catch {[focus] delete sel.first sel.last}} \
2270         -accelerator Del \
2271         -font font_ui
2272 .mbar.edit add separator
2273 .mbar.edit add command -label {Select All} \
2274         -command {catch {[focus] tag add sel 0.0 end}} \
2275         -accelerator $M1T-A \
2276         -font font_ui
2277 .mbar.edit add separator
2278 .mbar.edit add command -label {Options...} \
2279         -command do_options \
2280         -font font_ui
2281
2282 # -- Commit Menu
2283 menu .mbar.commit
2284 .mbar.commit add command -label Rescan \
2285         -command do_rescan \
2286         -accelerator F5 \
2287         -font font_ui
2288 lappend disable_on_lock \
2289         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2290 .mbar.commit add command -label {Amend Last Commit} \
2291         -command do_amend_last \
2292         -font font_ui
2293 lappend disable_on_lock \
2294         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2295 .mbar.commit add command -label {Include All Files} \
2296         -command do_include_all \
2297         -accelerator $M1T-I \
2298         -font font_ui
2299 lappend disable_on_lock \
2300         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2301 .mbar.commit add command -label {Sign Off} \
2302         -command do_signoff \
2303         -accelerator $M1T-S \
2304         -font font_ui
2305 .mbar.commit add command -label Commit \
2306         -command do_commit \
2307         -accelerator $M1T-Return \
2308         -font font_ui
2309 lappend disable_on_lock \
2310         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2311
2312 if {!$single_commit} {
2313         # -- Fetch Menu
2314         menu .mbar.fetch
2315
2316         # -- Pull Menu
2317         menu .mbar.pull
2318
2319         # -- Push Menu
2320         menu .mbar.push
2321 }
2322
2323 # -- Main Window Layout
2324 panedwindow .vpane -orient vertical
2325 panedwindow .vpane.files -orient horizontal
2326 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2327 pack .vpane -anchor n -side top -fill both -expand 1
2328
2329 # -- Index File List
2330 frame .vpane.files.index -height 100 -width 400
2331 label .vpane.files.index.title -text {Modified Files} \
2332         -background green \
2333         -font font_ui
2334 text $ui_index -background white -borderwidth 0 \
2335         -width 40 -height 10 \
2336         -font font_ui \
2337         -cursor $cursor_ptr \
2338         -yscrollcommand {.vpane.files.index.sb set} \
2339         -state disabled
2340 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2341 pack .vpane.files.index.title -side top -fill x
2342 pack .vpane.files.index.sb -side right -fill y
2343 pack $ui_index -side left -fill both -expand 1
2344 .vpane.files add .vpane.files.index -sticky nsew
2345
2346 # -- Other (Add) File List
2347 frame .vpane.files.other -height 100 -width 100
2348 label .vpane.files.other.title -text {Untracked Files} \
2349         -background red \
2350         -font font_ui
2351 text $ui_other -background white -borderwidth 0 \
2352         -width 40 -height 10 \
2353         -font font_ui \
2354         -cursor $cursor_ptr \
2355         -yscrollcommand {.vpane.files.other.sb set} \
2356         -state disabled
2357 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2358 pack .vpane.files.other.title -side top -fill x
2359 pack .vpane.files.other.sb -side right -fill y
2360 pack $ui_other -side left -fill both -expand 1
2361 .vpane.files add .vpane.files.other -sticky nsew
2362
2363 foreach i [list $ui_index $ui_other] {
2364         $i tag conf in_diff -font font_uibold
2365         $i tag conf in_sel \
2366                 -background [$i cget -foreground] \
2367                 -foreground [$i cget -background]
2368 }
2369 unset i
2370
2371 # -- Diff and Commit Area
2372 frame .vpane.lower -height 300 -width 400
2373 frame .vpane.lower.commarea
2374 frame .vpane.lower.diff -relief sunken -borderwidth 1
2375 pack .vpane.lower.commarea -side top -fill x
2376 pack .vpane.lower.diff -side bottom -fill both -expand 1
2377 .vpane add .vpane.lower -stick nsew
2378
2379 # -- Commit Area Buttons
2380 frame .vpane.lower.commarea.buttons
2381 label .vpane.lower.commarea.buttons.l -text {} \
2382         -anchor w \
2383         -justify left \
2384         -font font_ui
2385 pack .vpane.lower.commarea.buttons.l -side top -fill x
2386 pack .vpane.lower.commarea.buttons -side left -fill y
2387
2388 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2389         -command do_rescan \
2390         -font font_ui
2391 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2392 lappend disable_on_lock \
2393         {.vpane.lower.commarea.buttons.rescan conf -state}
2394
2395 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2396         -command do_amend_last \
2397         -font font_ui
2398 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2399 lappend disable_on_lock \
2400         {.vpane.lower.commarea.buttons.amend conf -state}
2401
2402 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2403         -command do_include_all \
2404         -font font_ui
2405 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2406 lappend disable_on_lock \
2407         {.vpane.lower.commarea.buttons.incall conf -state}
2408
2409 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2410         -command do_signoff \
2411         -font font_ui
2412 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2413
2414 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2415         -command do_commit \
2416         -font font_ui
2417 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2418 lappend disable_on_lock \
2419         {.vpane.lower.commarea.buttons.commit conf -state}
2420
2421 # -- Commit Message Buffer
2422 frame .vpane.lower.commarea.buffer
2423 set ui_comm .vpane.lower.commarea.buffer.t
2424 set ui_coml .vpane.lower.commarea.buffer.l
2425 label $ui_coml -text {Commit Message:} \
2426         -anchor w \
2427         -justify left \
2428         -font font_ui
2429 trace add variable commit_type write {uplevel #0 {
2430         switch -glob $commit_type \
2431         initial {$ui_coml conf -text {Initial Commit Message:}} \
2432         amend   {$ui_coml conf -text {Amended Commit Message:}} \
2433         merge   {$ui_coml conf -text {Merge Commit Message:}} \
2434         *       {$ui_coml conf -text {Commit Message:}}
2435 }}
2436 text $ui_comm -background white -borderwidth 1 \
2437         -undo true \
2438         -maxundo 20 \
2439         -autoseparators true \
2440         -relief sunken \
2441         -width 75 -height 9 -wrap none \
2442         -font font_diff \
2443         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2444 scrollbar .vpane.lower.commarea.buffer.sby \
2445         -command [list $ui_comm yview]
2446 pack $ui_coml -side top -fill x
2447 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2448 pack $ui_comm -side left -fill y
2449 pack .vpane.lower.commarea.buffer -side left -fill y
2450
2451 # -- Commit Message Buffer Context Menu
2452 #
2453 set ctxm .vpane.lower.commarea.buffer.ctxm
2454 menu $ctxm -tearoff 0
2455 $ctxm add command \
2456         -label {Cut} \
2457         -font font_ui \
2458         -command {tk_textCut $ui_comm}
2459 $ctxm add command \
2460         -label {Copy} \
2461         -font font_ui \
2462         -command {tk_textCopy $ui_comm}
2463 $ctxm add command \
2464         -label {Paste} \
2465         -font font_ui \
2466         -command {tk_textPaste $ui_comm}
2467 $ctxm add command \
2468         -label {Delete} \
2469         -font font_ui \
2470         -command {$ui_comm delete sel.first sel.last}
2471 $ctxm add separator
2472 $ctxm add command \
2473         -label {Select All} \
2474         -font font_ui \
2475         -command {$ui_comm tag add sel 0.0 end}
2476 $ctxm add command \
2477         -label {Copy All} \
2478         -font font_ui \
2479         -command {
2480                 $ui_comm tag add sel 0.0 end
2481                 tk_textCopy $ui_comm
2482                 $ui_comm tag remove sel 0.0 end
2483         }
2484 $ctxm add separator
2485 $ctxm add command \
2486         -label {Sign Off} \
2487         -font font_ui \
2488         -command do_signoff
2489 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2490
2491 # -- Diff Header
2492 set current_diff {}
2493 set diff_actions [list]
2494 proc current_diff_trace {varname args} {
2495         global current_diff diff_actions file_states
2496         if {$current_diff eq {}} {
2497                 set s {}
2498                 set f {}
2499                 set p {}
2500                 set o disabled
2501         } else {
2502                 set p $current_diff
2503                 set s [mapdesc [lindex $file_states($p) 0] $p]
2504                 set f {File:}
2505                 set p [escape_path $p]
2506                 set o normal
2507         }
2508
2509         .vpane.lower.diff.header.status configure -text $s
2510         .vpane.lower.diff.header.file configure -text $f
2511         .vpane.lower.diff.header.path configure -text $p
2512         foreach w $diff_actions {
2513                 uplevel #0 $w $o
2514         }
2515 }
2516 trace add variable current_diff write current_diff_trace
2517
2518 frame .vpane.lower.diff.header -background orange
2519 label .vpane.lower.diff.header.status \
2520         -background orange \
2521         -width $max_status_desc \
2522         -anchor w \
2523         -justify left \
2524         -font font_ui
2525 label .vpane.lower.diff.header.file \
2526         -background orange \
2527         -anchor w \
2528         -justify left \
2529         -font font_ui
2530 label .vpane.lower.diff.header.path \
2531         -background orange \
2532         -anchor w \
2533         -justify left \
2534         -font font_ui
2535 pack .vpane.lower.diff.header.status -side left
2536 pack .vpane.lower.diff.header.file -side left
2537 pack .vpane.lower.diff.header.path -fill x
2538 set ctxm .vpane.lower.diff.header.ctxm
2539 menu $ctxm -tearoff 0
2540 $ctxm add command \
2541         -label {Copy} \
2542         -font font_ui \
2543         -command {
2544                 clipboard clear
2545                 clipboard append \
2546                         -format STRING \
2547                         -type STRING \
2548                         -- $current_diff
2549         }
2550 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2551 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2552
2553 # -- Diff Body
2554 frame .vpane.lower.diff.body
2555 set ui_diff .vpane.lower.diff.body.t
2556 text $ui_diff -background white -borderwidth 0 \
2557         -width 80 -height 15 -wrap none \
2558         -font font_diff \
2559         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2560         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2561         -state disabled
2562 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2563         -command [list $ui_diff xview]
2564 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2565         -command [list $ui_diff yview]
2566 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2567 pack .vpane.lower.diff.body.sby -side right -fill y
2568 pack $ui_diff -side left -fill both -expand 1
2569 pack .vpane.lower.diff.header -side top -fill x
2570 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2571
2572 $ui_diff tag conf dm -foreground red
2573 $ui_diff tag conf dp -foreground blue
2574 $ui_diff tag conf di -foreground {#00a000}
2575 $ui_diff tag conf dni -foreground {#a000a0}
2576 $ui_diff tag conf da -font font_diffbold
2577 $ui_diff tag conf bold -font font_diffbold
2578
2579 # -- Diff Body Context Menu
2580 #
2581 set ctxm .vpane.lower.diff.body.ctxm
2582 menu $ctxm -tearoff 0
2583 $ctxm add command \
2584         -label {Copy} \
2585         -font font_ui \
2586         -command {tk_textCopy $ui_diff}
2587 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2588 $ctxm add command \
2589         -label {Select All} \
2590         -font font_ui \
2591         -command {$ui_diff tag add sel 0.0 end}
2592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2593 $ctxm add command \
2594         -label {Copy All} \
2595         -font font_ui \
2596         -command {
2597                 $ui_diff tag add sel 0.0 end
2598                 tk_textCopy $ui_diff
2599                 $ui_diff tag remove sel 0.0 end
2600         }
2601 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2602 $ctxm add separator
2603 $ctxm add command \
2604         -label {Decrease Font Size} \
2605         -font font_ui \
2606         -command {incr_font_size font_diff -1}
2607 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2608 $ctxm add command \
2609         -label {Increase Font Size} \
2610         -font font_ui \
2611         -command {incr_font_size font_diff 1}
2612 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2613 $ctxm add separator
2614 $ctxm add command \
2615         -label {Show Less Context} \
2616         -font font_ui \
2617         -command {if {$repo_config(gui.diffcontext) >= 2} {
2618                 incr repo_config(gui.diffcontext) -1
2619                 reshow_diff
2620         }}
2621 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2622 $ctxm add command \
2623         -label {Show More Context} \
2624         -font font_ui \
2625         -command {
2626                 incr repo_config(gui.diffcontext)
2627                 reshow_diff
2628         }
2629 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2630 $ctxm add separator
2631 $ctxm add command -label {Options...} \
2632         -font font_ui \
2633         -command do_options
2634 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2635
2636 # -- Status Bar
2637 #
2638 set ui_status_value {Initializing...}
2639 label .status -textvariable ui_status_value \
2640         -anchor w \
2641         -justify left \
2642         -borderwidth 1 \
2643         -relief sunken \
2644         -font font_ui
2645 pack .status -anchor w -side bottom -fill x
2646
2647 # -- Load geometry
2648 #
2649 catch {
2650 set gm $repo_config(gui.geometry)
2651 wm geometry . [lindex $gm 0]
2652 .vpane sash place 0 \
2653         [lindex [.vpane sash coord 0] 0] \
2654         [lindex $gm 1]
2655 .vpane.files sash place 0 \
2656         [lindex $gm 2] \
2657         [lindex [.vpane.files sash coord 0] 1]
2658 unset gm
2659 }
2660
2661 # -- Key Bindings
2662 #
2663 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2664 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2665 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2666 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2667 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2668 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2669 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2670 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2671 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2672 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2673 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2674
2675 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2676 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2677 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2678 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2679 bind $ui_diff <$M1B-Key-v> {break}
2680 bind $ui_diff <$M1B-Key-V> {break}
2681 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2682 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2683 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2684 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2685 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2686 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2687
2688 bind .   <Destroy> do_quit
2689 bind all <Key-F5> do_rescan
2690 bind all <$M1B-Key-r> do_rescan
2691 bind all <$M1B-Key-R> do_rescan
2692 bind .   <$M1B-Key-s> do_signoff
2693 bind .   <$M1B-Key-S> do_signoff
2694 bind .   <$M1B-Key-i> do_include_all
2695 bind .   <$M1B-Key-I> do_include_all
2696 bind .   <$M1B-Key-Return> do_commit
2697 bind all <$M1B-Key-q> do_quit
2698 bind all <$M1B-Key-Q> do_quit
2699 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2700 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2701 foreach i [list $ui_index $ui_other] {
2702         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2703         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2704         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2705 }
2706 unset i
2707
2708 set file_lists($ui_index) [list]
2709 set file_lists($ui_other) [list]
2710 set current_diff {}
2711
2712 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2713 focus -force $ui_comm
2714 if {!$single_commit} {
2715         load_all_remotes
2716         populate_remote_menu .mbar.fetch From fetch_from
2717         populate_remote_menu .mbar.push To push_to
2718         populate_pull_menu .mbar.pull
2719 }
2720 after 1 do_rescan