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_fetch_menu {m} {
1347         global gitdir all_remotes repo_config
1348
1349         foreach r $all_remotes {
1350                 set enable 0
1351                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1352                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1353                                 set enable 1
1354                         }
1355                 } else {
1356                         catch {
1357                                 set fd [open [file join $gitdir remotes $r] r]
1358                                 while {[gets $fd n] >= 0} {
1359                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1360                                                 set enable 1
1361                                                 break
1362                                         }
1363                                 }
1364                                 close $fd
1365                         }
1366                 }
1367
1368                 if {$enable} {
1369                         $m add command \
1370                                 -label "Fetch from $r..." \
1371                                 -command [list fetch_from $r] \
1372                                 -font font_ui
1373                 }
1374         }
1375 }
1376
1377 proc populate_push_menu {m} {
1378         global gitdir all_remotes repo_config
1379
1380         foreach r $all_remotes {
1381                 set enable 0
1382                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1383                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1384                                 set enable 1
1385                         }
1386                 } else {
1387                         catch {
1388                                 set fd [open [file join $gitdir remotes $r] r]
1389                                 while {[gets $fd n] >= 0} {
1390                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1391                                                 set enable 1
1392                                                 break
1393                                         }
1394                                 }
1395                                 close $fd
1396                         }
1397                 }
1398
1399                 if {$enable} {
1400                         $m add command \
1401                                 -label "Push to $r..." \
1402                                 -command [list push_to $r] \
1403                                 -font font_ui
1404                 }
1405         }
1406 }
1407
1408 proc populate_pull_menu {m} {
1409         global gitdir repo_config all_remotes disable_on_lock
1410
1411         foreach remote $all_remotes {
1412                 set rb {}
1413                 if {[array get repo_config remote.$remote.url] ne {}} {
1414                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1415                                 regexp {^([^:]+):} \
1416                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1417                                         line rb
1418                         }
1419                 } else {
1420                         catch {
1421                                 set fd [open [file join $gitdir remotes $remote] r]
1422                                 while {[gets $fd line] >= 0} {
1423                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1424                                                 break
1425                                         }
1426                                 }
1427                                 close $fd
1428                         }
1429                 }
1430
1431                 set rb_short $rb
1432                 regsub ^refs/heads/ $rb {} rb_short
1433                 if {$rb_short ne {}} {
1434                         $m add command \
1435                                 -label "Branch $rb_short from $remote..." \
1436                                 -command [list pull_remote $remote $rb] \
1437                                 -font font_ui
1438                         lappend disable_on_lock \
1439                                 [list $m entryconf [$m index last] -state]
1440                 }
1441         }
1442 }
1443
1444 ######################################################################
1445 ##
1446 ## icons
1447
1448 set filemask {
1449 #define mask_width 14
1450 #define mask_height 15
1451 static unsigned char mask_bits[] = {
1452    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1453    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1454    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1455 }
1456
1457 image create bitmap file_plain -background white -foreground black -data {
1458 #define plain_width 14
1459 #define plain_height 15
1460 static unsigned char plain_bits[] = {
1461    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1462    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1463    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1464 } -maskdata $filemask
1465
1466 image create bitmap file_mod -background white -foreground blue -data {
1467 #define mod_width 14
1468 #define mod_height 15
1469 static unsigned char mod_bits[] = {
1470    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1471    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1472    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1473 } -maskdata $filemask
1474
1475 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1476 #define file_fulltick_width 14
1477 #define file_fulltick_height 15
1478 static unsigned char file_fulltick_bits[] = {
1479    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1480    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1481    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1482 } -maskdata $filemask
1483
1484 image create bitmap file_parttick -background white -foreground "#005050" -data {
1485 #define parttick_width 14
1486 #define parttick_height 15
1487 static unsigned char parttick_bits[] = {
1488    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1489    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1490    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1491 } -maskdata $filemask
1492
1493 image create bitmap file_question -background white -foreground black -data {
1494 #define file_question_width 14
1495 #define file_question_height 15
1496 static unsigned char file_question_bits[] = {
1497    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1498    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1499    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1500 } -maskdata $filemask
1501
1502 image create bitmap file_removed -background white -foreground red -data {
1503 #define file_removed_width 14
1504 #define file_removed_height 15
1505 static unsigned char file_removed_bits[] = {
1506    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1507    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1508    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1509 } -maskdata $filemask
1510
1511 image create bitmap file_merge -background white -foreground blue -data {
1512 #define file_merge_width 14
1513 #define file_merge_height 15
1514 static unsigned char file_merge_bits[] = {
1515    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1516    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1517    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1518 } -maskdata $filemask
1519
1520 set ui_index .vpane.files.index.list
1521 set ui_other .vpane.files.other.list
1522 set max_status_desc 0
1523 foreach i {
1524                 {__ i plain    "Unmodified"}
1525                 {_M i mod      "Modified"}
1526                 {M_ i fulltick "Included in commit"}
1527                 {MM i parttick "Partially included"}
1528
1529                 {_O o plain    "Untracked"}
1530                 {A_ o fulltick "Added by commit"}
1531                 {AM o parttick "Partially added"}
1532                 {AD o question "Added (but now gone)"}
1533
1534                 {_D i question "Missing"}
1535                 {D_ i removed  "Removed by commit"}
1536                 {DD i removed  "Removed by commit"}
1537                 {DO i removed  "Removed (still exists)"}
1538
1539                 {UM i merge    "Merge conflicts"}
1540                 {U_ i merge    "Merge conflicts"}
1541         } {
1542         if {$max_status_desc < [string length [lindex $i 3]]} {
1543                 set max_status_desc [string length [lindex $i 3]]
1544         }
1545         if {[lindex $i 1] eq {i}} {
1546                 set all_cols([lindex $i 0]) $ui_index
1547         } else {
1548                 set all_cols([lindex $i 0]) $ui_other
1549         }
1550         set all_icons([lindex $i 0]) file_[lindex $i 2]
1551         set all_descs([lindex $i 0]) [lindex $i 3]
1552 }
1553 unset filemask i
1554
1555 ######################################################################
1556 ##
1557 ## util
1558
1559 proc is_MacOSX {} {
1560         global tcl_platform tk_library
1561         if {$tcl_platform(platform) eq {unix}
1562                 && $tcl_platform(os) eq {Darwin}
1563                 && [string match /Library/Frameworks/* $tk_library]} {
1564                 return 1
1565         }
1566         return 0
1567 }
1568
1569 proc bind_button3 {w cmd} {
1570         bind $w <Any-Button-3> $cmd
1571         if {[is_MacOSX]} {
1572                 bind $w <Control-Button-1> $cmd
1573         }
1574 }
1575
1576 proc incr_font_size {font {amt 1}} {
1577         set sz [font configure $font -size]
1578         incr sz $amt
1579         font configure $font -size $sz
1580         font configure ${font}bold -size $sz
1581 }
1582
1583 proc hook_failed_popup {hook msg} {
1584         global gitdir appname
1585
1586         set w .hookfail
1587         toplevel $w
1588
1589         frame $w.m
1590         label $w.m.l1 -text "$hook hook failed:" \
1591                 -anchor w \
1592                 -justify left \
1593                 -font font_uibold
1594         text $w.m.t \
1595                 -background white -borderwidth 1 \
1596                 -relief sunken \
1597                 -width 80 -height 10 \
1598                 -font font_diff \
1599                 -yscrollcommand [list $w.m.sby set]
1600         label $w.m.l2 \
1601                 -text {You must correct the above errors before committing.} \
1602                 -anchor w \
1603                 -justify left \
1604                 -font font_uibold
1605         scrollbar $w.m.sby -command [list $w.m.t yview]
1606         pack $w.m.l1 -side top -fill x
1607         pack $w.m.l2 -side bottom -fill x
1608         pack $w.m.sby -side right -fill y
1609         pack $w.m.t -side left -fill both -expand 1
1610         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1611
1612         $w.m.t insert 1.0 $msg
1613         $w.m.t conf -state disabled
1614
1615         button $w.ok -text OK \
1616                 -width 15 \
1617                 -font font_ui \
1618                 -command "destroy $w"
1619         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1620
1621         bind $w <Visibility> "grab $w; focus $w"
1622         bind $w <Key-Return> "destroy $w"
1623         wm title $w "$appname ([lindex [file split \
1624                 [file normalize [file dirname $gitdir]]] \
1625                 end]): error"
1626         tkwait window $w
1627 }
1628
1629 set next_console_id 0
1630
1631 proc new_console {short_title long_title} {
1632         global next_console_id console_data
1633         set w .console[incr next_console_id]
1634         set console_data($w) [list $short_title $long_title]
1635         return [console_init $w]
1636 }
1637
1638 proc console_init {w} {
1639         global console_cr console_data
1640         global gitdir appname M1B
1641
1642         set console_cr($w) 1.0
1643         toplevel $w
1644         frame $w.m
1645         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1646                 -anchor w \
1647                 -justify left \
1648                 -font font_uibold
1649         text $w.m.t \
1650                 -background white -borderwidth 1 \
1651                 -relief sunken \
1652                 -width 80 -height 10 \
1653                 -font font_diff \
1654                 -state disabled \
1655                 -yscrollcommand [list $w.m.sby set]
1656         label $w.m.s -text {Working... please wait...} \
1657                 -anchor w \
1658                 -justify left \
1659                 -font font_uibold
1660         scrollbar $w.m.sby -command [list $w.m.t yview]
1661         pack $w.m.l1 -side top -fill x
1662         pack $w.m.s -side bottom -fill x
1663         pack $w.m.sby -side right -fill y
1664         pack $w.m.t -side left -fill both -expand 1
1665         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1666
1667         menu $w.ctxm -tearoff 0
1668         $w.ctxm add command -label "Copy" \
1669                 -font font_ui \
1670                 -command "tk_textCopy $w.m.t"
1671         $w.ctxm add command -label "Select All" \
1672                 -font font_ui \
1673                 -command "$w.m.t tag add sel 0.0 end"
1674         $w.ctxm add command -label "Copy All" \
1675                 -font font_ui \
1676                 -command "
1677                         $w.m.t tag add sel 0.0 end
1678                         tk_textCopy $w.m.t
1679                         $w.m.t tag remove sel 0.0 end
1680                 "
1681
1682         button $w.ok -text {Close} \
1683                 -font font_ui \
1684                 -state disabled \
1685                 -command "destroy $w"
1686         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1687
1688         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1689         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1690         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1691         bind $w <Visibility> "focus $w"
1692         wm title $w "$appname ([lindex [file split \
1693                 [file normalize [file dirname $gitdir]]] \
1694                 end]): [lindex $console_data($w) 0]"
1695         return $w
1696 }
1697
1698 proc console_exec {w cmd {after {}}} {
1699         global tcl_platform
1700
1701         # -- Windows tosses the enviroment when we exec our child.
1702         #    But most users need that so we have to relogin. :-(
1703         #
1704         if {$tcl_platform(platform) eq {windows}} {
1705                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1706         }
1707
1708         # -- Tcl won't let us redirect both stdout and stderr to
1709         #    the same pipe.  So pass it through cat...
1710         #
1711         set cmd [concat | $cmd |& cat]
1712
1713         set fd_f [open $cmd r]
1714         fconfigure $fd_f -blocking 0 -translation binary
1715         fileevent $fd_f readable [list console_read $w $fd_f $after]
1716 }
1717
1718 proc console_read {w fd after} {
1719         global console_cr console_data
1720
1721         set buf [read $fd]
1722         if {$buf ne {}} {
1723                 if {![winfo exists $w]} {console_init $w}
1724                 $w.m.t conf -state normal
1725                 set c 0
1726                 set n [string length $buf]
1727                 while {$c < $n} {
1728                         set cr [string first "\r" $buf $c]
1729                         set lf [string first "\n" $buf $c]
1730                         if {$cr < 0} {set cr [expr {$n + 1}]}
1731                         if {$lf < 0} {set lf [expr {$n + 1}]}
1732
1733                         if {$lf < $cr} {
1734                                 $w.m.t insert end [string range $buf $c $lf]
1735                                 set console_cr($w) [$w.m.t index {end -1c}]
1736                                 set c $lf
1737                                 incr c
1738                         } else {
1739                                 $w.m.t delete $console_cr($w) end
1740                                 $w.m.t insert end "\n"
1741                                 $w.m.t insert end [string range $buf $c $cr]
1742                                 set c $cr
1743                                 incr c
1744                         }
1745                 }
1746                 $w.m.t conf -state disabled
1747                 $w.m.t see end
1748         }
1749
1750         fconfigure $fd -blocking 1
1751         if {[eof $fd]} {
1752                 if {[catch {close $fd}]} {
1753                         if {![winfo exists $w]} {console_init $w}
1754                         $w.m.s conf -background red -text {Error: Command Failed}
1755                         $w.ok conf -state normal
1756                         set ok 0
1757                 } elseif {[winfo exists $w]} {
1758                         $w.m.s conf -background green -text {Success}
1759                         $w.ok conf -state normal
1760                         set ok 1
1761                 }
1762                 array unset console_cr $w
1763                 array unset console_data $w
1764                 if {$after ne {}} {
1765                         uplevel #0 $after $ok
1766                 }
1767                 return
1768         }
1769         fconfigure $fd -blocking 0
1770 }
1771
1772 ######################################################################
1773 ##
1774 ## ui commands
1775
1776 set starting_gitk_msg {Please wait... Starting gitk...}
1777
1778 proc do_gitk {} {
1779         global tcl_platform ui_status_value starting_gitk_msg
1780
1781         set ui_status_value $starting_gitk_msg
1782         after 10000 {
1783                 if {$ui_status_value eq $starting_gitk_msg} {
1784                         set ui_status_value {Ready.}
1785                 }
1786         }
1787
1788         if {$tcl_platform(platform) eq {windows}} {
1789                 exec sh -c gitk &
1790         } else {
1791                 exec gitk &
1792         }
1793 }
1794
1795 proc do_repack {} {
1796         set w [new_console "repack" "Repacking the object database"]
1797         set cmd [list git repack]
1798         lappend cmd -a
1799         lappend cmd -d
1800         console_exec $w $cmd
1801 }
1802
1803 set is_quitting 0
1804
1805 proc do_quit {} {
1806         global gitdir ui_comm is_quitting repo_config
1807
1808         if {$is_quitting} return
1809         set is_quitting 1
1810
1811         # -- Stash our current commit buffer.
1812         #
1813         set save [file join $gitdir GITGUI_MSG]
1814         set msg [string trim [$ui_comm get 0.0 end]]
1815         if {[$ui_comm edit modified] && $msg ne {}} {
1816                 catch {
1817                         set fd [open $save w]
1818                         puts $fd [string trim [$ui_comm get 0.0 end]]
1819                         close $fd
1820                 }
1821         } elseif {$msg eq {} && [file exists $save]} {
1822                 file delete $save
1823         }
1824
1825         # -- Stash our current window geometry into this repository.
1826         #
1827         set cfg_geometry [list]
1828         lappend cfg_geometry [wm geometry .]
1829         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1830         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1831         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1832                 set rc_geometry {}
1833         }
1834         if {$cfg_geometry ne $rc_geometry} {
1835                 catch {exec git repo-config gui.geometry $cfg_geometry}
1836         }
1837
1838         destroy .
1839 }
1840
1841 proc do_rescan {} {
1842         rescan {set ui_status_value {Ready.}}
1843 }
1844
1845 proc do_include_all {} {
1846         global file_states
1847
1848         if {![lock_index begin-update]} return
1849
1850         set pathList [list]
1851         foreach path [array names file_states] {
1852                 set s $file_states($path)
1853                 set m [lindex $s 0]
1854                 switch -- $m {
1855                 AM -
1856                 MM -
1857                 _M -
1858                 _D {lappend pathList $path}
1859                 }
1860         }
1861         if {$pathList eq {}} {
1862                 unlock_index
1863         } else {
1864                 update_index \
1865                         "Including all modified files" \
1866                         $pathList \
1867                         {set ui_status_value {Ready to commit.}}
1868         }
1869 }
1870
1871 set GIT_COMMITTER_IDENT {}
1872
1873 proc do_signoff {} {
1874         global ui_comm GIT_COMMITTER_IDENT
1875
1876         if {$GIT_COMMITTER_IDENT eq {}} {
1877                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1878                         error_popup "Unable to obtain your identity:\n\n$err"
1879                         return
1880                 }
1881                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1882                         $me me GIT_COMMITTER_IDENT]} {
1883                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1884                         return
1885                 }
1886         }
1887
1888         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1889         set last [$ui_comm get {end -1c linestart} {end -1c}]
1890         if {$last ne $sob} {
1891                 $ui_comm edit separator
1892                 if {$last ne {}
1893                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1894                         $ui_comm insert end "\n"
1895                 }
1896                 $ui_comm insert end "\n$sob"
1897                 $ui_comm edit separator
1898                 $ui_comm see end
1899         }
1900 }
1901
1902 proc do_amend_last {} {
1903         load_last_commit
1904 }
1905
1906 proc do_commit {} {
1907         commit_tree
1908 }
1909
1910 proc do_options {} {
1911         global appname gitdir font_descs
1912         global repo_config global_config
1913         global repo_config_new global_config_new
1914
1915         array unset repo_config_new
1916         array unset global_config_new
1917         foreach name [array names repo_config] {
1918                 set repo_config_new($name) $repo_config($name)
1919         }
1920         load_config 1
1921         foreach name [array names repo_config] {
1922                 switch -- $name {
1923                 gui.diffcontext {continue}
1924                 }
1925                 set repo_config_new($name) $repo_config($name)
1926         }
1927         foreach name [array names global_config] {
1928                 set global_config_new($name) $global_config($name)
1929         }
1930         set reponame [lindex [file split \
1931                 [file normalize [file dirname $gitdir]]] \
1932                 end]
1933
1934         set w .options_editor
1935         toplevel $w
1936         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1937
1938         label $w.header -text "$appname Options" \
1939                 -font font_uibold
1940         pack $w.header -side top -fill x
1941
1942         frame $w.buttons
1943         button $w.buttons.restore -text {Restore Defaults} \
1944                 -font font_ui \
1945                 -command do_restore_defaults
1946         pack $w.buttons.restore -side left
1947         button $w.buttons.save -text Save \
1948                 -font font_ui \
1949                 -command [list do_save_config $w]
1950         pack $w.buttons.save -side right
1951         button $w.buttons.cancel -text {Cancel} \
1952                 -font font_ui \
1953                 -command [list destroy $w]
1954         pack $w.buttons.cancel -side right
1955         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1956
1957         labelframe $w.repo -text "$reponame Repository" \
1958                 -font font_ui \
1959                 -relief raised -borderwidth 2
1960         labelframe $w.global -text {Global (All Repositories)} \
1961                 -font font_ui \
1962                 -relief raised -borderwidth 2
1963         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1964         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1965
1966         foreach option {
1967                 {b partialinclude {Allow Partially Included Files}}
1968                 {b pullsummary {Show Pull Summary}}
1969                 {b trustmtime  {Trust File Modification Timestamps}}
1970                 {i diffcontext {Number of Diff Context Lines}}
1971                 } {
1972                 set type [lindex $option 0]
1973                 set name [lindex $option 1]
1974                 set text [lindex $option 2]
1975                 foreach f {repo global} {
1976                         switch $type {
1977                         b {
1978                                 checkbutton $w.$f.$name -text $text \
1979                                         -variable ${f}_config_new(gui.$name) \
1980                                         -onvalue true \
1981                                         -offvalue false \
1982                                         -font font_ui
1983                                 pack $w.$f.$name -side top -anchor w
1984                         }
1985                         i {
1986                                 frame $w.$f.$name
1987                                 label $w.$f.$name.l -text "$text:" -font font_ui
1988                                 pack $w.$f.$name.l -side left -anchor w -fill x
1989                                 spinbox $w.$f.$name.v \
1990                                         -textvariable ${f}_config_new(gui.$name) \
1991                                         -from 1 -to 99 -increment 1 \
1992                                         -width 3 \
1993                                         -font font_ui
1994                                 pack $w.$f.$name.v -side right -anchor e
1995                                 pack $w.$f.$name -side top -anchor w -fill x
1996                         }
1997                         }
1998                 }
1999         }
2000
2001         set all_fonts [lsort [font families]]
2002         foreach option $font_descs {
2003                 set name [lindex $option 0]
2004                 set font [lindex $option 1]
2005                 set text [lindex $option 2]
2006
2007                 set global_config_new(gui.$font^^family) \
2008                         [font configure $font -family]
2009                 set global_config_new(gui.$font^^size) \
2010                         [font configure $font -size]
2011
2012                 frame $w.global.$name
2013                 label $w.global.$name.l -text "$text:" -font font_ui
2014                 pack $w.global.$name.l -side left -anchor w -fill x
2015                 eval tk_optionMenu $w.global.$name.family \
2016                         global_config_new(gui.$font^^family) \
2017                         $all_fonts
2018                 spinbox $w.global.$name.size \
2019                         -textvariable global_config_new(gui.$font^^size) \
2020                         -from 2 -to 80 -increment 1 \
2021                         -width 3 \
2022                         -font font_ui
2023                 pack $w.global.$name.size -side right -anchor e
2024                 pack $w.global.$name.family -side right -anchor e
2025                 pack $w.global.$name -side top -anchor w -fill x
2026         }
2027
2028         bind $w <Visibility> "grab $w; focus $w"
2029         bind $w <Key-Escape> "destroy $w"
2030         wm title $w "$appname ($reponame): Options"
2031         tkwait window $w
2032 }
2033
2034 proc do_restore_defaults {} {
2035         global font_descs default_config repo_config
2036         global repo_config_new global_config_new
2037
2038         foreach name [array names default_config] {
2039                 set repo_config_new($name) $default_config($name)
2040                 set global_config_new($name) $default_config($name)
2041         }
2042
2043         foreach option $font_descs {
2044                 set name [lindex $option 0]
2045                 set repo_config(gui.$name) $default_config(gui.$name)
2046         }
2047         apply_config
2048
2049         foreach option $font_descs {
2050                 set name [lindex $option 0]
2051                 set font [lindex $option 1]
2052                 set global_config_new(gui.$font^^family) \
2053                         [font configure $font -family]
2054                 set global_config_new(gui.$font^^size) \
2055                         [font configure $font -size]
2056         }
2057 }
2058
2059 proc do_save_config {w} {
2060         if {[catch {save_config} err]} {
2061                 error_popup "Failed to completely save options:\n\n$err"
2062         }
2063         reshow_diff
2064         destroy $w
2065 }
2066
2067 proc do_windows_shortcut {} {
2068         global gitdir appname argv0
2069
2070         set reponame [lindex [file split \
2071                 [file normalize [file dirname $gitdir]]] \
2072                 end]
2073
2074         if {[catch {
2075                 set desktop [exec cygpath \
2076                         --windows \
2077                         --absolute \
2078                         --long-name \
2079                         --desktop]
2080                 }]} {
2081                         set desktop .
2082         }
2083         set fn [tk_getSaveFile \
2084                 -parent . \
2085                 -title "$appname ($reponame): Create Desktop Icon" \
2086                 -initialdir $desktop \
2087                 -initialfile "Git $reponame.bat"]
2088         if {$fn != {}} {
2089                 if {[catch {
2090                                 set fd [open $fn w]
2091                                 set sh [exec cygpath \
2092                                         --windows \
2093                                         --absolute \
2094                                         --long-name \
2095                                         /bin/sh]
2096                                 set me [exec cygpath \
2097                                         --unix \
2098                                         --absolute \
2099                                         $argv0]
2100                                 set gd [exec cygpath \
2101                                         --unix \
2102                                         --absolute \
2103                                         $gitdir]
2104                                 regsub -all ' $me "'\\''" me
2105                                 regsub -all ' $gd "'\\''" gd
2106                                 puts -nonewline $fd "\"$sh\" --login -c \""
2107                                 puts -nonewline $fd "GIT_DIR='$gd'"
2108                                 puts -nonewline $fd " '$me'"
2109                                 puts $fd "&\""
2110                                 close $fd
2111                         } err]} {
2112                         error_popup "Cannot write script:\n\n$err"
2113                 }
2114         }
2115 }
2116
2117 proc toggle_or_diff {w x y} {
2118         global file_lists ui_index ui_other
2119         global last_clicked selected_paths
2120
2121         set pos [split [$w index @$x,$y] .]
2122         set lno [lindex $pos 0]
2123         set col [lindex $pos 1]
2124         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2125         if {$path eq {}} {
2126                 set last_clicked {}
2127                 return
2128         }
2129
2130         set last_clicked [list $w $lno]
2131         array unset selected_paths
2132         $ui_index tag remove in_sel 0.0 end
2133         $ui_other tag remove in_sel 0.0 end
2134
2135         if {$col == 0} {
2136                 update_index \
2137                         "Including [short_path $path]" \
2138                         [list $path] \
2139                         {set ui_status_value {Ready.}}
2140         } else {
2141                 show_diff $path $w $lno
2142         }
2143 }
2144
2145 proc add_one_to_selection {w x y} {
2146         global file_lists
2147         global last_clicked selected_paths
2148
2149         set pos [split [$w index @$x,$y] .]
2150         set lno [lindex $pos 0]
2151         set col [lindex $pos 1]
2152         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2153         if {$path eq {}} {
2154                 set last_clicked {}
2155                 return
2156         }
2157
2158         set last_clicked [list $w $lno]
2159         if {[catch {set in_sel $selected_paths($path)}]} {
2160                 set in_sel 0
2161         }
2162         if {$in_sel} {
2163                 unset selected_paths($path)
2164                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2165         } else {
2166                 set selected_paths($path) 1
2167                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2168         }
2169 }
2170
2171 proc add_range_to_selection {w x y} {
2172         global file_lists
2173         global last_clicked selected_paths
2174
2175         if {[lindex $last_clicked 0] ne $w} {
2176                 toggle_or_diff $w $x $y
2177                 return
2178         }
2179
2180         set pos [split [$w index @$x,$y] .]
2181         set lno [lindex $pos 0]
2182         set lc [lindex $last_clicked 1]
2183         if {$lc < $lno} {
2184                 set begin $lc
2185                 set end $lno
2186         } else {
2187                 set begin $lno
2188                 set end $lc
2189         }
2190
2191         foreach path [lrange $file_lists($w) \
2192                 [expr {$begin - 1}] \
2193                 [expr {$end - 1}]] {
2194                 set selected_paths($path) 1
2195         }
2196         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2197 }
2198
2199 ######################################################################
2200 ##
2201 ## config defaults
2202
2203 set cursor_ptr arrow
2204 font create font_diff -family Courier -size 10
2205 font create font_ui
2206 catch {
2207         label .dummy
2208         eval font configure font_ui [font actual [.dummy cget -font]]
2209         destroy .dummy
2210 }
2211
2212 font create font_uibold
2213 font create font_diffbold
2214
2215 set M1B M1
2216 set M1T M1
2217 if {$tcl_platform(platform) eq {windows}} {
2218         set M1B Control
2219         set M1T Ctrl
2220 } elseif {[is_MacOSX]} {
2221         set M1B M1
2222         set M1T Cmd
2223 }
2224
2225 proc apply_config {} {
2226         global repo_config font_descs
2227
2228         foreach option $font_descs {
2229                 set name [lindex $option 0]
2230                 set font [lindex $option 1]
2231                 if {[catch {
2232                         foreach {cn cv} $repo_config(gui.$name) {
2233                                 font configure $font $cn $cv
2234                         }
2235                         } err]} {
2236                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2237                 }
2238                 foreach {cn cv} [font configure $font] {
2239                         font configure ${font}bold $cn $cv
2240                 }
2241                 font configure ${font}bold -weight bold
2242         }
2243 }
2244
2245 set default_config(gui.trustmtime) false
2246 set default_config(gui.pullsummary) true
2247 set default_config(gui.partialinclude) false
2248 set default_config(gui.diffcontext) 5
2249 set default_config(gui.fontui) [font configure font_ui]
2250 set default_config(gui.fontdiff) [font configure font_diff]
2251 set font_descs {
2252         {fontui   font_ui   {Main Font}}
2253         {fontdiff font_diff {Diff/Console Font}}
2254 }
2255 load_config 0
2256 apply_config
2257
2258 ######################################################################
2259 ##
2260 ## ui construction
2261
2262 # -- Menu Bar
2263 menu .mbar -tearoff 0
2264 .mbar add cascade -label Project -menu .mbar.project
2265 .mbar add cascade -label Edit -menu .mbar.edit
2266 .mbar add cascade -label Commit -menu .mbar.commit
2267 if {!$single_commit} {
2268         .mbar add cascade -label Fetch -menu .mbar.fetch
2269         .mbar add cascade -label Pull -menu .mbar.pull
2270         .mbar add cascade -label Push -menu .mbar.push
2271 }
2272 . configure -menu .mbar
2273
2274 # -- Project Menu
2275 menu .mbar.project
2276 .mbar.project add command -label Visualize \
2277         -command do_gitk \
2278         -font font_ui
2279 if {!$single_commit} {
2280         .mbar.project add command -label {Repack Database} \
2281                 -command do_repack \
2282                 -font font_ui
2283
2284         if {$tcl_platform(platform) eq {windows}} {
2285                 .mbar.project add command \
2286                         -label {Create Desktop Icon} \
2287                         -command do_windows_shortcut \
2288                         -font font_ui
2289         }
2290 }
2291 .mbar.project add command -label Quit \
2292         -command do_quit \
2293         -accelerator $M1T-Q \
2294         -font font_ui
2295
2296 # -- Edit Menu
2297 #
2298 menu .mbar.edit
2299 .mbar.edit add command -label Undo \
2300         -command {catch {[focus] edit undo}} \
2301         -accelerator $M1T-Z \
2302         -font font_ui
2303 .mbar.edit add command -label Redo \
2304         -command {catch {[focus] edit redo}} \
2305         -accelerator $M1T-Y \
2306         -font font_ui
2307 .mbar.edit add separator
2308 .mbar.edit add command -label Cut \
2309         -command {catch {tk_textCut [focus]}} \
2310         -accelerator $M1T-X \
2311         -font font_ui
2312 .mbar.edit add command -label Copy \
2313         -command {catch {tk_textCopy [focus]}} \
2314         -accelerator $M1T-C \
2315         -font font_ui
2316 .mbar.edit add command -label Paste \
2317         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2318         -accelerator $M1T-V \
2319         -font font_ui
2320 .mbar.edit add command -label Delete \
2321         -command {catch {[focus] delete sel.first sel.last}} \
2322         -accelerator Del \
2323         -font font_ui
2324 .mbar.edit add separator
2325 .mbar.edit add command -label {Select All} \
2326         -command {catch {[focus] tag add sel 0.0 end}} \
2327         -accelerator $M1T-A \
2328         -font font_ui
2329 .mbar.edit add separator
2330 .mbar.edit add command -label {Options...} \
2331         -command do_options \
2332         -font font_ui
2333
2334 # -- Commit Menu
2335 menu .mbar.commit
2336 .mbar.commit add command -label Rescan \
2337         -command do_rescan \
2338         -accelerator F5 \
2339         -font font_ui
2340 lappend disable_on_lock \
2341         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2342 .mbar.commit add command -label {Amend Last Commit} \
2343         -command do_amend_last \
2344         -font font_ui
2345 lappend disable_on_lock \
2346         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2347 .mbar.commit add command -label {Include All Files} \
2348         -command do_include_all \
2349         -accelerator $M1T-I \
2350         -font font_ui
2351 lappend disable_on_lock \
2352         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2353 .mbar.commit add command -label {Sign Off} \
2354         -command do_signoff \
2355         -accelerator $M1T-S \
2356         -font font_ui
2357 .mbar.commit add command -label Commit \
2358         -command do_commit \
2359         -accelerator $M1T-Return \
2360         -font font_ui
2361 lappend disable_on_lock \
2362         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2363
2364 if {!$single_commit} {
2365         # -- Fetch Menu
2366         menu .mbar.fetch
2367
2368         # -- Pull Menu
2369         menu .mbar.pull
2370
2371         # -- Push Menu
2372         menu .mbar.push
2373 }
2374
2375 # -- Main Window Layout
2376 panedwindow .vpane -orient vertical
2377 panedwindow .vpane.files -orient horizontal
2378 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2379 pack .vpane -anchor n -side top -fill both -expand 1
2380
2381 # -- Index File List
2382 frame .vpane.files.index -height 100 -width 400
2383 label .vpane.files.index.title -text {Modified Files} \
2384         -background green \
2385         -font font_ui
2386 text $ui_index -background white -borderwidth 0 \
2387         -width 40 -height 10 \
2388         -font font_ui \
2389         -cursor $cursor_ptr \
2390         -yscrollcommand {.vpane.files.index.sb set} \
2391         -state disabled
2392 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2393 pack .vpane.files.index.title -side top -fill x
2394 pack .vpane.files.index.sb -side right -fill y
2395 pack $ui_index -side left -fill both -expand 1
2396 .vpane.files add .vpane.files.index -sticky nsew
2397
2398 # -- Other (Add) File List
2399 frame .vpane.files.other -height 100 -width 100
2400 label .vpane.files.other.title -text {Untracked Files} \
2401         -background red \
2402         -font font_ui
2403 text $ui_other -background white -borderwidth 0 \
2404         -width 40 -height 10 \
2405         -font font_ui \
2406         -cursor $cursor_ptr \
2407         -yscrollcommand {.vpane.files.other.sb set} \
2408         -state disabled
2409 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2410 pack .vpane.files.other.title -side top -fill x
2411 pack .vpane.files.other.sb -side right -fill y
2412 pack $ui_other -side left -fill both -expand 1
2413 .vpane.files add .vpane.files.other -sticky nsew
2414
2415 foreach i [list $ui_index $ui_other] {
2416         $i tag conf in_diff -font font_uibold
2417         $i tag conf in_sel \
2418                 -background [$i cget -foreground] \
2419                 -foreground [$i cget -background]
2420 }
2421 unset i
2422
2423 # -- Diff and Commit Area
2424 frame .vpane.lower -height 300 -width 400
2425 frame .vpane.lower.commarea
2426 frame .vpane.lower.diff -relief sunken -borderwidth 1
2427 pack .vpane.lower.commarea -side top -fill x
2428 pack .vpane.lower.diff -side bottom -fill both -expand 1
2429 .vpane add .vpane.lower -stick nsew
2430
2431 # -- Commit Area Buttons
2432 frame .vpane.lower.commarea.buttons
2433 label .vpane.lower.commarea.buttons.l -text {} \
2434         -anchor w \
2435         -justify left \
2436         -font font_ui
2437 pack .vpane.lower.commarea.buttons.l -side top -fill x
2438 pack .vpane.lower.commarea.buttons -side left -fill y
2439
2440 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2441         -command do_rescan \
2442         -font font_ui
2443 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2444 lappend disable_on_lock \
2445         {.vpane.lower.commarea.buttons.rescan conf -state}
2446
2447 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2448         -command do_amend_last \
2449         -font font_ui
2450 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2451 lappend disable_on_lock \
2452         {.vpane.lower.commarea.buttons.amend conf -state}
2453
2454 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2455         -command do_include_all \
2456         -font font_ui
2457 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2458 lappend disable_on_lock \
2459         {.vpane.lower.commarea.buttons.incall conf -state}
2460
2461 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2462         -command do_signoff \
2463         -font font_ui
2464 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2465
2466 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2467         -command do_commit \
2468         -font font_ui
2469 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2470 lappend disable_on_lock \
2471         {.vpane.lower.commarea.buttons.commit conf -state}
2472
2473 # -- Commit Message Buffer
2474 frame .vpane.lower.commarea.buffer
2475 set ui_comm .vpane.lower.commarea.buffer.t
2476 set ui_coml .vpane.lower.commarea.buffer.l
2477 label $ui_coml -text {Commit Message:} \
2478         -anchor w \
2479         -justify left \
2480         -font font_ui
2481 trace add variable commit_type write {uplevel #0 {
2482         switch -glob $commit_type \
2483         initial {$ui_coml conf -text {Initial Commit Message:}} \
2484         amend   {$ui_coml conf -text {Amended Commit Message:}} \
2485         merge   {$ui_coml conf -text {Merge Commit Message:}} \
2486         *       {$ui_coml conf -text {Commit Message:}}
2487 }}
2488 text $ui_comm -background white -borderwidth 1 \
2489         -undo true \
2490         -maxundo 20 \
2491         -autoseparators true \
2492         -relief sunken \
2493         -width 75 -height 9 -wrap none \
2494         -font font_diff \
2495         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2496 scrollbar .vpane.lower.commarea.buffer.sby \
2497         -command [list $ui_comm yview]
2498 pack $ui_coml -side top -fill x
2499 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2500 pack $ui_comm -side left -fill y
2501 pack .vpane.lower.commarea.buffer -side left -fill y
2502
2503 # -- Commit Message Buffer Context Menu
2504 #
2505 set ctxm .vpane.lower.commarea.buffer.ctxm
2506 menu $ctxm -tearoff 0
2507 $ctxm add command \
2508         -label {Cut} \
2509         -font font_ui \
2510         -command {tk_textCut $ui_comm}
2511 $ctxm add command \
2512         -label {Copy} \
2513         -font font_ui \
2514         -command {tk_textCopy $ui_comm}
2515 $ctxm add command \
2516         -label {Paste} \
2517         -font font_ui \
2518         -command {tk_textPaste $ui_comm}
2519 $ctxm add command \
2520         -label {Delete} \
2521         -font font_ui \
2522         -command {$ui_comm delete sel.first sel.last}
2523 $ctxm add separator
2524 $ctxm add command \
2525         -label {Select All} \
2526         -font font_ui \
2527         -command {$ui_comm tag add sel 0.0 end}
2528 $ctxm add command \
2529         -label {Copy All} \
2530         -font font_ui \
2531         -command {
2532                 $ui_comm tag add sel 0.0 end
2533                 tk_textCopy $ui_comm
2534                 $ui_comm tag remove sel 0.0 end
2535         }
2536 $ctxm add separator
2537 $ctxm add command \
2538         -label {Sign Off} \
2539         -font font_ui \
2540         -command do_signoff
2541 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2542
2543 # -- Diff Header
2544 set current_diff {}
2545 set diff_actions [list]
2546 proc current_diff_trace {varname args} {
2547         global current_diff diff_actions file_states
2548         if {$current_diff eq {}} {
2549                 set s {}
2550                 set f {}
2551                 set p {}
2552                 set o disabled
2553         } else {
2554                 set p $current_diff
2555                 set s [mapdesc [lindex $file_states($p) 0] $p]
2556                 set f {File:}
2557                 set p [escape_path $p]
2558                 set o normal
2559         }
2560
2561         .vpane.lower.diff.header.status configure -text $s
2562         .vpane.lower.diff.header.file configure -text $f
2563         .vpane.lower.diff.header.path configure -text $p
2564         foreach w $diff_actions {
2565                 uplevel #0 $w $o
2566         }
2567 }
2568 trace add variable current_diff write current_diff_trace
2569
2570 frame .vpane.lower.diff.header -background orange
2571 label .vpane.lower.diff.header.status \
2572         -background orange \
2573         -width $max_status_desc \
2574         -anchor w \
2575         -justify left \
2576         -font font_ui
2577 label .vpane.lower.diff.header.file \
2578         -background orange \
2579         -anchor w \
2580         -justify left \
2581         -font font_ui
2582 label .vpane.lower.diff.header.path \
2583         -background orange \
2584         -anchor w \
2585         -justify left \
2586         -font font_ui
2587 pack .vpane.lower.diff.header.status -side left
2588 pack .vpane.lower.diff.header.file -side left
2589 pack .vpane.lower.diff.header.path -fill x
2590 set ctxm .vpane.lower.diff.header.ctxm
2591 menu $ctxm -tearoff 0
2592 $ctxm add command \
2593         -label {Copy} \
2594         -font font_ui \
2595         -command {
2596                 clipboard clear
2597                 clipboard append \
2598                         -format STRING \
2599                         -type STRING \
2600                         -- $current_diff
2601         }
2602 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2603 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2604
2605 # -- Diff Body
2606 frame .vpane.lower.diff.body
2607 set ui_diff .vpane.lower.diff.body.t
2608 text $ui_diff -background white -borderwidth 0 \
2609         -width 80 -height 15 -wrap none \
2610         -font font_diff \
2611         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2612         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2613         -state disabled
2614 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2615         -command [list $ui_diff xview]
2616 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2617         -command [list $ui_diff yview]
2618 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2619 pack .vpane.lower.diff.body.sby -side right -fill y
2620 pack $ui_diff -side left -fill both -expand 1
2621 pack .vpane.lower.diff.header -side top -fill x
2622 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2623
2624 $ui_diff tag conf dm -foreground red
2625 $ui_diff tag conf dp -foreground blue
2626 $ui_diff tag conf di -foreground {#00a000}
2627 $ui_diff tag conf dni -foreground {#a000a0}
2628 $ui_diff tag conf da -font font_diffbold
2629 $ui_diff tag conf bold -font font_diffbold
2630
2631 # -- Diff Body Context Menu
2632 #
2633 set ctxm .vpane.lower.diff.body.ctxm
2634 menu $ctxm -tearoff 0
2635 $ctxm add command \
2636         -label {Copy} \
2637         -font font_ui \
2638         -command {tk_textCopy $ui_diff}
2639 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2640 $ctxm add command \
2641         -label {Select All} \
2642         -font font_ui \
2643         -command {$ui_diff tag add sel 0.0 end}
2644 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2645 $ctxm add command \
2646         -label {Copy All} \
2647         -font font_ui \
2648         -command {
2649                 $ui_diff tag add sel 0.0 end
2650                 tk_textCopy $ui_diff
2651                 $ui_diff tag remove sel 0.0 end
2652         }
2653 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2654 $ctxm add separator
2655 $ctxm add command \
2656         -label {Decrease Font Size} \
2657         -font font_ui \
2658         -command {incr_font_size font_diff -1}
2659 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2660 $ctxm add command \
2661         -label {Increase Font Size} \
2662         -font font_ui \
2663         -command {incr_font_size font_diff 1}
2664 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2665 $ctxm add separator
2666 $ctxm add command \
2667         -label {Show Less Context} \
2668         -font font_ui \
2669         -command {if {$repo_config(gui.diffcontext) >= 2} {
2670                 incr repo_config(gui.diffcontext) -1
2671                 reshow_diff
2672         }}
2673 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2674 $ctxm add command \
2675         -label {Show More Context} \
2676         -font font_ui \
2677         -command {
2678                 incr repo_config(gui.diffcontext)
2679                 reshow_diff
2680         }
2681 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2682 $ctxm add separator
2683 $ctxm add command -label {Options...} \
2684         -font font_ui \
2685         -command do_options
2686 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2687
2688 # -- Status Bar
2689 #
2690 set ui_status_value {Initializing...}
2691 label .status -textvariable ui_status_value \
2692         -anchor w \
2693         -justify left \
2694         -borderwidth 1 \
2695         -relief sunken \
2696         -font font_ui
2697 pack .status -anchor w -side bottom -fill x
2698
2699 # -- Load geometry
2700 #
2701 catch {
2702 set gm $repo_config(gui.geometry)
2703 wm geometry . [lindex $gm 0]
2704 .vpane sash place 0 \
2705         [lindex [.vpane sash coord 0] 0] \
2706         [lindex $gm 1]
2707 .vpane.files sash place 0 \
2708         [lindex $gm 2] \
2709         [lindex [.vpane.files sash coord 0] 1]
2710 unset gm
2711 }
2712
2713 # -- Key Bindings
2714 #
2715 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2716 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2717 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2718 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2719 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2720 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2721 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2722 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2723 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2724 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2725 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2726
2727 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2728 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2729 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2730 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2731 bind $ui_diff <$M1B-Key-v> {break}
2732 bind $ui_diff <$M1B-Key-V> {break}
2733 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2734 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2735 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2736 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2737 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2738 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2739
2740 bind .   <Destroy> do_quit
2741 bind all <Key-F5> do_rescan
2742 bind all <$M1B-Key-r> do_rescan
2743 bind all <$M1B-Key-R> do_rescan
2744 bind .   <$M1B-Key-s> do_signoff
2745 bind .   <$M1B-Key-S> do_signoff
2746 bind .   <$M1B-Key-i> do_include_all
2747 bind .   <$M1B-Key-I> do_include_all
2748 bind .   <$M1B-Key-Return> do_commit
2749 bind all <$M1B-Key-q> do_quit
2750 bind all <$M1B-Key-Q> do_quit
2751 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2752 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2753 foreach i [list $ui_index $ui_other] {
2754         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2755         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2756         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2757 }
2758 unset i
2759
2760 set file_lists($ui_index) [list]
2761 set file_lists($ui_other) [list]
2762 set current_diff {}
2763
2764 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2765 focus -force $ui_comm
2766 if {!$single_commit} {
2767         load_all_remotes
2768         populate_fetch_menu .mbar.fetch
2769         populate_pull_menu .mbar.pull
2770         populate_push_menu .mbar.push
2771 }
2772 after 1 do_rescan