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