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         button $w.ok -text {Running...} \
1305                 -width 15 \
1306                 -font $font_ui \
1307                 -state disabled \
1308                 -command "destroy $w"
1309         pack $w.ok -side bottom
1310
1311         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1312         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1313         bind $w <Visibility> "focus $w"
1314         wm title $w "$appname ([lindex [file split \
1315                 [file normalize [file dirname $gitdir]]] \
1316                 end]): [lindex $console_data($w) 0]"
1317         return $w
1318 }
1319
1320 proc console_exec {w cmd {after {}}} {
1321         global tcl_platform
1322
1323         # -- Windows tosses the enviroment when we exec our child.
1324         #    But most users need that so we have to relogin. :-(
1325         #
1326         if {$tcl_platform(platform) == {windows}} {
1327                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1328         }
1329
1330         # -- Tcl won't let us redirect both stdout and stderr to
1331         #    the same pipe.  So pass it through cat...
1332         #
1333         set cmd [concat | $cmd |& cat]
1334
1335         set fd_f [open $cmd r]
1336         fconfigure $fd_f -blocking 0 -translation binary
1337         fileevent $fd_f readable [list console_read $w $fd_f $after]
1338 }
1339
1340 proc console_read {w fd after} {
1341         global console_cr console_data
1342
1343         set buf [read $fd]
1344         if {$buf != {}} {
1345                 if {![winfo exists $w]} {console_init $w}
1346                 $w.m.t conf -state normal
1347                 set c 0
1348                 set n [string length $buf]
1349                 while {$c < $n} {
1350                         set cr [string first "\r" $buf $c]
1351                         set lf [string first "\n" $buf $c]
1352                         if {$cr < 0} {set cr [expr $n + 1]}
1353                         if {$lf < 0} {set lf [expr $n + 1]}
1354
1355                         if {$lf < $cr} {
1356                                 $w.m.t insert end [string range $buf $c $lf]
1357                                 set console_cr($w) [$w.m.t index {end -1c}]
1358                                 set c $lf
1359                                 incr c
1360                         } else {
1361                                 $w.m.t delete $console_cr($w) end
1362                                 $w.m.t insert end "\n"
1363                                 $w.m.t insert end [string range $buf $c $cr]
1364                                 set c $cr
1365                                 incr c
1366                         }
1367                 }
1368                 $w.m.t conf -state disabled
1369                 $w.m.t see end
1370         }
1371
1372         fconfigure $fd -blocking 1
1373         if {[eof $fd]} {
1374                 if {[catch {close $fd}]} {
1375                         if {![winfo exists $w]} {console_init $w}
1376                         $w.m.s conf -background red -text {Error: Command Failed}
1377                         $w.ok conf -text Close
1378                         $w.ok conf -state normal
1379                         set ok 0
1380                 } elseif {[winfo exists $w]} {
1381                         $w.m.s conf -background green -text {Success}
1382                         $w.ok conf -text Close
1383                         $w.ok conf -state normal
1384                         set ok 1
1385                 }
1386                 array unset console_cr $w
1387                 array unset console_data $w
1388                 if {$after != {}} {
1389                         uplevel #0 $after $ok
1390                 }
1391                 return
1392         }
1393         fconfigure $fd -blocking 0
1394 }
1395
1396 ######################################################################
1397 ##
1398 ## ui commands
1399
1400 set starting_gitk_msg {Please wait... Starting gitk...}
1401
1402 proc do_gitk {} {
1403         global tcl_platform ui_status_value starting_gitk_msg
1404
1405         set ui_status_value $starting_gitk_msg
1406         after 10000 {
1407                 if {$ui_status_value == $starting_gitk_msg} {
1408                         set ui_status_value {Ready.}
1409                 }
1410         }
1411
1412         if {$tcl_platform(platform) == {windows}} {
1413                 exec sh -c gitk &
1414         } else {
1415                 exec gitk &
1416         }
1417 }
1418
1419 proc do_repack {} {
1420         set w [new_console "repack" "Repacking the object database"]
1421         set cmd [list git repack]
1422         lappend cmd -a
1423         lappend cmd -d
1424         console_exec $w $cmd
1425 }
1426
1427 set quitting 0
1428
1429 proc do_quit {} {
1430         global gitdir ui_comm quitting
1431
1432         if {$quitting} return
1433         set quitting 1
1434
1435         set save [file join $gitdir GITGUI_MSG]
1436         set msg [string trim [$ui_comm get 0.0 end]]
1437         if {[$ui_comm edit modified] && $msg != {}} {
1438                 catch {
1439                         set fd [open $save w]
1440                         puts $fd [string trim [$ui_comm get 0.0 end]]
1441                         close $fd
1442                 }
1443         } elseif {$msg == {} && [file exists $save]} {
1444                 file delete $save
1445         }
1446
1447         save_my_config
1448         destroy .
1449 }
1450
1451 proc do_rescan {} {
1452         update_status
1453 }
1454
1455 proc do_include_all {} {
1456         global update_active ui_status_value
1457
1458         if {$update_active || ![lock_index begin-update]} return
1459
1460         set update_active 1
1461         set ui_status_value {Including all modified files...}
1462         after 1 {
1463                 with_update_index {
1464                         foreach path [array names file_states] {
1465                                 set s $file_states($path)
1466                                 set m [lindex $s 0]
1467                                 switch -- $m {
1468                                 AM -
1469                                 MM -
1470                                 _M -
1471                                 _D {toggle_mode $path}
1472                                 }
1473                         }
1474                 }
1475                 set update_active 0
1476                 set ui_status_value {Ready.}
1477         }
1478 }
1479
1480 set GIT_COMMITTER_IDENT {}
1481
1482 proc do_signoff {} {
1483         global ui_comm GIT_COMMITTER_IDENT
1484
1485         if {$GIT_COMMITTER_IDENT == {}} {
1486                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1487                         error_popup "Unable to obtain your identity:\n\n$err"
1488                         return
1489                 }
1490                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1491                         $me me GIT_COMMITTER_IDENT]} {
1492                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1493                         return
1494                 }
1495         }
1496
1497         set str "Signed-off-by: $GIT_COMMITTER_IDENT"
1498         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1499                 $ui_comm edit separator
1500                 $ui_comm insert end "\n$str"
1501                 $ui_comm edit separator
1502                 $ui_comm see end
1503         }
1504 }
1505
1506 proc do_amend_last {} {
1507         load_last_commit
1508 }
1509
1510 proc do_commit {} {
1511         commit_tree
1512 }
1513
1514 # shift == 1: left click
1515 #          3: right click
1516 proc click {w x y shift wx wy} {
1517         global ui_index ui_other file_lists
1518
1519         set pos [split [$w index @$x,$y] .]
1520         set lno [lindex $pos 0]
1521         set col [lindex $pos 1]
1522         set path [lindex $file_lists($w) [expr $lno - 1]]
1523         if {$path == {}} return
1524
1525         if {$col > 0 && $shift == 1} {
1526                 show_diff $path $w $lno
1527         }
1528 }
1529
1530 proc unclick {w x y} {
1531         global file_lists
1532
1533         set pos [split [$w index @$x,$y] .]
1534         set lno [lindex $pos 0]
1535         set col [lindex $pos 1]
1536         set path [lindex $file_lists($w) [expr $lno - 1]]
1537         if {$path == {}} return
1538
1539         if {$col == 0} {
1540                 toggle_mode $path
1541         }
1542 }
1543
1544 ######################################################################
1545 ##
1546 ## ui init
1547
1548 set font_ui {Helvetica 10}
1549 set font_diff {Courier 10}
1550 set maincursor [. cget -cursor]
1551
1552 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1553 windows,*   {set M1B Control; set M1T Ctrl}
1554 unix,Darwin {set M1B M1; set M1T Cmd}
1555 *           {set M1B M1; set M1T M1}
1556 }
1557
1558 # -- Menu Bar
1559 menu .mbar -tearoff 0
1560 .mbar add cascade -label Project -menu .mbar.project
1561 .mbar add cascade -label Edit -menu .mbar.edit
1562 .mbar add cascade -label Commit -menu .mbar.commit
1563 .mbar add cascade -label Fetch -menu .mbar.fetch
1564 .mbar add cascade -label Pull -menu .mbar.pull
1565 .mbar add cascade -label Push -menu .mbar.push
1566 .mbar add cascade -label Options -menu .mbar.options
1567 . configure -menu .mbar
1568
1569 # -- Project Menu
1570 menu .mbar.project
1571 .mbar.project add command -label Visualize \
1572         -command do_gitk \
1573         -font $font_ui
1574 .mbar.project add command -label {Repack Database} \
1575         -command do_repack \
1576         -font $font_ui
1577 .mbar.project add command -label Quit \
1578         -command do_quit \
1579         -accelerator $M1T-Q \
1580         -font $font_ui
1581
1582 # -- Edit Menu
1583 #
1584 menu .mbar.edit
1585 .mbar.edit add command -label Undo \
1586         -command {catch {[focus] edit undo}} \
1587         -accelerator $M1T-Z \
1588         -font $font_ui
1589 .mbar.edit add command -label Redo \
1590         -command {catch {[focus] edit redo}} \
1591         -accelerator $M1T-Y \
1592         -font $font_ui
1593 .mbar.edit add separator
1594 .mbar.edit add command -label Cut \
1595         -command {catch {tk_textCut [focus]}} \
1596         -accelerator $M1T-X \
1597         -font $font_ui
1598 .mbar.edit add command -label Copy \
1599         -command {catch {tk_textCopy [focus]}} \
1600         -accelerator $M1T-C \
1601         -font $font_ui
1602 .mbar.edit add command -label Paste \
1603         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1604         -accelerator $M1T-V \
1605         -font $font_ui
1606 .mbar.edit add command -label Delete \
1607         -command {catch {[focus] delete sel.first sel.last}} \
1608         -accelerator Del \
1609         -font $font_ui
1610 .mbar.edit add separator
1611 .mbar.edit add command -label {Select All} \
1612         -command {catch {[focus] tag add sel 0.0 end}} \
1613         -accelerator $M1T-A \
1614         -font $font_ui
1615
1616 # -- Commit Menu
1617 menu .mbar.commit
1618 .mbar.commit add command -label Rescan \
1619         -command do_rescan \
1620         -accelerator F5 \
1621         -font $font_ui
1622 lappend disable_on_lock \
1623         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1624 .mbar.commit add command -label {Amend Last Commit} \
1625         -command do_amend_last \
1626         -font $font_ui
1627 lappend disable_on_lock \
1628         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1629 .mbar.commit add command -label {Include All Files} \
1630         -command do_include_all \
1631         -accelerator $M1T-I \
1632         -font $font_ui
1633 lappend disable_on_lock \
1634         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1635 .mbar.commit add command -label {Sign Off} \
1636         -command do_signoff \
1637         -accelerator $M1T-S \
1638         -font $font_ui
1639 .mbar.commit add command -label Commit \
1640         -command do_commit \
1641         -accelerator $M1T-Return \
1642         -font $font_ui
1643 lappend disable_on_lock \
1644         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1645
1646 # -- Fetch Menu
1647 menu .mbar.fetch
1648
1649 # -- Pull Menu
1650 menu .mbar.pull
1651
1652 # -- Push Menu
1653 menu .mbar.push
1654
1655 # -- Options Menu
1656 menu .mbar.options
1657 .mbar.options add checkbutton \
1658         -label {Trust File Modification Timestamps} \
1659         -offvalue false \
1660         -onvalue true \
1661         -variable cfg_trust_mtime
1662
1663 # -- Main Window Layout
1664 panedwindow .vpane -orient vertical
1665 panedwindow .vpane.files -orient horizontal
1666 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1667 pack .vpane -anchor n -side top -fill both -expand 1
1668
1669 # -- Index File List
1670 frame .vpane.files.index -height 100 -width 400
1671 label .vpane.files.index.title -text {Modified Files} \
1672         -background green \
1673         -font $font_ui
1674 text $ui_index -background white -borderwidth 0 \
1675         -width 40 -height 10 \
1676         -font $font_ui \
1677         -yscrollcommand {.vpane.files.index.sb set} \
1678         -cursor $maincursor \
1679         -state disabled
1680 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1681 pack .vpane.files.index.title -side top -fill x
1682 pack .vpane.files.index.sb -side right -fill y
1683 pack $ui_index -side left -fill both -expand 1
1684 .vpane.files add .vpane.files.index -sticky nsew
1685
1686 # -- Other (Add) File List
1687 frame .vpane.files.other -height 100 -width 100
1688 label .vpane.files.other.title -text {Untracked Files} \
1689         -background red \
1690         -font $font_ui
1691 text $ui_other -background white -borderwidth 0 \
1692         -width 40 -height 10 \
1693         -font $font_ui \
1694         -yscrollcommand {.vpane.files.other.sb set} \
1695         -cursor $maincursor \
1696         -state disabled
1697 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1698 pack .vpane.files.other.title -side top -fill x
1699 pack .vpane.files.other.sb -side right -fill y
1700 pack $ui_other -side left -fill both -expand 1
1701 .vpane.files add .vpane.files.other -sticky nsew
1702
1703 $ui_index tag conf in_diff -font [concat $font_ui bold]
1704 $ui_other tag conf in_diff -font [concat $font_ui bold]
1705
1706 # -- Diff and Commit Area
1707 frame .vpane.lower -height 400 -width 400
1708 frame .vpane.lower.commarea
1709 frame .vpane.lower.diff -relief sunken -borderwidth 1
1710 pack .vpane.lower.commarea -side top -fill x
1711 pack .vpane.lower.diff -side bottom -fill both -expand 1
1712 .vpane add .vpane.lower -stick nsew
1713
1714 # -- Commit Area Buttons
1715 frame .vpane.lower.commarea.buttons
1716 label .vpane.lower.commarea.buttons.l -text {} \
1717         -anchor w \
1718         -justify left \
1719         -font $font_ui
1720 pack .vpane.lower.commarea.buttons.l -side top -fill x
1721 pack .vpane.lower.commarea.buttons -side left -fill y
1722
1723 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1724         -command do_rescan \
1725         -font $font_ui
1726 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1727 lappend disable_on_lock \
1728         {.vpane.lower.commarea.buttons.rescan conf -state}
1729
1730 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1731         -command do_amend_last \
1732         -font $font_ui
1733 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1734 lappend disable_on_lock \
1735         {.vpane.lower.commarea.buttons.amend conf -state}
1736
1737 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1738         -command do_include_all \
1739         -font $font_ui
1740 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1741 lappend disable_on_lock \
1742         {.vpane.lower.commarea.buttons.incall conf -state}
1743
1744 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1745         -command do_signoff \
1746         -font $font_ui
1747 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1748
1749 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1750         -command do_commit \
1751         -font $font_ui
1752 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1753 lappend disable_on_lock \
1754         {.vpane.lower.commarea.buttons.commit conf -state}
1755
1756 # -- Commit Message Buffer
1757 frame .vpane.lower.commarea.buffer
1758 set ui_comm .vpane.lower.commarea.buffer.t
1759 set ui_coml .vpane.lower.commarea.buffer.l
1760 label $ui_coml -text {Commit Message:} \
1761         -anchor w \
1762         -justify left \
1763         -font $font_ui
1764 trace add variable commit_type write {uplevel #0 {
1765         switch -glob $commit_type \
1766         initial {$ui_coml conf -text {Initial Commit Message:}} \
1767         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1768         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1769         *       {$ui_coml conf -text {Commit Message:}}
1770 }}
1771 text $ui_comm -background white -borderwidth 1 \
1772         -undo true \
1773         -maxundo 20 \
1774         -autoseparators true \
1775         -relief sunken \
1776         -width 75 -height 9 -wrap none \
1777         -font $font_diff \
1778         -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1779         -cursor $maincursor
1780 scrollbar .vpane.lower.commarea.buffer.sby \
1781         -command [list $ui_comm yview]
1782 pack $ui_coml -side top -fill x
1783 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1784 pack $ui_comm -side left -fill y
1785 pack .vpane.lower.commarea.buffer -side left -fill y
1786
1787 # -- Diff Header
1788 set ui_fname_value {}
1789 set ui_fstatus_value {}
1790 frame .vpane.lower.diff.header -background orange
1791 label .vpane.lower.diff.header.l1 -text {File:} \
1792         -background orange \
1793         -font $font_ui
1794 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1795         -background orange \
1796         -anchor w \
1797         -justify left \
1798         -font $font_ui
1799 label .vpane.lower.diff.header.l3 -text {Status:} \
1800         -background orange \
1801         -font $font_ui
1802 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1803         -background orange \
1804         -width $max_status_desc \
1805         -anchor w \
1806         -justify left \
1807         -font $font_ui
1808 pack .vpane.lower.diff.header.l1 -side left
1809 pack .vpane.lower.diff.header.l2 -side left -fill x
1810 pack .vpane.lower.diff.header.l4 -side right
1811 pack .vpane.lower.diff.header.l3 -side right
1812
1813 # -- Diff Body
1814 frame .vpane.lower.diff.body
1815 set ui_diff .vpane.lower.diff.body.t
1816 text $ui_diff -background white -borderwidth 0 \
1817         -width 80 -height 15 -wrap none \
1818         -font $font_diff \
1819         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1820         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1821         -cursor $maincursor \
1822         -state disabled
1823 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1824         -command [list $ui_diff xview]
1825 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1826         -command [list $ui_diff yview]
1827 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1828 pack .vpane.lower.diff.body.sby -side right -fill y
1829 pack $ui_diff -side left -fill both -expand 1
1830 pack .vpane.lower.diff.header -side top -fill x
1831 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1832
1833 $ui_diff tag conf dm -foreground red
1834 $ui_diff tag conf dp -foreground blue
1835 $ui_diff tag conf da -font [concat $font_diff bold]
1836 $ui_diff tag conf di -foreground "#00a000"
1837 $ui_diff tag conf dni -foreground "#a000a0"
1838 $ui_diff tag conf bold -font [concat $font_diff bold]
1839
1840 # -- Status Bar
1841 set ui_status_value {Initializing...}
1842 label .status -textvariable ui_status_value \
1843         -anchor w \
1844         -justify left \
1845         -borderwidth 1 \
1846         -relief sunken \
1847         -font $font_ui
1848 pack .status -anchor w -side bottom -fill x
1849
1850 # -- Load geometry
1851 catch {
1852 set gm [lindex $repo_config(gui.geometry) 0]
1853 wm geometry . [lindex $gm 0]
1854 .vpane sash place 0 \
1855         [lindex [.vpane sash coord 0] 0] \
1856         [lindex $gm 1]
1857 .vpane.files sash place 0 \
1858         [lindex $gm 2] \
1859         [lindex [.vpane.files sash coord 0] 1]
1860 unset gm
1861 }
1862
1863 # -- Key Bindings
1864 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1865 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1866 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
1867 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1868 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1869 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1870 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1871 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1872 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1873 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1874 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1875
1876 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1877 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1878 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1879 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1880 bind $ui_diff <$M1B-Key-v> {break}
1881 bind $ui_diff <$M1B-Key-V> {break}
1882 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1883 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1884 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
1885 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
1886 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
1887 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
1888
1889 bind .   <Destroy> do_quit
1890 bind all <Key-F5> do_rescan
1891 bind all <$M1B-Key-r> do_rescan
1892 bind all <$M1B-Key-R> do_rescan
1893 bind .   <$M1B-Key-s> do_signoff
1894 bind .   <$M1B-Key-S> do_signoff
1895 bind .   <$M1B-Key-i> do_include_all
1896 bind .   <$M1B-Key-I> do_include_all
1897 bind .   <$M1B-Key-Return> do_commit
1898 bind all <$M1B-Key-q> do_quit
1899 bind all <$M1B-Key-Q> do_quit
1900 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1901 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1902 foreach i [list $ui_index $ui_other] {
1903         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1904         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1905         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1906 }
1907 unset i
1908
1909 set file_lists($ui_index) [list]
1910 set file_lists($ui_other) [list]
1911
1912 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1913 focus -force $ui_comm
1914 load_all_remotes
1915 populate_remote_menu .mbar.fetch From fetch_from
1916 populate_remote_menu .mbar.push To push_to
1917 populate_pull_menu .mbar.pull
1918 update_status