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