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