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 load_repo_config {} {
  18         global repo_config
  19         global cfg_trust_mtime
  20
  21         array unset repo_config
  22         catch {
  23                 set fd_rc [open "| git repo-config --list" r]
  24                 while {[gets $fd_rc line] >= 0} {
  25                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  26                                 lappend repo_config($name) $value
  27                         }
  28                 }
  29                 close $fd_rc
  30         }
  31
  32         if {[catch {set cfg_trust_mtime \
  33                         [lindex $repo_config(gui.trustmtime) 0]
  34                 }]} {
  35                 set cfg_trust_mtime false
  36         }
  37 }
  38
  39 proc save_my_config {} {
  40         global repo_config
  41         global cfg_trust_mtime
  42
  43         if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
  44                 set rc_trustMTime [list false]
  45         }
  46         if {$cfg_trust_mtime != [lindex $rc_trustMTime 0]} {
  47                 exec git repo-config gui.trustMTime $cfg_trust_mtime
  48                 set repo_config(gui.trustmtime) [list $cfg_trust_mtime]
  49         }
  50
  51         set cfg_geometry [wm geometry .]
  52         append cfg_geometry " [lindex [.vpane sash coord 0] 1]"
  53         append cfg_geometry " [lindex [.vpane.files sash coord 0] 0]"
  54         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
  55                 set rc_geometry [list [list]]
  56         }
  57         if {$cfg_geometry != [lindex $rc_geometry 0]} {
  58                 exec git repo-config gui.geometry $cfg_geometry
  59                 set repo_config(gui.geometry) [list $cfg_geometry]
  60         }
  61 }
  62
  63 proc error_popup {msg} {
  64         global gitdir appname
  65
  66         set title $appname
  67         if {$gitdir != {}} {
  68                 append title { (}
  69                 append title [lindex \
  70                         [file split [file normalize [file dirname $gitdir]]] \
  71                         end]
  72                 append title {)}
  73         }
  74         tk_messageBox \
  75                 -parent . \
  76                 -icon error \
  77                 -type ok \
  78                 -title "$title: error" \
  79                 -message $msg
  80 }
  81
  82 ######################################################################
  83 ##
  84 ## repository setup
  85
  86 if {   [catch {set cdup [exec git rev-parse --show-cdup]} err]
  87         || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
  88         catch {wm withdraw .}
  89         error_popup "Cannot find the git directory:\n\n$err"
  90         exit 1
  91 }
  92 if {$cdup != ""} {
  93         cd $cdup
  94 }
  95 unset cdup
  96
  97 if {$appname == {git-citool}} {
  98         set single_commit 1
  99 }
 100
 101 load_repo_config
 102
 103 ######################################################################
 104 ##
 105 ## task management
 106
 107 set single_commit 0
 108 set status_active 0
 109 set diff_active 0
 110 set update_active 0
 111 set commit_active 0
 112 set update_index_fd {}
 113
 114 set disable_on_lock [list]
 115 set index_lock_type none
 116
 117 set HEAD {}
 118 set PARENT {}
 119 set commit_type {}
 120
 121 proc lock_index {type} {
 122         global index_lock_type disable_on_lock
 123
 124         if {$index_lock_type == {none}} {
 125                 set index_lock_type $type
 126                 foreach w $disable_on_lock {
 127                         uplevel #0 $w disabled
 128                 }
 129                 return 1
 130         } elseif {$index_lock_type == {begin-update} && $type == {update}} {
 131                 set index_lock_type $type
 132                 return 1
 133         }
 134         return 0
 135 }
 136
 137 proc unlock_index {} {
 138         global index_lock_type disable_on_lock
 139
 140         set index_lock_type none
 141         foreach w $disable_on_lock {
 142                 uplevel #0 $w normal
 143         }
 144 }
 145
 146 ######################################################################
 147 ##
 148 ## status
 149
 150 proc repository_state {hdvar ctvar} {
 151         global gitdir
 152         upvar $hdvar hd $ctvar ct
 153
 154         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 155                 set ct initial
 156         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 157                 set ct merge
 158         } else {
 159                 set ct normal
 160         }
 161 }
 162
 163 proc update_status {{final Ready.}} {
 164         global HEAD PARENT commit_type
 165         global ui_index ui_other ui_status_value ui_comm
 166         global status_active file_states
 167         global cfg_trust_mtime
 168
 169         if {$status_active || ![lock_index read]} return
 170
 171         repository_state new_HEAD new_type
 172         if {$commit_type == {amend}
 173                 && $new_type == {normal}
 174                 && $new_HEAD == $HEAD} {
 175         } else {
 176                 set HEAD $new_HEAD
 177                 set PARENT $new_HEAD
 178                 set commit_type $new_type
 179         }
 180
 181         array unset file_states
 182
 183         if {![$ui_comm edit modified]
 184                 || [string trim [$ui_comm get 0.0 end]] == {}} {
 185                 if {[load_message GITGUI_MSG]} {
 186                 } elseif {[load_message MERGE_MSG]} {
 187                 } elseif {[load_message SQUASH_MSG]} {
 188                 }
 189                 $ui_comm edit modified false
 190                 $ui_comm edit reset
 191         }
 192
 193         if {$cfg_trust_mtime == {true}} {
 194                 update_status_stage2 {} $final
 195         } else {
 196                 set status_active 1
 197                 set ui_status_value {Refreshing file status...}
 198                 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
 199                 fconfigure $fd_rf -blocking 0 -translation binary
 200                 fileevent $fd_rf readable \
 201                         [list update_status_stage2 $fd_rf $final]
 202         }
 203 }
 204
 205 proc update_status_stage2 {fd final} {
 206         global gitdir PARENT commit_type
 207         global ui_index ui_other ui_status_value ui_comm
 208         global status_active
 209         global buf_rdi buf_rdf buf_rlo
 210
 211         if {$fd != {}} {
 212                 read $fd
 213                 if {![eof $fd]} return
 214                 close $fd
 215         }
 216
 217         set ls_others [list | git ls-files --others -z \
 218                 --exclude-per-directory=.gitignore]
 219         set info_exclude [file join $gitdir info exclude]
 220         if {[file readable $info_exclude]} {
 221                 lappend ls_others "--exclude-from=$info_exclude"
 222         }
 223
 224         set buf_rdi {}
 225         set buf_rdf {}
 226         set buf_rlo {}
 227
 228         set status_active 3
 229         set ui_status_value {Scanning for modified files ...}
 230         set fd_di [open "| git diff-index --cached -z $PARENT" r]
 231         set fd_df [open "| git diff-files -z" r]
 232         set fd_lo [open $ls_others r]
 233
 234         fconfigure $fd_di -blocking 0 -translation binary
 235         fconfigure $fd_df -blocking 0 -translation binary
 236         fconfigure $fd_lo -blocking 0 -translation binary
 237         fileevent $fd_di readable [list read_diff_index $fd_di $final]
 238         fileevent $fd_df readable [list read_diff_files $fd_df $final]
 239         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 240 }
 241
 242 proc load_message {file} {
 243         global gitdir ui_comm
 244
 245         set f [file join $gitdir $file]
 246         if {[file isfile $f]} {
 247                 if {[catch {set fd [open $f r]}]} {
 248                         return 0
 249                 }
 250                 set content [string trim [read $fd]]
 251                 close $fd
 252                 $ui_comm delete 0.0 end
 253                 $ui_comm insert end $content
 254                 return 1
 255         }
 256         return 0
 257 }
 258
 259 proc read_diff_index {fd final} {
 260         global buf_rdi
 261
 262         append buf_rdi [read $fd]
 263         set c 0
 264         set n [string length $buf_rdi]
 265         while {$c < $n} {
 266                 set z1 [string first "\0" $buf_rdi $c]
 267                 if {$z1 == -1} break
 268                 incr z1
 269                 set z2 [string first "\0" $buf_rdi $z1]
 270                 if {$z2 == -1} break
 271
 272                 set c $z2
 273                 incr z2 -1
 274                 display_file \
 275                         [string range $buf_rdi $z1 $z2] \
 276                         [string index $buf_rdi [expr $z1 - 2]]_
 277                 incr c
 278         }
 279         if {$c < $n} {
 280                 set buf_rdi [string range $buf_rdi $c end]
 281         } else {
 282                 set buf_rdi {}
 283         }
 284
 285         status_eof $fd buf_rdi $final
 286 }
 287
 288 proc read_diff_files {fd final} {
 289         global buf_rdf
 290
 291         append buf_rdf [read $fd]
 292         set c 0
 293         set n [string length $buf_rdf]
 294         while {$c < $n} {
 295                 set z1 [string first "\0" $buf_rdf $c]
 296                 if {$z1 == -1} break
 297                 incr z1
 298                 set z2 [string first "\0" $buf_rdf $z1]
 299                 if {$z2 == -1} break
 300
 301                 set c $z2
 302                 incr z2 -1
 303                 display_file \
 304                         [string range $buf_rdf $z1 $z2] \
 305                         _[string index $buf_rdf [expr $z1 - 2]]
 306                 incr c
 307         }
 308         if {$c < $n} {
 309                 set buf_rdf [string range $buf_rdf $c end]
 310         } else {
 311                 set buf_rdf {}
 312         }
 313
 314         status_eof $fd buf_rdf $final
 315 }
 316
 317 proc read_ls_others {fd final} {
 318         global buf_rlo
 319
 320         append buf_rlo [read $fd]
 321         set pck [split $buf_rlo "\0"]
 322         set buf_rlo [lindex $pck end]
 323         foreach p [lrange $pck 0 end-1] {
 324                 display_file $p _O
 325         }
 326         status_eof $fd buf_rlo $final
 327 }
 328
 329 proc status_eof {fd buf final} {
 330         global status_active ui_status_value
 331         upvar $buf to_clear
 332
 333         if {[eof $fd]} {
 334                 set to_clear {}
 335                 close $fd
 336
 337                 if {[incr status_active -1] == 0} {
 338                         display_all_files
 339                         unlock_index
 340                         reshow_diff
 341                         set ui_status_value $final
 342                 }
 343         }
 344 }
 345
 346 ######################################################################
 347 ##
 348 ## diff
 349
 350 proc clear_diff {} {
 351         global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
 352
 353         $ui_diff conf -state normal
 354         $ui_diff delete 0.0 end
 355         $ui_diff conf -state disabled
 356
 357         set ui_fname_value {}
 358         set ui_fstatus_value {}
 359
 360         $ui_index tag remove in_diff 0.0 end
 361         $ui_other tag remove in_diff 0.0 end
 362 }
 363
 364 proc reshow_diff {} {
 365         global ui_fname_value ui_status_value file_states
 366
 367         if {$ui_fname_value == {}
 368                 || [catch {set s $file_states($ui_fname_value)}]} {
 369                 clear_diff
 370         } else {
 371                 show_diff $ui_fname_value
 372         }
 373 }
 374
 375 proc show_diff {path {w {}} {lno {}}} {
 376         global file_states file_lists
 377         global PARENT diff_3way diff_active
 378         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 379
 380         if {$diff_active || ![lock_index read]} return
 381
 382         clear_diff
 383         if {$w == {} || $lno == {}} {
 384                 foreach w [array names file_lists] {
 385                         set lno [lsearch -sorted $file_lists($w) $path]
 386                         if {$lno >= 0} {
 387                                 incr lno
 388                                 break
 389                         }
 390                 }
 391         }
 392         if {$w != {} && $lno >= 1} {
 393                 $w tag add in_diff $lno.0 [expr $lno + 1].0
 394         }
 395
 396         set s $file_states($path)
 397         set m [lindex $s 0]
 398         set diff_3way 0
 399         set diff_active 1
 400         set ui_fname_value [escape_path $path]
 401         set ui_fstatus_value [mapdesc $m $path]
 402         set ui_status_value "Loading diff of [escape_path $path]..."
 403
 404         set cmd [list | git diff-index -p $PARENT -- $path]
 405         switch $m {
 406         MM {
 407                 set cmd [list | git diff-index -p -c $PARENT $path]
 408         }
 409         _O {
 410                 if {[catch {
 411                                 set fd [open $path r]
 412                                 set content [read $fd]
 413                                 close $fd
 414                         } err ]} {
 415                         set diff_active 0
 416                         unlock_index
 417                         set ui_status_value "Unable to display [escape_path $path]"
 418                         error_popup "Error loading file:\n\n$err"
 419                         return
 420                 }
 421                 $ui_diff conf -state normal
 422                 $ui_diff insert end $content
 423                 $ui_diff conf -state disabled
 424                 set diff_active 0
 425                 unlock_index
 426                 set ui_status_value {Ready.}
 427                 return
 428         }
 429         }
 430
 431         if {[catch {set fd [open $cmd r]} err]} {
 432                 set diff_active 0
 433                 unlock_index
 434                 set ui_status_value "Unable to display [escape_path $path]"
 435                 error_popup "Error loading diff:\n\n$err"
 436                 return
 437         }
 438
 439         fconfigure $fd -blocking 0 -translation auto
 440         fileevent $fd readable [list read_diff $fd]
 441 }
 442
 443 proc read_diff {fd} {
 444         global ui_diff ui_status_value diff_3way diff_active
 445
 446         while {[gets $fd line] >= 0} {
 447                 if {[string match {diff --git *} $line]} continue
 448                 if {[string match {diff --combined *} $line]} continue
 449                 if {[string match {--- *} $line]} continue
 450                 if {[string match {+++ *} $line]} continue
 451                 if {[string match index* $line]} {
 452                         if {[string first , $line] >= 0} {
 453                                 set diff_3way 1
 454                         }
 455                 }
 456
 457                 $ui_diff conf -state normal
 458                 if {!$diff_3way} {
 459                         set x [string index $line 0]
 460                         switch -- $x {
 461                         "@" {set tags da}
 462                         "+" {set tags dp}
 463                         "-" {set tags dm}
 464                         default {set tags {}}
 465                         }
 466                 } else {
 467                         set x [string range $line 0 1]
 468                         switch -- $x {
 469                         default {set tags {}}
 470                         "@@" {set tags da}
 471                         "++" {set tags dp; set x " +"}
 472                         " +" {set tags {di bold}; set x "++"}
 473                         "+ " {set tags dni; set x "-+"}
 474                         "--" {set tags dm; set x " -"}
 475                         " -" {set tags {dm bold}; set x "--"}
 476                         "- " {set tags di; set x "+-"}
 477                         default {set tags {}}
 478                         }
 479                         set line [string replace $line 0 1 $x]
 480                 }
 481                 $ui_diff insert end $line $tags
 482                 $ui_diff insert end "\n"
 483                 $ui_diff conf -state disabled
 484         }
 485
 486         if {[eof $fd]} {
 487                 close $fd
 488                 set diff_active 0
 489                 unlock_index
 490                 set ui_status_value {Ready.}
 491         }
 492 }
 493
 494 ######################################################################
 495 ##
 496 ## commit
 497
 498 proc load_last_commit {} {
 499         global HEAD PARENT commit_type ui_comm
 500
 501         if {$commit_type == {amend}} return
 502         if {$commit_type != {normal}} {
 503                 error_popup "Can't amend a $commit_type commit."
 504                 return
 505         }
 506
 507         set msg {}
 508         set parent {}
 509         set parent_count 0
 510         if {[catch {
 511                         set fd [open "| git cat-file commit $HEAD" r]
 512                         while {[gets $fd line] > 0} {
 513                                 if {[string match {parent *} $line]} {
 514                                         set parent [string range $line 7 end]
 515                                         incr parent_count
 516                                 }
 517                         }
 518                         set msg [string trim [read $fd]]
 519                         close $fd
 520                 } err]} {
 521                 error_popup "Error loading commit data for amend:\n\n$err"
 522                 return
 523         }
 524
 525         if {$parent_count == 0} {
 526                 set commit_type amend
 527                 set HEAD {}
 528                 set PARENT {}
 529                 update_status
 530         } elseif {$parent_count == 1} {
 531                 set commit_type amend
 532                 set PARENT $parent
 533                 $ui_comm delete 0.0 end
 534                 $ui_comm insert end $msg
 535                 $ui_comm edit modified false
 536                 $ui_comm edit reset
 537                 update_status
 538         } else {
 539                 error_popup {You can't amend a merge commit.}
 540                 return
 541         }
 542 }
 543
 544 proc commit_tree {} {
 545         global tcl_platform HEAD gitdir commit_type file_states
 546         global commit_active ui_status_value
 547         global ui_comm
 548
 549         if {$commit_active || ![lock_index update]} return
 550
 551         # -- Our in memory state should match the repository.
 552         #
 553         repository_state curHEAD cur_type
 554         if {$commit_type == {amend}
 555                 && $cur_type == {normal}
 556                 && $curHEAD == $HEAD} {
 557         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 558                 error_popup {Last scanned state does not match repository state.
 559
 560 Its highly likely that another Git program modified the
 561 repository since our last scan.  A rescan is required
 562 before committing.
 563 }
 564                 unlock_index
 565                 update_status
 566                 return
 567         }
 568
 569         # -- At least one file should differ in the index.
 570         #
 571         set files_ready 0
 572         foreach path [array names file_states] {
 573                 set s $file_states($path)
 574                 switch -glob -- [lindex $s 0] {
 575                 _? {continue}
 576                 A? -
 577                 D? -
 578                 M? {set files_ready 1; break}
 579                 U? {
 580                         error_popup "Unmerged files cannot be committed.
 581
 582 File [escape_path $path] has merge conflicts.
 583 You must resolve them and include the file before committing.
 584 "
 585                         unlock_index
 586                         return
 587                 }
 588                 default {
 589                         error_popup "Unknown file state [lindex $s 0] detected.
 590
 591 File [escape_path $path] cannot be committed by this program.
 592 "
 593                 }
 594                 }
 595         }
 596         if {!$files_ready} {
 597                 error_popup {No included files to commit.
 598
 599 You must include at least 1 file before you can commit.
 600 }
 601                 unlock_index
 602                 return
 603         }
 604
 605         # -- A message is required.
 606         #
 607         set msg [string trim [$ui_comm get 1.0 end]]
 608         if {$msg == {}} {
 609                 error_popup {Please supply a commit message.
 610
 611 A good commit message has the following format:
 612
 613 - First line: Describe in one sentance what you did.
 614 - Second line: Blank
 615 - Remaining lines: Describe why this change is good.
 616 }
 617                 unlock_index
 618                 return
 619         }
 620
 621         # -- Ask the pre-commit hook for the go-ahead.
 622         #
 623         set pchook [file join $gitdir hooks pre-commit]
 624         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 625                 set pchook [list sh -c \
 626                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 627         } elseif {[file executable $pchook]} {
 628                 set pchook [list $pchook]
 629         } else {
 630                 set pchook {}
 631         }
 632         if {$pchook != {} && [catch {eval exec $pchook} err]} {
 633                 hook_failed_popup pre-commit $err
 634                 unlock_index
 635                 return
 636         }
 637
 638         # -- Write the tree in the background.
 639         #
 640         set commit_active 1
 641         set ui_status_value {Committing changes...}
 642
 643         set fd_wt [open "| git write-tree" r]
 644         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 645 }
 646
 647 proc commit_stage2 {fd_wt curHEAD msg} {
 648         global single_commit gitdir HEAD PARENT commit_type
 649         global commit_active ui_status_value ui_comm
 650         global file_states
 651
 652         gets $fd_wt tree_id
 653         if {$tree_id == {} || [catch {close $fd_wt} err]} {
 654                 error_popup "write-tree failed:\n\n$err"
 655                 set commit_active 0
 656                 set ui_status_value {Commit failed.}
 657                 unlock_index
 658                 return
 659         }
 660
 661         # -- Create the commit.
 662         #
 663         set cmd [list git commit-tree $tree_id]
 664         if {$PARENT != {}} {
 665                 lappend cmd -p $PARENT
 666         }
 667         if {$commit_type == {merge}} {
 668                 if {[catch {
 669                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 670                                 while {[gets $fd_mh merge_head] >= 0} {
 671                                         lappend cmd -p $merge_head
 672                                 }
 673                                 close $fd_mh
 674                         } err]} {
 675                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 676                         set commit_active 0
 677                         set ui_status_value {Commit failed.}
 678                         unlock_index
 679                         return
 680                 }
 681         }
 682         if {$PARENT == {}} {
 683                 # git commit-tree writes to stderr during initial commit.
 684                 lappend cmd 2>/dev/null
 685         }
 686         lappend cmd << $msg
 687         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 688                 error_popup "commit-tree failed:\n\n$err"
 689                 set commit_active 0
 690                 set ui_status_value {Commit failed.}
 691                 unlock_index
 692                 return
 693         }
 694
 695         # -- Update the HEAD ref.
 696         #
 697         set reflogm commit
 698         if {$commit_type != {normal}} {
 699                 append reflogm " ($commit_type)"
 700         }
 701         set i [string first "\n" $msg]
 702         if {$i >= 0} {
 703                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
 704         } else {
 705                 append reflogm {: } $msg
 706         }
 707         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 708         if {[catch {eval exec $cmd} err]} {
 709                 error_popup "update-ref failed:\n\n$err"
 710                 set commit_active 0
 711                 set ui_status_value {Commit failed.}
 712                 unlock_index
 713                 return
 714         }
 715
 716         # -- Cleanup after ourselves.
 717         #
 718         catch {file delete [file join $gitdir MERGE_HEAD]}
 719         catch {file delete [file join $gitdir MERGE_MSG]}
 720         catch {file delete [file join $gitdir SQUASH_MSG]}
 721         catch {file delete [file join $gitdir GITGUI_MSG]}
 722
 723         # -- Let rerere do its thing.
 724         #
 725         if {[file isdirectory [file join $gitdir rr-cache]]} {
 726                 catch {exec git rerere}
 727         }
 728
 729         $ui_comm delete 0.0 end
 730         $ui_comm edit modified false
 731         $ui_comm edit reset
 732
 733         if {$single_commit} do_quit
 734
 735         # -- Update status without invoking any git commands.
 736         #
 737         set commit_active 0
 738         set commit_type normal
 739         set HEAD $cmt_id
 740         set PARENT $cmt_id
 741
 742         foreach path [array names file_states] {
 743                 set s $file_states($path)
 744                 set m [lindex $s 0]
 745                 switch -glob -- $m {
 746                 A? -
 747                 M? -
 748                 D? {set m _[string index $m 1]}
 749                 }
 750
 751                 if {$m == {__}} {
 752                         unset file_states($path)
 753                 } else {
 754                         lset file_states($path) 0 $m
 755                 }
 756         }
 757
 758         display_all_files
 759         unlock_index
 760         reshow_diff
 761         set ui_status_value \
 762                 "Changes committed as [string range $cmt_id 0 7]."
 763 }
 764
 765 ######################################################################
 766 ##
 767 ## fetch pull push
 768
 769 proc fetch_from {remote} {
 770         set w [new_console "fetch $remote" \
 771                 "Fetching new changes from $remote"]
 772         set cmd [list git fetch]
 773         lappend cmd $remote
 774         console_exec $w $cmd
 775 }
 776
 777 proc pull_remote {remote branch} {
 778         global HEAD commit_type
 779         global file_states
 780
 781         if {![lock_index update]} return
 782
 783         # -- Our in memory state should match the repository.
 784         #
 785         repository_state curHEAD cur_type
 786         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 787                 error_popup {Last scanned state does not match repository state.
 788
 789 Its highly likely that another Git program modified the
 790 repository since our last scan.  A rescan is required
 791 before a pull can be started.
 792 }
 793                 unlock_index
 794                 update_status
 795                 return
 796         }
 797
 798         # -- No differences should exist before a pull.
 799         #
 800         if {[array size file_states] != 0} {
 801                 error_popup {Uncommitted but modified files are present.
 802
 803 You should not perform a pull with unmodified files in your working
 804 directory as Git would be unable to recover from an incorrect merge.
 805
 806 Commit or throw away all changes before starting a pull operation.
 807 }
 808                 unlock_index
 809                 return
 810         }
 811
 812         set w [new_console "pull $remote $branch" \
 813                 "Pulling new changes from branch $branch in $remote"]
 814         set cmd [list git pull]
 815         lappend cmd $remote
 816         lappend cmd $branch
 817         console_exec $w $cmd [list post_pull_remote $remote $branch]
 818 }
 819
 820 proc post_pull_remote {remote branch success} {
 821         global HEAD PARENT commit_type
 822         global ui_status_value
 823
 824         unlock_index
 825         if {$success} {
 826                 repository_state HEAD commit_type
 827                 set PARENT $HEAD
 828                 set $ui_status_value {Ready.}
 829         } else {
 830                 update_status \
 831                         "Conflicts detected while pulling $branch from $remote."
 832         }
 833 }
 834
 835 proc push_to {remote} {
 836         set w [new_console "push $remote" \
 837                 "Pushing changes to $remote"]
 838         set cmd [list git push]
 839         lappend cmd $remote
 840         console_exec $w $cmd
 841 }
 842
 843 ######################################################################
 844 ##
 845 ## ui helpers
 846
 847 proc mapcol {state path} {
 848         global all_cols ui_other
 849
 850         if {[catch {set r $all_cols($state)}]} {
 851                 puts "error: no column for state={$state} $path"
 852                 return $ui_other
 853         }
 854         return $r
 855 }
 856
 857 proc mapicon {state path} {
 858         global all_icons
 859
 860         if {[catch {set r $all_icons($state)}]} {
 861                 puts "error: no icon for state={$state} $path"
 862                 return file_plain
 863         }
 864         return $r
 865 }
 866
 867 proc mapdesc {state path} {
 868         global all_descs
 869
 870         if {[catch {set r $all_descs($state)}]} {
 871                 puts "error: no desc for state={$state} $path"
 872                 return $state
 873         }
 874         return $r
 875 }
 876
 877 proc escape_path {path} {
 878         regsub -all "\n" $path "\\n" path
 879         return $path
 880 }
 881
 882 set next_icon_id 0
 883
 884 proc merge_state {path new_state} {
 885         global file_states next_icon_id
 886
 887         set s0 [string index $new_state 0]
 888         set s1 [string index $new_state 1]
 889
 890         if {[catch {set info $file_states($path)}]} {
 891                 set state __
 892                 set icon n[incr next_icon_id]
 893         } else {
 894                 set state [lindex $info 0]
 895                 set icon [lindex $info 1]
 896         }
 897
 898         if {$s0 == {_}} {
 899                 set s0 [string index $state 0]
 900         } elseif {$s0 == {*}} {
 901                 set s0 _
 902         }
 903
 904         if {$s1 == {_}} {
 905                 set s1 [string index $state 1]
 906         } elseif {$s1 == {*}} {
 907                 set s1 _
 908         }
 909
 910         set file_states($path) [list $s0$s1 $icon]
 911         return $state
 912 }
 913
 914 proc display_file {path state} {
 915         global ui_index ui_other
 916         global file_states file_lists status_active
 917
 918         set old_m [merge_state $path $state]
 919         if {$status_active} return
 920
 921         set s $file_states($path)
 922         set new_m [lindex $s 0]
 923         set new_w [mapcol $new_m $path]
 924         set old_w [mapcol $old_m $path]
 925         set new_icon [mapicon $new_m $path]
 926
 927         if {$new_w != $old_w} {
 928                 set lno [lsearch -sorted $file_lists($old_w) $path]
 929                 if {$lno >= 0} {
 930                         incr lno
 931                         $old_w conf -state normal
 932                         $old_w delete $lno.0 [expr $lno + 1].0
 933                         $old_w conf -state disabled
 934                 }
 935
 936                 lappend file_lists($new_w) $path
 937                 set file_lists($new_w) [lsort $file_lists($new_w)]
 938                 set lno [lsearch -sorted $file_lists($new_w) $path]
 939                 incr lno
 940                 $new_w conf -state normal
 941                 $new_w image create $lno.0 \
 942                         -align center -padx 5 -pady 1 \
 943                         -name [lindex $s 1] \
 944                         -image $new_icon
 945                 $new_w insert $lno.1 "[escape_path $path]\n"
 946                 $new_w conf -state disabled
 947         } elseif {$new_icon != [mapicon $old_m $path]} {
 948                 $new_w conf -state normal
 949                 $new_w image conf [lindex $s 1] -image $new_icon
 950                 $new_w conf -state disabled
 951         }
 952 }
 953
 954 proc display_all_files {} {
 955         global ui_index ui_other file_states file_lists
 956
 957         $ui_index conf -state normal
 958         $ui_other conf -state normal
 959
 960         $ui_index delete 0.0 end
 961         $ui_other delete 0.0 end
 962
 963         set file_lists($ui_index) [list]
 964         set file_lists($ui_other) [list]
 965
 966         foreach path [lsort [array names file_states]] {
 967                 set s $file_states($path)
 968                 set m [lindex $s 0]
 969                 set w [mapcol $m $path]
 970                 lappend file_lists($w) $path
 971                 $w image create end \
 972                         -align center -padx 5 -pady 1 \
 973                         -name [lindex $s 1] \
 974                         -image [mapicon $m $path]
 975                 $w insert end "[escape_path $path]\n"
 976         }
 977
 978         $ui_index conf -state disabled
 979         $ui_other conf -state disabled
 980 }
 981
 982 proc with_update_index {body} {
 983         global update_index_fd
 984
 985         if {$update_index_fd == {}} {
 986                 if {![lock_index update]} return
 987                 set update_index_fd [open \
 988                         "| git update-index --add --remove -z --stdin" \
 989                         w]
 990                 fconfigure $update_index_fd -translation binary
 991                 uplevel 1 $body
 992                 close $update_index_fd
 993                 set update_index_fd {}
 994                 unlock_index
 995         } else {
 996                 uplevel 1 $body
 997         }
 998 }
 999
1000 proc update_index {path} {
1001         global update_index_fd
1002
1003         if {$update_index_fd == {}} {
1004                 error {not in with_update_index}
1005         } else {
1006                 puts -nonewline $update_index_fd "$path\0"
1007         }
1008 }
1009
1010 proc toggle_mode {path} {
1011         global file_states ui_fname_value
1012
1013         set s $file_states($path)
1014         set m [lindex $s 0]
1015
1016         switch -- $m {
1017         AM -
1018         _O {set new A*}
1019         _M -
1020         MM {set new M*}
1021         AD -
1022         _D {set new D*}
1023         default {return}
1024         }
1025
1026         with_update_index {update_index $path}
1027         display_file $path $new
1028         if {$ui_fname_value == $path} {
1029                 show_diff $path
1030         }
1031 }
1032
1033 ######################################################################
1034 ##
1035 ## remote management
1036
1037 proc load_all_remotes {} {
1038         global gitdir all_remotes repo_config
1039
1040         set all_remotes [list]
1041         set rm_dir [file join $gitdir remotes]
1042         if {[file isdirectory $rm_dir]} {
1043                 set all_remotes [concat $all_remotes [glob \
1044                         -types f \
1045                         -tails \
1046                         -nocomplain \
1047                         -directory $rm_dir *]]
1048         }
1049
1050         foreach line [array names repo_config remote.*.url] {
1051                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1052                         lappend all_remotes $name
1053                 }
1054         }
1055
1056         set all_remotes [lsort -unique $all_remotes]
1057 }
1058
1059 proc populate_remote_menu {m pfx op} {
1060         global all_remotes font_ui
1061
1062         foreach remote $all_remotes {
1063                 $m add command -label "$pfx $remote..." \
1064                         -command [list $op $remote] \
1065                         -font $font_ui
1066         }
1067 }
1068
1069 proc populate_pull_menu {m} {
1070         global gitdir repo_config all_remotes font_ui disable_on_lock
1071
1072         foreach remote $all_remotes {
1073                 set rb {}
1074                 if {[array get repo_config remote.$remote.url] != {}} {
1075                         if {[array get repo_config remote.$remote.fetch] != {}} {
1076                                 regexp {^([^:]+):} \
1077                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1078                                         line rb
1079                         }
1080                 } else {
1081                         catch {
1082                                 set fd [open [file join $gitdir remotes $remote] r]
1083                                 while {[gets $fd line] >= 0} {
1084                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1085                                                 break
1086                                         }
1087                                 }
1088                                 close $fd
1089                         }
1090                 }
1091
1092                 set rb_short $rb
1093                 regsub ^refs/heads/ $rb {} rb_short
1094                 if {$rb_short != {}} {
1095                         $m add command \
1096                                 -label "Branch $rb_short from $remote..." \
1097                                 -command [list pull_remote $remote $rb] \
1098                                 -font $font_ui
1099                         lappend disable_on_lock \
1100                                 [list $m entryconf [$m index last] -state]
1101                 }
1102         }
1103 }
1104
1105 ######################################################################
1106 ##
1107 ## icons
1108
1109 set filemask {
1110 #define mask_width 14
1111 #define mask_height 15
1112 static unsigned char mask_bits[] = {
1113    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1114    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1115    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1116 }
1117
1118 image create bitmap file_plain -background white -foreground black -data {
1119 #define plain_width 14
1120 #define plain_height 15
1121 static unsigned char plain_bits[] = {
1122    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1123    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1124    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1125 } -maskdata $filemask
1126
1127 image create bitmap file_mod -background white -foreground blue -data {
1128 #define mod_width 14
1129 #define mod_height 15
1130 static unsigned char mod_bits[] = {
1131    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1132    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1133    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1134 } -maskdata $filemask
1135
1136 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1137 #define file_fulltick_width 14
1138 #define file_fulltick_height 15
1139 static unsigned char file_fulltick_bits[] = {
1140    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1141    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1142    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1143 } -maskdata $filemask
1144
1145 image create bitmap file_parttick -background white -foreground "#005050" -data {
1146 #define parttick_width 14
1147 #define parttick_height 15
1148 static unsigned char parttick_bits[] = {
1149    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1150    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1151    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1152 } -maskdata $filemask
1153
1154 image create bitmap file_question -background white -foreground black -data {
1155 #define file_question_width 14
1156 #define file_question_height 15
1157 static unsigned char file_question_bits[] = {
1158    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1159    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1160    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1161 } -maskdata $filemask
1162
1163 image create bitmap file_removed -background white -foreground red -data {
1164 #define file_removed_width 14
1165 #define file_removed_height 15
1166 static unsigned char file_removed_bits[] = {
1167    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1168    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1169    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1170 } -maskdata $filemask
1171
1172 image create bitmap file_merge -background white -foreground blue -data {
1173 #define file_merge_width 14
1174 #define file_merge_height 15
1175 static unsigned char file_merge_bits[] = {
1176    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1177    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1178    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1179 } -maskdata $filemask
1180
1181 set ui_index .vpane.files.index.list
1182 set ui_other .vpane.files.other.list
1183 set max_status_desc 0
1184 foreach i {
1185                 {__ i plain    "Unmodified"}
1186                 {_M i mod      "Modified"}
1187                 {M_ i fulltick "Checked in"}
1188                 {MM i parttick "Partially included"}
1189
1190                 {_O o plain    "Untracked"}
1191                 {A_ o fulltick "Added"}
1192                 {AM o parttick "Partially added"}
1193                 {AD o question "Added (but now gone)"}
1194
1195                 {_D i question "Missing"}
1196                 {D_ i removed  "Removed"}
1197                 {DD i removed  "Removed"}
1198                 {DO i removed  "Removed (still exists)"}
1199
1200                 {UM i merge    "Merge conflicts"}
1201                 {U_ i merge    "Merge conflicts"}
1202         } {
1203         if {$max_status_desc < [string length [lindex $i 3]]} {
1204                 set max_status_desc [string length [lindex $i 3]]
1205         }
1206         if {[lindex $i 1] == {i}} {
1207                 set all_cols([lindex $i 0]) $ui_index
1208         } else {
1209                 set all_cols([lindex $i 0]) $ui_other
1210         }
1211         set all_icons([lindex $i 0]) file_[lindex $i 2]
1212         set all_descs([lindex $i 0]) [lindex $i 3]
1213 }
1214 unset filemask i
1215
1216 ######################################################################
1217 ##
1218 ## util
1219
1220 proc hook_failed_popup {hook msg} {
1221         global gitdir font_ui font_diff appname
1222
1223         set w .hookfail
1224         toplevel $w
1225         wm transient $w .
1226
1227         frame $w.m
1228         label $w.m.l1 -text "$hook hook failed:" \
1229                 -anchor w \
1230                 -justify left \
1231                 -font [concat $font_ui bold]
1232         text $w.m.t \
1233                 -background white -borderwidth 1 \
1234                 -relief sunken \
1235                 -width 80 -height 10 \
1236                 -font $font_diff \
1237                 -yscrollcommand [list $w.m.sby set]
1238         label $w.m.l2 \
1239                 -text {You must correct the above errors before committing.} \
1240                 -anchor w \
1241                 -justify left \
1242                 -font [concat $font_ui bold]
1243         scrollbar $w.m.sby -command [list $w.m.t yview]
1244         pack $w.m.l1 -side top -fill x
1245         pack $w.m.l2 -side bottom -fill x
1246         pack $w.m.sby -side right -fill y
1247         pack $w.m.t -side left -fill both -expand 1
1248         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1249
1250         $w.m.t insert 1.0 $msg
1251         $w.m.t conf -state disabled
1252
1253         button $w.ok -text OK \
1254                 -width 15 \
1255                 -font $font_ui \
1256                 -command "destroy $w"
1257         pack $w.ok -side bottom
1258
1259         bind $w <Visibility> "grab $w; focus $w"
1260         bind $w <Key-Return> "destroy $w"
1261         wm title $w "$appname ([lindex [file split \
1262                 [file normalize [file dirname $gitdir]]] \
1263                 end]): error"
1264         tkwait window $w
1265 }
1266
1267 set next_console_id 0
1268
1269 proc new_console {short_title long_title} {
1270         global next_console_id console_data
1271         set w .console[incr next_console_id]
1272         set console_data($w) [list $short_title $long_title]
1273         return [console_init $w]
1274 }
1275
1276 proc console_init {w} {
1277         global console_cr console_data
1278         global gitdir appname font_ui font_diff M1B
1279
1280         set console_cr($w) 1.0
1281         toplevel $w
1282         frame $w.m
1283         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1284                 -anchor w \
1285                 -justify left \
1286                 -font [concat $font_ui bold]
1287         text $w.m.t \
1288                 -background white -borderwidth 1 \
1289                 -relief sunken \
1290                 -width 80 -height 10 \
1291                 -font $font_diff \
1292                 -state disabled \
1293                 -yscrollcommand [list $w.m.sby set]
1294         label $w.m.s -anchor w \
1295                 -justify left \
1296                 -font [concat $font_ui bold]
1297         scrollbar $w.m.sby -command [list $w.m.t yview]
1298         pack $w.m.l1 -side top -fill x
1299         pack $w.m.s -side bottom -fill x
1300         pack $w.m.sby -side right -fill y
1301         pack $w.m.t -side left -fill both -expand 1
1302         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1303
1304         menu $w.ctxm -tearoff 0
1305         $w.ctxm add command -label "Copy" \
1306                 -font $font_ui \
1307                 -command "tk_textCopy $w.m.t"
1308         $w.ctxm add command -label "Select All" \
1309                 -font $font_ui \
1310                 -command "$w.m.t tag add sel 0.0 end"
1311         $w.ctxm add command -label "Copy All" \
1312                 -font $font_ui \
1313                 -command "
1314                         $w.m.t tag add sel 0.0 end
1315                         tk_textCopy $w.m.t
1316                         $w.m.t tag remove sel 0.0 end
1317                 "
1318
1319         button $w.ok -text {Running...} \
1320                 -width 15 \
1321                 -font $font_ui \
1322                 -state disabled \
1323                 -command "destroy $w"
1324         pack $w.ok -side bottom
1325
1326         bind $w.m.t <Any-Button-3> "tk_popup $w.ctxm %X %Y"
1327         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1328         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1329         bind $w <Visibility> "focus $w"
1330         wm title $w "$appname ([lindex [file split \
1331                 [file normalize [file dirname $gitdir]]] \
1332                 end]): [lindex $console_data($w) 0]"
1333         return $w
1334 }
1335
1336 proc console_exec {w cmd {after {}}} {
1337         global tcl_platform
1338
1339         # -- Windows tosses the enviroment when we exec our child.
1340         #    But most users need that so we have to relogin. :-(
1341         #
1342         if {$tcl_platform(platform) == {windows}} {
1343                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1344         }
1345
1346         # -- Tcl won't let us redirect both stdout and stderr to
1347         #    the same pipe.  So pass it through cat...
1348         #
1349         set cmd [concat | $cmd |& cat]
1350
1351         set fd_f [open $cmd r]
1352         fconfigure $fd_f -blocking 0 -translation binary
1353         fileevent $fd_f readable [list console_read $w $fd_f $after]
1354 }
1355
1356 proc console_read {w fd after} {
1357         global console_cr console_data
1358
1359         set buf [read $fd]
1360         if {$buf != {}} {
1361                 if {![winfo exists $w]} {console_init $w}
1362                 $w.m.t conf -state normal
1363                 set c 0
1364                 set n [string length $buf]
1365                 while {$c < $n} {
1366                         set cr [string first "\r" $buf $c]
1367                         set lf [string first "\n" $buf $c]
1368                         if {$cr < 0} {set cr [expr $n + 1]}
1369                         if {$lf < 0} {set lf [expr $n + 1]}
1370
1371                         if {$lf < $cr} {
1372                                 $w.m.t insert end [string range $buf $c $lf]
1373                                 set console_cr($w) [$w.m.t index {end -1c}]
1374                                 set c $lf
1375                                 incr c
1376                         } else {
1377                                 $w.m.t delete $console_cr($w) end
1378                                 $w.m.t insert end "\n"
1379                                 $w.m.t insert end [string range $buf $c $cr]
1380                                 set c $cr
1381                                 incr c
1382                         }
1383                 }
1384                 $w.m.t conf -state disabled
1385                 $w.m.t see end
1386         }
1387
1388         fconfigure $fd -blocking 1
1389         if {[eof $fd]} {
1390                 if {[catch {close $fd}]} {
1391                         if {![winfo exists $w]} {console_init $w}
1392                         $w.m.s conf -background red -text {Error: Command Failed}
1393                         $w.ok conf -text Close
1394                         $w.ok conf -state normal
1395                         set ok 0
1396                 } elseif {[winfo exists $w]} {
1397                         $w.m.s conf -background green -text {Success}
1398                         $w.ok conf -text Close
1399                         $w.ok conf -state normal
1400                         set ok 1
1401                 }
1402                 array unset console_cr $w
1403                 array unset console_data $w
1404                 if {$after != {}} {
1405                         uplevel #0 $after $ok
1406                 }
1407                 return
1408         }
1409         fconfigure $fd -blocking 0
1410 }
1411
1412 ######################################################################
1413 ##
1414 ## ui commands
1415
1416 set starting_gitk_msg {Please wait... Starting gitk...}
1417
1418 proc do_gitk {} {
1419         global tcl_platform ui_status_value starting_gitk_msg
1420
1421         set ui_status_value $starting_gitk_msg
1422         after 10000 {
1423                 if {$ui_status_value == $starting_gitk_msg} {
1424                         set ui_status_value {Ready.}
1425                 }
1426         }
1427
1428         if {$tcl_platform(platform) == {windows}} {
1429                 exec sh -c gitk &
1430         } else {
1431                 exec gitk &
1432         }
1433 }
1434
1435 proc do_repack {} {
1436         set w [new_console "repack" "Repacking the object database"]
1437         set cmd [list git repack]
1438         lappend cmd -a
1439         lappend cmd -d
1440         console_exec $w $cmd
1441 }
1442
1443 set quitting 0
1444
1445 proc do_quit {} {
1446         global gitdir ui_comm quitting
1447
1448         if {$quitting} return
1449         set quitting 1
1450
1451         set save [file join $gitdir GITGUI_MSG]
1452         set msg [string trim [$ui_comm get 0.0 end]]
1453         if {[$ui_comm edit modified] && $msg != {}} {
1454                 catch {
1455                         set fd [open $save w]
1456                         puts $fd [string trim [$ui_comm get 0.0 end]]
1457                         close $fd
1458                 }
1459         } elseif {$msg == {} && [file exists $save]} {
1460                 file delete $save
1461         }
1462
1463         save_my_config
1464         destroy .
1465 }
1466
1467 proc do_rescan {} {
1468         update_status
1469 }
1470
1471 proc do_include_all {} {
1472         global update_active ui_status_value
1473
1474         if {$update_active || ![lock_index begin-update]} return
1475
1476         set update_active 1
1477         set ui_status_value {Including all modified files...}
1478         after 1 {
1479                 with_update_index {
1480                         foreach path [array names file_states] {
1481                                 set s $file_states($path)
1482                                 set m [lindex $s 0]
1483                                 switch -- $m {
1484                                 AM -
1485                                 MM -
1486                                 _M -
1487                                 _D {toggle_mode $path}
1488                                 }
1489                         }
1490                 }
1491                 set update_active 0
1492                 set ui_status_value {Ready.}
1493         }
1494 }
1495
1496 set GIT_COMMITTER_IDENT {}
1497
1498 proc do_signoff {} {
1499         global ui_comm GIT_COMMITTER_IDENT
1500
1501         if {$GIT_COMMITTER_IDENT == {}} {
1502                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1503                         error_popup "Unable to obtain your identity:\n\n$err"
1504                         return
1505                 }
1506                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1507                         $me me GIT_COMMITTER_IDENT]} {
1508                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1509                         return
1510                 }
1511         }
1512
1513         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1514         set last [$ui_comm get {end -1c linestart} {end -1c}]
1515         if {$last != $sob} {
1516                 $ui_comm edit separator
1517                 if {$last != {}
1518                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1519                         $ui_comm insert end "\n"
1520                 }
1521                 $ui_comm insert end "\n$sob"
1522                 $ui_comm edit separator
1523                 $ui_comm see end
1524         }
1525 }
1526
1527 proc do_amend_last {} {
1528         load_last_commit
1529 }
1530
1531 proc do_commit {} {
1532         commit_tree
1533 }
1534
1535 # shift == 1: left click
1536 #          3: right click
1537 proc click {w x y shift wx wy} {
1538         global ui_index ui_other file_lists
1539
1540         set pos [split [$w index @$x,$y] .]
1541         set lno [lindex $pos 0]
1542         set col [lindex $pos 1]
1543         set path [lindex $file_lists($w) [expr $lno - 1]]
1544         if {$path == {}} return
1545
1546         if {$col > 0 && $shift == 1} {
1547                 show_diff $path $w $lno
1548         }
1549 }
1550
1551 proc unclick {w x y} {
1552         global file_lists
1553
1554         set pos [split [$w index @$x,$y] .]
1555         set lno [lindex $pos 0]
1556         set col [lindex $pos 1]
1557         set path [lindex $file_lists($w) [expr $lno - 1]]
1558         if {$path == {}} return
1559
1560         if {$col == 0} {
1561                 toggle_mode $path
1562         }
1563 }
1564
1565 ######################################################################
1566 ##
1567 ## ui init
1568
1569 set font_ui {}
1570 set font_diff {}
1571 set cursor_ptr {}
1572 menu .mbar -tearoff 0
1573 catch {set font_ui   [lindex $repo_config(gui.fontui) 0]}
1574 catch {set font_diff [lindex $repo_config(gui.fontdiff) 0]}
1575 if {$font_ui == {}}    {catch {set font_ui [.mbar cget -font]}}
1576 if {$font_ui == {}}    {set font_ui {Helvetica 10}}
1577 if {$font_diff == {}}  {set font_diff {Courier 10}}
1578 if {$cursor_ptr == {}} {set cursor_ptr left_ptr}
1579
1580 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1581 windows,*   {set M1B Control; set M1T Ctrl}
1582 unix,Darwin {set M1B M1; set M1T Cmd}
1583 *           {set M1B M1; set M1T M1}
1584 }
1585
1586 # -- Menu Bar
1587 .mbar add cascade -label Project -menu .mbar.project
1588 .mbar add cascade -label Edit -menu .mbar.edit
1589 .mbar add cascade -label Commit -menu .mbar.commit
1590 .mbar add cascade -label Fetch -menu .mbar.fetch
1591 .mbar add cascade -label Pull -menu .mbar.pull
1592 .mbar add cascade -label Push -menu .mbar.push
1593 .mbar add cascade -label Options -menu .mbar.options
1594 . configure -menu .mbar
1595
1596 # -- Project Menu
1597 menu .mbar.project
1598 .mbar.project add command -label Visualize \
1599         -command do_gitk \
1600         -font $font_ui
1601 .mbar.project add command -label {Repack Database} \
1602         -command do_repack \
1603         -font $font_ui
1604 .mbar.project add command -label Quit \
1605         -command do_quit \
1606         -accelerator $M1T-Q \
1607         -font $font_ui
1608
1609 # -- Edit Menu
1610 #
1611 menu .mbar.edit
1612 .mbar.edit add command -label Undo \
1613         -command {catch {[focus] edit undo}} \
1614         -accelerator $M1T-Z \
1615         -font $font_ui
1616 .mbar.edit add command -label Redo \
1617         -command {catch {[focus] edit redo}} \
1618         -accelerator $M1T-Y \
1619         -font $font_ui
1620 .mbar.edit add separator
1621 .mbar.edit add command -label Cut \
1622         -command {catch {tk_textCut [focus]}} \
1623         -accelerator $M1T-X \
1624         -font $font_ui
1625 .mbar.edit add command -label Copy \
1626         -command {catch {tk_textCopy [focus]}} \
1627         -accelerator $M1T-C \
1628         -font $font_ui
1629 .mbar.edit add command -label Paste \
1630         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1631         -accelerator $M1T-V \
1632         -font $font_ui
1633 .mbar.edit add command -label Delete \
1634         -command {catch {[focus] delete sel.first sel.last}} \
1635         -accelerator Del \
1636         -font $font_ui
1637 .mbar.edit add separator
1638 .mbar.edit add command -label {Select All} \
1639         -command {catch {[focus] tag add sel 0.0 end}} \
1640         -accelerator $M1T-A \
1641         -font $font_ui
1642
1643 # -- Commit Menu
1644 menu .mbar.commit
1645 .mbar.commit add command -label Rescan \
1646         -command do_rescan \
1647         -accelerator F5 \
1648         -font $font_ui
1649 lappend disable_on_lock \
1650         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1651 .mbar.commit add command -label {Amend Last Commit} \
1652         -command do_amend_last \
1653         -font $font_ui
1654 lappend disable_on_lock \
1655         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1656 .mbar.commit add command -label {Include All Files} \
1657         -command do_include_all \
1658         -accelerator $M1T-I \
1659         -font $font_ui
1660 lappend disable_on_lock \
1661         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1662 .mbar.commit add command -label {Sign Off} \
1663         -command do_signoff \
1664         -accelerator $M1T-S \
1665         -font $font_ui
1666 .mbar.commit add command -label Commit \
1667         -command do_commit \
1668         -accelerator $M1T-Return \
1669         -font $font_ui
1670 lappend disable_on_lock \
1671         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1672
1673 # -- Fetch Menu
1674 menu .mbar.fetch
1675
1676 # -- Pull Menu
1677 menu .mbar.pull
1678
1679 # -- Push Menu
1680 menu .mbar.push
1681
1682 # -- Options Menu
1683 menu .mbar.options
1684 .mbar.options add checkbutton \
1685         -label {Trust File Modification Timestamps} \
1686         -font $font_ui \
1687         -offvalue false \
1688         -onvalue true \
1689         -variable cfg_trust_mtime
1690
1691 # -- Main Window Layout
1692 panedwindow .vpane -orient vertical
1693 panedwindow .vpane.files -orient horizontal
1694 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1695 pack .vpane -anchor n -side top -fill both -expand 1
1696
1697 # -- Index File List
1698 frame .vpane.files.index -height 100 -width 400
1699 label .vpane.files.index.title -text {Modified Files} \
1700         -background green \
1701         -font $font_ui
1702 text $ui_index -background white -borderwidth 0 \
1703         -width 40 -height 10 \
1704         -font $font_ui \
1705         -cursor $cursor_ptr \
1706         -yscrollcommand {.vpane.files.index.sb set} \
1707         -state disabled
1708 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1709 pack .vpane.files.index.title -side top -fill x
1710 pack .vpane.files.index.sb -side right -fill y
1711 pack $ui_index -side left -fill both -expand 1
1712 .vpane.files add .vpane.files.index -sticky nsew
1713
1714 # -- Other (Add) File List
1715 frame .vpane.files.other -height 100 -width 100
1716 label .vpane.files.other.title -text {Untracked Files} \
1717         -background red \
1718         -font $font_ui
1719 text $ui_other -background white -borderwidth 0 \
1720         -width 40 -height 10 \
1721         -font $font_ui \
1722         -cursor $cursor_ptr \
1723         -yscrollcommand {.vpane.files.other.sb set} \
1724         -state disabled
1725 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1726 pack .vpane.files.other.title -side top -fill x
1727 pack .vpane.files.other.sb -side right -fill y
1728 pack $ui_other -side left -fill both -expand 1
1729 .vpane.files add .vpane.files.other -sticky nsew
1730
1731 $ui_index tag conf in_diff -font [concat $font_ui bold]
1732 $ui_other tag conf in_diff -font [concat $font_ui bold]
1733
1734 # -- Diff and Commit Area
1735 frame .vpane.lower -height 400 -width 400
1736 frame .vpane.lower.commarea
1737 frame .vpane.lower.diff -relief sunken -borderwidth 1
1738 pack .vpane.lower.commarea -side top -fill x
1739 pack .vpane.lower.diff -side bottom -fill both -expand 1
1740 .vpane add .vpane.lower -stick nsew
1741
1742 # -- Commit Area Buttons
1743 frame .vpane.lower.commarea.buttons
1744 label .vpane.lower.commarea.buttons.l -text {} \
1745         -anchor w \
1746         -justify left \
1747         -font $font_ui
1748 pack .vpane.lower.commarea.buttons.l -side top -fill x
1749 pack .vpane.lower.commarea.buttons -side left -fill y
1750
1751 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1752         -command do_rescan \
1753         -font $font_ui
1754 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1755 lappend disable_on_lock \
1756         {.vpane.lower.commarea.buttons.rescan conf -state}
1757
1758 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1759         -command do_amend_last \
1760         -font $font_ui
1761 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1762 lappend disable_on_lock \
1763         {.vpane.lower.commarea.buttons.amend conf -state}
1764
1765 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1766         -command do_include_all \
1767         -font $font_ui
1768 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1769 lappend disable_on_lock \
1770         {.vpane.lower.commarea.buttons.incall conf -state}
1771
1772 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1773         -command do_signoff \
1774         -font $font_ui
1775 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1776
1777 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1778         -command do_commit \
1779         -font $font_ui
1780 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1781 lappend disable_on_lock \
1782         {.vpane.lower.commarea.buttons.commit conf -state}
1783
1784 # -- Commit Message Buffer
1785 frame .vpane.lower.commarea.buffer
1786 set ui_comm .vpane.lower.commarea.buffer.t
1787 set ui_coml .vpane.lower.commarea.buffer.l
1788 label $ui_coml -text {Commit Message:} \
1789         -anchor w \
1790         -justify left \
1791         -font $font_ui
1792 trace add variable commit_type write {uplevel #0 {
1793         switch -glob $commit_type \
1794         initial {$ui_coml conf -text {Initial Commit Message:}} \
1795         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1796         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1797         *       {$ui_coml conf -text {Commit Message:}}
1798 }}
1799 text $ui_comm -background white -borderwidth 1 \
1800         -undo true \
1801         -maxundo 20 \
1802         -autoseparators true \
1803         -relief sunken \
1804         -width 75 -height 9 -wrap none \
1805         -font $font_diff \
1806         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
1807 scrollbar .vpane.lower.commarea.buffer.sby \
1808         -command [list $ui_comm yview]
1809 pack $ui_coml -side top -fill x
1810 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1811 pack $ui_comm -side left -fill y
1812 pack .vpane.lower.commarea.buffer -side left -fill y
1813
1814 # -- Commit Message Buffer Context Menu
1815 #
1816 menu $ui_comm.ctxm -tearoff 0
1817 $ui_comm.ctxm add command -label "Cut" \
1818         -font $font_ui \
1819         -command "tk_textCut $ui_comm"
1820 $ui_comm.ctxm add command -label "Copy" \
1821         -font $font_ui \
1822         -command "tk_textCopy $ui_comm"
1823 $ui_comm.ctxm add command -label "Paste" \
1824         -font $font_ui \
1825         -command "tk_textPaste $ui_comm"
1826 $ui_comm.ctxm add command -label "Delete" \
1827         -font $font_ui \
1828         -command "$ui_comm delete sel.first sel.last"
1829 $ui_comm.ctxm add separator
1830 $ui_comm.ctxm add command -label "Select All" \
1831         -font $font_ui \
1832         -command "$ui_comm tag add sel 0.0 end"
1833 $ui_comm.ctxm add command -label "Copy All" \
1834         -font $font_ui \
1835         -command "
1836                 $ui_comm tag add sel 0.0 end
1837                 tk_textCopy $ui_comm
1838                 $ui_comm tag remove sel 0.0 end
1839         "
1840 $ui_comm.ctxm add separator
1841 $ui_comm.ctxm add command -label "Sign Off" \
1842         -font $font_ui \
1843         -command do_signoff
1844 bind $ui_comm <Any-Button-3> "tk_popup $ui_comm.ctxm %X %Y"
1845
1846 # -- Diff Header
1847 set ui_fname_value {}
1848 set ui_fstatus_value {}
1849 frame .vpane.lower.diff.header -background orange
1850 label .vpane.lower.diff.header.l1 -text {File:} \
1851         -background orange \
1852         -font $font_ui
1853 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1854         -background orange \
1855         -anchor w \
1856         -justify left \
1857         -font $font_ui
1858 label .vpane.lower.diff.header.l3 -text {Status:} \
1859         -background orange \
1860         -font $font_ui
1861 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1862         -background orange \
1863         -width $max_status_desc \
1864         -anchor w \
1865         -justify left \
1866         -font $font_ui
1867 pack .vpane.lower.diff.header.l1 -side left
1868 pack .vpane.lower.diff.header.l2 -side left -fill x
1869 pack .vpane.lower.diff.header.l4 -side right
1870 pack .vpane.lower.diff.header.l3 -side right
1871
1872 # -- Diff Body
1873 frame .vpane.lower.diff.body
1874 set ui_diff .vpane.lower.diff.body.t
1875 text $ui_diff -background white -borderwidth 0 \
1876         -width 80 -height 15 -wrap none \
1877         -font $font_diff \
1878         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1879         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1880         -state disabled
1881 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1882         -command [list $ui_diff xview]
1883 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1884         -command [list $ui_diff yview]
1885 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1886 pack .vpane.lower.diff.body.sby -side right -fill y
1887 pack $ui_diff -side left -fill both -expand 1
1888 pack .vpane.lower.diff.header -side top -fill x
1889 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1890
1891 $ui_diff tag conf dm -foreground red
1892 $ui_diff tag conf dp -foreground blue
1893 $ui_diff tag conf da -font [concat $font_diff bold]
1894 $ui_diff tag conf di -foreground "#00a000"
1895 $ui_diff tag conf dni -foreground "#a000a0"
1896 $ui_diff tag conf bold -font [concat $font_diff bold]
1897
1898 # -- Diff Body Context Menu
1899 #
1900 menu $ui_diff.ctxm -tearoff 0
1901 $ui_diff.ctxm add command -label "Copy" \
1902         -font $font_ui \
1903         -command "tk_textCopy $ui_diff"
1904 $ui_diff.ctxm add command -label "Select All" \
1905         -font $font_ui \
1906         -command "$ui_diff tag add sel 0.0 end"
1907 $ui_diff.ctxm add command -label "Copy All" \
1908         -font $font_ui \
1909         -command "
1910                 $ui_diff tag add sel 0.0 end
1911                 tk_textCopy $ui_diff
1912                 $ui_diff tag remove sel 0.0 end
1913         "
1914 bind $ui_diff <Any-Button-3> "tk_popup $ui_diff.ctxm %X %Y"
1915
1916 # -- Status Bar
1917 set ui_status_value {Initializing...}
1918 label .status -textvariable ui_status_value \
1919         -anchor w \
1920         -justify left \
1921         -borderwidth 1 \
1922         -relief sunken \
1923         -font $font_ui
1924 pack .status -anchor w -side bottom -fill x
1925
1926 # -- Load geometry
1927 catch {
1928 set gm [lindex $repo_config(gui.geometry) 0]
1929 wm geometry . [lindex $gm 0]
1930 .vpane sash place 0 \
1931         [lindex [.vpane sash coord 0] 0] \
1932         [lindex $gm 1]
1933 .vpane.files sash place 0 \
1934         [lindex $gm 2] \
1935         [lindex [.vpane.files sash coord 0] 1]
1936 unset gm
1937 }
1938
1939 # -- Key Bindings
1940 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1941 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1942 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
1943 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1944 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1945 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1946 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1947 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1948 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1949 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1950 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1951
1952 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1953 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1954 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1955 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1956 bind $ui_diff <$M1B-Key-v> {break}
1957 bind $ui_diff <$M1B-Key-V> {break}
1958 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1959 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1960 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
1961 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
1962 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
1963 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
1964
1965 bind .   <Destroy> do_quit
1966 bind all <Key-F5> do_rescan
1967 bind all <$M1B-Key-r> do_rescan
1968 bind all <$M1B-Key-R> do_rescan
1969 bind .   <$M1B-Key-s> do_signoff
1970 bind .   <$M1B-Key-S> do_signoff
1971 bind .   <$M1B-Key-i> do_include_all
1972 bind .   <$M1B-Key-I> do_include_all
1973 bind .   <$M1B-Key-Return> do_commit
1974 bind all <$M1B-Key-q> do_quit
1975 bind all <$M1B-Key-Q> do_quit
1976 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1977 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1978 foreach i [list $ui_index $ui_other] {
1979         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1980         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1981         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1982 }
1983 unset i
1984
1985 set file_lists($ui_index) [list]
1986 set file_lists($ui_other) [list]
1987
1988 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1989 focus -force $ui_comm
1990 load_all_remotes
1991 populate_remote_menu .mbar.fetch From fetch_from
1992 populate_remote_menu .mbar.push To push_to
1993 populate_pull_menu .mbar.pull
1994 update_status