git-gui

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