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