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 PkgInfo] w]
2220                                 puts -nonewline $fd {APPL????}
2221                                 close $fd
2222
2223                                 set fd [open [file join $Contents Info.plist] w]
2224                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2225 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2226 <plist version="1.0">
2227 <dict>
2228         <key>CFBundleDevelopmentRegion</key>
2229         <string>English</string>
2230         <key>CFBundleExecutable</key>
2231         <string>git-gui</string>
2232         <key>CFBundleIdentifier</key>
2233         <string>org.spearce.git-gui</string>
2234         <key>CFBundleInfoDictionaryVersion</key>
2235         <string>6.0</string>
2236         <key>CFBundlePackageType</key>
2237         <string>APPL</string>
2238         <key>CFBundleSignature</key>
2239         <string>????</string>
2240         <key>CFBundleVersion</key>
2241         <string>1.0</string>
2242         <key>NSPrincipalClass</key>
2243         <string>NSApplication</string>
2244 </dict>
2245 </plist>}
2246                                 close $fd
2247
2248                                 set fd [open $exe w]
2249                                 set gd [file normalize $gitdir]
2250                                 set ep [file normalize [exec git --exec-path]]
2251                                 regsub -all ' $gd "'\\''" gd
2252                                 regsub -all ' $ep "'\\''" ep
2253                                 puts $fd "#!/bin/sh"
2254                                 foreach name [array names env] {
2255                                         if {[string match GIT_* $name]} {
2256                                                 regsub -all ' $env($name) "'\\''" v
2257                                                 puts $fd "export $name='$v'"
2258                                         }
2259                                 }
2260                                 puts $fd "export PATH='$ep':\$PATH"
2261                                 puts $fd "export GIT_DIR='$gd'"
2262                                 puts $fd "exec [file normalize $argv0]"
2263                                 close $fd
2264
2265                                 file attributes $exe -permissions u+x,g+x,o+x
2266                         } err]} {
2267                         error_popup "Cannot write icon:\n\n$err"
2268                 }
2269         }
2270 }
2271
2272 proc toggle_or_diff {w x y} {
2273         global file_lists current_diff ui_index ui_other
2274         global last_clicked selected_paths
2275
2276         set pos [split [$w index @$x,$y] .]
2277         set lno [lindex $pos 0]
2278         set col [lindex $pos 1]
2279         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2280         if {$path eq {}} {
2281                 set last_clicked {}
2282                 return
2283         }
2284
2285         set last_clicked [list $w $lno]
2286         array unset selected_paths
2287         $ui_index tag remove in_sel 0.0 end
2288         $ui_other tag remove in_sel 0.0 end
2289
2290         if {$col == 0} {
2291                 if {$current_diff eq $path} {
2292                         set after {reshow_diff;}
2293                 } else {
2294                         set after {}
2295                 }
2296                 update_index \
2297                         "Including [short_path $path]" \
2298                         [list $path] \
2299                         [concat $after {set ui_status_value {Ready.}}]
2300         } else {
2301                 show_diff $path $w $lno
2302         }
2303 }
2304
2305 proc add_one_to_selection {w x y} {
2306         global file_lists
2307         global last_clicked selected_paths
2308
2309         set pos [split [$w index @$x,$y] .]
2310         set lno [lindex $pos 0]
2311         set col [lindex $pos 1]
2312         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2313         if {$path eq {}} {
2314                 set last_clicked {}
2315                 return
2316         }
2317
2318         set last_clicked [list $w $lno]
2319         if {[catch {set in_sel $selected_paths($path)}]} {
2320                 set in_sel 0
2321         }
2322         if {$in_sel} {
2323                 unset selected_paths($path)
2324                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2325         } else {
2326                 set selected_paths($path) 1
2327                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2328         }
2329 }
2330
2331 proc add_range_to_selection {w x y} {
2332         global file_lists
2333         global last_clicked selected_paths
2334
2335         if {[lindex $last_clicked 0] ne $w} {
2336                 toggle_or_diff $w $x $y
2337                 return
2338         }
2339
2340         set pos [split [$w index @$x,$y] .]
2341         set lno [lindex $pos 0]
2342         set lc [lindex $last_clicked 1]
2343         if {$lc < $lno} {
2344                 set begin $lc
2345                 set end $lno
2346         } else {
2347                 set begin $lno
2348                 set end $lc
2349         }
2350
2351         foreach path [lrange $file_lists($w) \
2352                 [expr {$begin - 1}] \
2353                 [expr {$end - 1}]] {
2354                 set selected_paths($path) 1
2355         }
2356         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2357 }
2358
2359 ######################################################################
2360 ##
2361 ## config defaults
2362
2363 set cursor_ptr arrow
2364 font create font_diff -family Courier -size 10
2365 font create font_ui
2366 catch {
2367         label .dummy
2368         eval font configure font_ui [font actual [.dummy cget -font]]
2369         destroy .dummy
2370 }
2371
2372 font create font_uibold
2373 font create font_diffbold
2374
2375 set M1B M1
2376 set M1T M1
2377 if {$tcl_platform(platform) eq {windows}} {
2378         set M1B Control
2379         set M1T Ctrl
2380 } elseif {[is_MacOSX]} {
2381         set M1B M1
2382         set M1T Cmd
2383 }
2384
2385 proc apply_config {} {
2386         global repo_config font_descs
2387
2388         foreach option $font_descs {
2389                 set name [lindex $option 0]
2390                 set font [lindex $option 1]
2391                 if {[catch {
2392                         foreach {cn cv} $repo_config(gui.$name) {
2393                                 font configure $font $cn $cv
2394                         }
2395                         } err]} {
2396                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2397                 }
2398                 foreach {cn cv} [font configure $font] {
2399                         font configure ${font}bold $cn $cv
2400                 }
2401                 font configure ${font}bold -weight bold
2402         }
2403 }
2404
2405 set default_config(gui.trustmtime) false
2406 set default_config(gui.pullsummary) true
2407 set default_config(gui.partialinclude) false
2408 set default_config(gui.diffcontext) 5
2409 set default_config(gui.fontui) [font configure font_ui]
2410 set default_config(gui.fontdiff) [font configure font_diff]
2411 set font_descs {
2412         {fontui   font_ui   {Main Font}}
2413         {fontdiff font_diff {Diff/Console Font}}
2414 }
2415 load_config 0
2416 apply_config
2417
2418 ######################################################################
2419 ##
2420 ## ui construction
2421
2422 # -- Menu Bar
2423 #
2424 menu .mbar -tearoff 0
2425 .mbar add cascade -label Project -menu .mbar.project
2426 .mbar add cascade -label Edit -menu .mbar.edit
2427 .mbar add cascade -label Commit -menu .mbar.commit
2428 if {!$single_commit} {
2429         .mbar add cascade -label Fetch -menu .mbar.fetch
2430         .mbar add cascade -label Pull -menu .mbar.pull
2431         .mbar add cascade -label Push -menu .mbar.push
2432 }
2433 . configure -menu .mbar
2434
2435 # -- Project Menu
2436 #
2437 menu .mbar.project
2438 .mbar.project add command -label Visualize \
2439         -command do_gitk \
2440         -font font_ui
2441 if {!$single_commit} {
2442         .mbar.project add command -label {Repack Database} \
2443                 -command do_repack \
2444                 -font font_ui
2445
2446         if {$tcl_platform(platform) eq {windows}} {
2447                 .mbar.project add command \
2448                         -label {Create Desktop Icon} \
2449                         -command do_windows_shortcut \
2450                         -font font_ui
2451         } elseif {[is_MacOSX]} {
2452                 .mbar.project add command \
2453                         -label {Create Desktop Icon} \
2454                         -command do_macosx_app \
2455                         -font font_ui
2456         }
2457 }
2458 .mbar.project add command -label Quit \
2459         -command do_quit \
2460         -accelerator $M1T-Q \
2461         -font font_ui
2462
2463 # -- Edit Menu
2464 #
2465 menu .mbar.edit
2466 .mbar.edit add command -label Undo \
2467         -command {catch {[focus] edit undo}} \
2468         -accelerator $M1T-Z \
2469         -font font_ui
2470 .mbar.edit add command -label Redo \
2471         -command {catch {[focus] edit redo}} \
2472         -accelerator $M1T-Y \
2473         -font font_ui
2474 .mbar.edit add separator
2475 .mbar.edit add command -label Cut \
2476         -command {catch {tk_textCut [focus]}} \
2477         -accelerator $M1T-X \
2478         -font font_ui
2479 .mbar.edit add command -label Copy \
2480         -command {catch {tk_textCopy [focus]}} \
2481         -accelerator $M1T-C \
2482         -font font_ui
2483 .mbar.edit add command -label Paste \
2484         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2485         -accelerator $M1T-V \
2486         -font font_ui
2487 .mbar.edit add command -label Delete \
2488         -command {catch {[focus] delete sel.first sel.last}} \
2489         -accelerator Del \
2490         -font font_ui
2491 .mbar.edit add separator
2492 .mbar.edit add command -label {Select All} \
2493         -command {catch {[focus] tag add sel 0.0 end}} \
2494         -accelerator $M1T-A \
2495         -font font_ui
2496 .mbar.edit add separator
2497 .mbar.edit add command -label {Options...} \
2498         -command do_options \
2499         -font font_ui
2500
2501 # -- Commit Menu
2502 #
2503 menu .mbar.commit
2504
2505 .mbar.commit add radiobutton \
2506         -label {New Commit} \
2507         -command do_select_commit_type \
2508         -variable selected_commit_type \
2509         -value new \
2510         -font font_ui
2511 lappend disable_on_lock \
2512         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2513
2514 .mbar.commit add radiobutton \
2515         -label {Amend Last Commit} \
2516         -command do_select_commit_type \
2517         -variable selected_commit_type \
2518         -value amend \
2519         -font font_ui
2520 lappend disable_on_lock \
2521         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2522
2523 .mbar.commit add separator
2524
2525 .mbar.commit add command -label Rescan \
2526         -command do_rescan \
2527         -accelerator F5 \
2528         -font font_ui
2529 lappend disable_on_lock \
2530         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2531
2532 .mbar.commit add command -label {Include Selected Files} \
2533         -command do_include_selection \
2534         -font font_ui
2535 lappend disable_on_lock \
2536         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2537
2538 .mbar.commit add command -label {Include All Files} \
2539         -command do_include_all \
2540         -accelerator $M1T-I \
2541         -font font_ui
2542 lappend disable_on_lock \
2543         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2544
2545 .mbar.commit add command -label {Sign Off} \
2546         -command do_signoff \
2547         -accelerator $M1T-S \
2548         -font font_ui
2549
2550 .mbar.commit add command -label Commit \
2551         -command do_commit \
2552         -accelerator $M1T-Return \
2553         -font font_ui
2554 lappend disable_on_lock \
2555         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2556
2557 # -- Transport menus
2558 #
2559 if {!$single_commit} {
2560         menu .mbar.fetch
2561         menu .mbar.pull
2562         menu .mbar.push
2563 }
2564
2565 # -- Main Window Layout
2566 #
2567 panedwindow .vpane -orient vertical
2568 panedwindow .vpane.files -orient horizontal
2569 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2570 pack .vpane -anchor n -side top -fill both -expand 1
2571
2572 # -- Index File List
2573 #
2574 frame .vpane.files.index -height 100 -width 400
2575 label .vpane.files.index.title -text {Modified Files} \
2576         -background green \
2577         -font font_ui
2578 text $ui_index -background white -borderwidth 0 \
2579         -width 40 -height 10 \
2580         -font font_ui \
2581         -cursor $cursor_ptr \
2582         -yscrollcommand {.vpane.files.index.sb set} \
2583         -state disabled
2584 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2585 pack .vpane.files.index.title -side top -fill x
2586 pack .vpane.files.index.sb -side right -fill y
2587 pack $ui_index -side left -fill both -expand 1
2588 .vpane.files add .vpane.files.index -sticky nsew
2589
2590 # -- Other (Add) File List
2591 #
2592 frame .vpane.files.other -height 100 -width 100
2593 label .vpane.files.other.title -text {Untracked Files} \
2594         -background red \
2595         -font font_ui
2596 text $ui_other -background white -borderwidth 0 \
2597         -width 40 -height 10 \
2598         -font font_ui \
2599         -cursor $cursor_ptr \
2600         -yscrollcommand {.vpane.files.other.sb set} \
2601         -state disabled
2602 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2603 pack .vpane.files.other.title -side top -fill x
2604 pack .vpane.files.other.sb -side right -fill y
2605 pack $ui_other -side left -fill both -expand 1
2606 .vpane.files add .vpane.files.other -sticky nsew
2607
2608 foreach i [list $ui_index $ui_other] {
2609         $i tag conf in_diff -font font_uibold
2610         $i tag conf in_sel \
2611                 -background [$i cget -foreground] \
2612                 -foreground [$i cget -background]
2613 }
2614 unset i
2615
2616 # -- Diff and Commit Area
2617 #
2618 frame .vpane.lower -height 300 -width 400
2619 frame .vpane.lower.commarea
2620 frame .vpane.lower.diff -relief sunken -borderwidth 1
2621 pack .vpane.lower.commarea -side top -fill x
2622 pack .vpane.lower.diff -side bottom -fill both -expand 1
2623 .vpane add .vpane.lower -stick nsew
2624
2625 # -- Commit Area Buttons
2626 #
2627 frame .vpane.lower.commarea.buttons
2628 label .vpane.lower.commarea.buttons.l -text {} \
2629         -anchor w \
2630         -justify left \
2631         -font font_ui
2632 pack .vpane.lower.commarea.buttons.l -side top -fill x
2633 pack .vpane.lower.commarea.buttons -side left -fill y
2634
2635 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2636         -command do_rescan \
2637         -font font_ui
2638 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2639 lappend disable_on_lock \
2640         {.vpane.lower.commarea.buttons.rescan conf -state}
2641
2642 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2643         -command do_include_all \
2644         -font font_ui
2645 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2646 lappend disable_on_lock \
2647         {.vpane.lower.commarea.buttons.incall conf -state}
2648
2649 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2650         -command do_signoff \
2651         -font font_ui
2652 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2653
2654 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2655         -command do_commit \
2656         -font font_ui
2657 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2658 lappend disable_on_lock \
2659         {.vpane.lower.commarea.buttons.commit conf -state}
2660
2661 # -- Commit Message Buffer
2662 #
2663 frame .vpane.lower.commarea.buffer
2664 frame .vpane.lower.commarea.buffer.header
2665 set ui_comm .vpane.lower.commarea.buffer.t
2666 set ui_coml .vpane.lower.commarea.buffer.header.l
2667 radiobutton .vpane.lower.commarea.buffer.header.new \
2668         -text {New Commit} \
2669         -command do_select_commit_type \
2670         -variable selected_commit_type \
2671         -value new \
2672         -font font_ui
2673 lappend disable_on_lock \
2674         [list .vpane.lower.commarea.buffer.header.new conf -state]
2675 radiobutton .vpane.lower.commarea.buffer.header.amend \
2676         -text {Amend Last Commit} \
2677         -command do_select_commit_type \
2678         -variable selected_commit_type \
2679         -value amend \
2680         -font font_ui
2681 lappend disable_on_lock \
2682         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2683 label $ui_coml \
2684         -anchor w \
2685         -justify left \
2686         -font font_ui
2687 proc trace_commit_type {varname args} {
2688         global ui_coml commit_type
2689         switch -glob -- $commit_type {
2690         initial       {set txt {Initial Commit Message:}}
2691         amend         {set txt {Amended Commit Message:}}
2692         amend-initial {set txt {Amended Initial Commit Message:}}
2693         merge         {set txt {Merge Commit Message:}}
2694         *             {set txt {Commit Message:}}
2695         }
2696         $ui_coml conf -text $txt
2697 }
2698 trace add variable commit_type write trace_commit_type
2699 pack $ui_coml -side left -fill x
2700 pack .vpane.lower.commarea.buffer.header.amend -side right
2701 pack .vpane.lower.commarea.buffer.header.new -side right
2702
2703 text $ui_comm -background white -borderwidth 1 \
2704         -undo true \
2705         -maxundo 20 \
2706         -autoseparators true \
2707         -relief sunken \
2708         -width 75 -height 9 -wrap none \
2709         -font font_diff \
2710         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2711 scrollbar .vpane.lower.commarea.buffer.sby \
2712         -command [list $ui_comm yview]
2713 pack .vpane.lower.commarea.buffer.header -side top -fill x
2714 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2715 pack $ui_comm -side left -fill y
2716 pack .vpane.lower.commarea.buffer -side left -fill y
2717
2718 # -- Commit Message Buffer Context Menu
2719 #
2720 set ctxm .vpane.lower.commarea.buffer.ctxm
2721 menu $ctxm -tearoff 0
2722 $ctxm add command \
2723         -label {Cut} \
2724         -font font_ui \
2725         -command {tk_textCut $ui_comm}
2726 $ctxm add command \
2727         -label {Copy} \
2728         -font font_ui \
2729         -command {tk_textCopy $ui_comm}
2730 $ctxm add command \
2731         -label {Paste} \
2732         -font font_ui \
2733         -command {tk_textPaste $ui_comm}
2734 $ctxm add command \
2735         -label {Delete} \
2736         -font font_ui \
2737         -command {$ui_comm delete sel.first sel.last}
2738 $ctxm add separator
2739 $ctxm add command \
2740         -label {Select All} \
2741         -font font_ui \
2742         -command {$ui_comm tag add sel 0.0 end}
2743 $ctxm add command \
2744         -label {Copy All} \
2745         -font font_ui \
2746         -command {
2747                 $ui_comm tag add sel 0.0 end
2748                 tk_textCopy $ui_comm
2749                 $ui_comm tag remove sel 0.0 end
2750         }
2751 $ctxm add separator
2752 $ctxm add command \
2753         -label {Sign Off} \
2754         -font font_ui \
2755         -command do_signoff
2756 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2757
2758 # -- Diff Header
2759 #
2760 set current_diff {}
2761 set diff_actions [list]
2762 proc trace_current_diff {varname args} {
2763         global current_diff diff_actions file_states
2764         if {$current_diff eq {}} {
2765                 set s {}
2766                 set f {}
2767                 set p {}
2768                 set o disabled
2769         } else {
2770                 set p $current_diff
2771                 set s [mapdesc [lindex $file_states($p) 0] $p]
2772                 set f {File:}
2773                 set p [escape_path $p]
2774                 set o normal
2775         }
2776
2777         .vpane.lower.diff.header.status configure -text $s
2778         .vpane.lower.diff.header.file configure -text $f
2779         .vpane.lower.diff.header.path configure -text $p
2780         foreach w $diff_actions {
2781                 uplevel #0 $w $o
2782         }
2783 }
2784 trace add variable current_diff write trace_current_diff
2785
2786 frame .vpane.lower.diff.header -background orange
2787 label .vpane.lower.diff.header.status \
2788         -background orange \
2789         -width $max_status_desc \
2790         -anchor w \
2791         -justify left \
2792         -font font_ui
2793 label .vpane.lower.diff.header.file \
2794         -background orange \
2795         -anchor w \
2796         -justify left \
2797         -font font_ui
2798 label .vpane.lower.diff.header.path \
2799         -background orange \
2800         -anchor w \
2801         -justify left \
2802         -font font_ui
2803 pack .vpane.lower.diff.header.status -side left
2804 pack .vpane.lower.diff.header.file -side left
2805 pack .vpane.lower.diff.header.path -fill x
2806 set ctxm .vpane.lower.diff.header.ctxm
2807 menu $ctxm -tearoff 0
2808 $ctxm add command \
2809         -label {Copy} \
2810         -font font_ui \
2811         -command {
2812                 clipboard clear
2813                 clipboard append \
2814                         -format STRING \
2815                         -type STRING \
2816                         -- $current_diff
2817         }
2818 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2819 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2820
2821 # -- Diff Body
2822 #
2823 frame .vpane.lower.diff.body
2824 set ui_diff .vpane.lower.diff.body.t
2825 text $ui_diff -background white -borderwidth 0 \
2826         -width 80 -height 15 -wrap none \
2827         -font font_diff \
2828         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2829         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2830         -state disabled
2831 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2832         -command [list $ui_diff xview]
2833 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2834         -command [list $ui_diff yview]
2835 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2836 pack .vpane.lower.diff.body.sby -side right -fill y
2837 pack $ui_diff -side left -fill both -expand 1
2838 pack .vpane.lower.diff.header -side top -fill x
2839 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2840
2841 $ui_diff tag conf dm -foreground red
2842 $ui_diff tag conf dp -foreground blue
2843 $ui_diff tag conf di -foreground {#00a000}
2844 $ui_diff tag conf dni -foreground {#a000a0}
2845 $ui_diff tag conf da -font font_diffbold
2846 $ui_diff tag conf bold -font font_diffbold
2847
2848 # -- Diff Body Context Menu
2849 #
2850 set ctxm .vpane.lower.diff.body.ctxm
2851 menu $ctxm -tearoff 0
2852 $ctxm add command \
2853         -label {Copy} \
2854         -font font_ui \
2855         -command {tk_textCopy $ui_diff}
2856 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2857 $ctxm add command \
2858         -label {Select All} \
2859         -font font_ui \
2860         -command {$ui_diff tag add sel 0.0 end}
2861 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2862 $ctxm add command \
2863         -label {Copy All} \
2864         -font font_ui \
2865         -command {
2866                 $ui_diff tag add sel 0.0 end
2867                 tk_textCopy $ui_diff
2868                 $ui_diff tag remove sel 0.0 end
2869         }
2870 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2871 $ctxm add separator
2872 $ctxm add command \
2873         -label {Decrease Font Size} \
2874         -font font_ui \
2875         -command {incr_font_size font_diff -1}
2876 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2877 $ctxm add command \
2878         -label {Increase Font Size} \
2879         -font font_ui \
2880         -command {incr_font_size font_diff 1}
2881 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2882 $ctxm add separator
2883 $ctxm add command \
2884         -label {Show Less Context} \
2885         -font font_ui \
2886         -command {if {$repo_config(gui.diffcontext) >= 2} {
2887                 incr repo_config(gui.diffcontext) -1
2888                 reshow_diff
2889         }}
2890 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2891 $ctxm add command \
2892         -label {Show More Context} \
2893         -font font_ui \
2894         -command {
2895                 incr repo_config(gui.diffcontext)
2896                 reshow_diff
2897         }
2898 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2899 $ctxm add separator
2900 $ctxm add command -label {Options...} \
2901         -font font_ui \
2902         -command do_options
2903 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2904
2905 # -- Status Bar
2906 #
2907 set ui_status_value {Initializing...}
2908 label .status -textvariable ui_status_value \
2909         -anchor w \
2910         -justify left \
2911         -borderwidth 1 \
2912         -relief sunken \
2913         -font font_ui
2914 pack .status -anchor w -side bottom -fill x
2915
2916 # -- Load geometry
2917 #
2918 catch {
2919 set gm $repo_config(gui.geometry)
2920 wm geometry . [lindex $gm 0]
2921 .vpane sash place 0 \
2922         [lindex [.vpane sash coord 0] 0] \
2923         [lindex $gm 1]
2924 .vpane.files sash place 0 \
2925         [lindex $gm 2] \
2926         [lindex [.vpane.files sash coord 0] 1]
2927 unset gm
2928 }
2929
2930 # -- Key Bindings
2931 #
2932 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2933 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2934 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2935 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2936 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2937 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2938 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2939 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2940 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2941 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2942 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2943
2944 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2945 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2946 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2947 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2948 bind $ui_diff <$M1B-Key-v> {break}
2949 bind $ui_diff <$M1B-Key-V> {break}
2950 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2951 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2952 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2953 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2954 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2955 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2956
2957 bind .   <Destroy> do_quit
2958 bind all <Key-F5> do_rescan
2959 bind all <$M1B-Key-r> do_rescan
2960 bind all <$M1B-Key-R> do_rescan
2961 bind .   <$M1B-Key-s> do_signoff
2962 bind .   <$M1B-Key-S> do_signoff
2963 bind .   <$M1B-Key-i> do_include_all
2964 bind .   <$M1B-Key-I> do_include_all
2965 bind .   <$M1B-Key-Return> do_commit
2966 bind all <$M1B-Key-q> do_quit
2967 bind all <$M1B-Key-Q> do_quit
2968 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2969 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2970 foreach i [list $ui_index $ui_other] {
2971         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2972         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2973         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2974 }
2975 unset i
2976
2977 set file_lists($ui_index) [list]
2978 set file_lists($ui_other) [list]
2979
2980 set HEAD {}
2981 set PARENT {}
2982 set commit_type {}
2983 set empty_tree {}
2984 set current_diff {}
2985 set selected_commit_type new
2986
2987 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2988 focus -force $ui_comm
2989 if {!$single_commit} {
2990         load_all_remotes
2991         populate_fetch_menu .mbar.fetch
2992         populate_pull_menu .mbar.pull
2993         populate_push_menu .mbar.push
2994 }
2995 lock_index begin-read
2996 after 1 do_rescan