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