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