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