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