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