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