Andrew's git / gitweb.git / git-gui
?
git-guion commit git-gui: Refactored diff line display formatting logic. (38dbe27)
   1# Tcl ignores the next line -*- tcl -*- \
   2exec wish "$0" -- "$@"
   3
   4# Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   5# This program is free software; it may be used, copied, modified
   6# and distributed under the terms of the GNU General Public Licence,
   7# either version 2, or (at your option) any later version.
   8
   9set appname [lindex [file split $argv0] end]
  10set gitdir {}
  11
  12######################################################################
  13##
  14## config
  15
  16proc is_many_config {name} {
  17        switch -glob -- $name {
  18        remote.*.fetch -
  19        remote.*.push
  20                {return 1}
  21        *
  22                {return 0}
  23        }
  24}
  25
  26proc load_config {include_global} {
  27        global repo_config global_config default_config
  28
  29        array unset global_config
  30        if {$include_global} {
  31                catch {
  32                        set fd_rc [open "| git repo-config --global --list" r]
  33                        while {[gets $fd_rc line] >= 0} {
  34                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  35                                        if {[is_many_config $name]} {
  36                                                lappend global_config($name) $value
  37                                        } else {
  38                                                set global_config($name) $value
  39                                        }
  40                                }
  41                        }
  42                        close $fd_rc
  43                }
  44        }
  45
  46        array unset repo_config
  47        catch {
  48                set fd_rc [open "| git repo-config --list" r]
  49                while {[gets $fd_rc line] >= 0} {
  50                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  51                                if {[is_many_config $name]} {
  52                                        lappend repo_config($name) $value
  53                                } else {
  54                                        set repo_config($name) $value
  55                                }
  56                        }
  57                }
  58                close $fd_rc
  59        }
  60
  61        foreach name [array names default_config] {
  62                if {[catch {set v $global_config($name)}]} {
  63                        set global_config($name) $default_config($name)
  64                }
  65                if {[catch {set v $repo_config($name)}]} {
  66                        set repo_config($name) $default_config($name)
  67                }
  68        }
  69}
  70
  71proc save_config {} {
  72        global default_config font_descs
  73        global repo_config global_config
  74        global repo_config_new global_config_new
  75
  76        foreach option $font_descs {
  77                set name [lindex $option 0]
  78                set font [lindex $option 1]
  79                font configure $font \
  80                        -family $global_config_new(gui.$font^^family) \
  81                        -size $global_config_new(gui.$font^^size)
  82                font configure ${font}bold \
  83                        -family $global_config_new(gui.$font^^family) \
  84                        -size $global_config_new(gui.$font^^size)
  85                set global_config_new(gui.$name) [font configure $font]
  86                unset global_config_new(gui.$font^^family)
  87                unset global_config_new(gui.$font^^size)
  88        }
  89
  90        foreach name [array names default_config] {
  91                set value $global_config_new($name)
  92                if {$value ne $global_config($name)} {
  93                        if {$value eq $default_config($name)} {
  94                                catch {exec git repo-config --global --unset $name}
  95                        } else {
  96                                regsub -all "\[{}\]" $value {"} value
  97                                exec git repo-config --global $name $value
  98                        }
  99                        set global_config($name) $value
 100                        if {$value eq $repo_config($name)} {
 101                                catch {exec git repo-config --unset $name}
 102                                set repo_config($name) $value
 103                        }
 104                }
 105        }
 106
 107        foreach name [array names default_config] {
 108                set value $repo_config_new($name)
 109                if {$value ne $repo_config($name)} {
 110                        if {$value eq $global_config($name)} {
 111                                catch {exec git repo-config --unset $name}
 112                        } else {
 113                                regsub -all "\[{}\]" $value {"} value
 114                                exec git repo-config $name $value
 115                        }
 116                        set repo_config($name) $value
 117                }
 118        }
 119}
 120
 121proc error_popup {msg} {
 122        global gitdir appname
 123
 124        set title $appname
 125        if {$gitdir ne {}} {
 126                append title { (}
 127                append title [lindex \
 128                        [file split [file normalize [file dirname $gitdir]]] \
 129                        end]
 130                append title {)}
 131        }
 132        set cmd [list tk_messageBox \
 133                -icon error \
 134                -type ok \
 135                -title "$title: error" \
 136                -message $msg]
 137        if {[winfo ismapped .]} {
 138                lappend cmd -parent .
 139        }
 140        eval $cmd
 141}
 142
 143proc info_popup {msg} {
 144        global gitdir appname
 145
 146        set title $appname
 147        if {$gitdir ne {}} {
 148                append title { (}
 149                append title [lindex \
 150                        [file split [file normalize [file dirname $gitdir]]] \
 151                        end]
 152                append title {)}
 153        }
 154        tk_messageBox \
 155                -parent . \
 156                -icon error \
 157                -type ok \
 158                -title $title \
 159                -message $msg
 160}
 161
 162######################################################################
 163##
 164## repository setup
 165
 166if {   [catch {set gitdir $env(GIT_DIR)}]
 167        && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 168        catch {wm withdraw .}
 169        error_popup "Cannot find the git directory:\n\n$err"
 170        exit 1
 171}
 172if {![file isdirectory $gitdir]} {
 173        catch {wm withdraw .}
 174        error_popup "Git directory not found:\n\n$gitdir"
 175        exit 1
 176}
 177if {[lindex [file split $gitdir] end] ne {.git}} {
 178        catch {wm withdraw .}
 179        error_popup "Cannot use funny .git directory:\n\n$gitdir"
 180        exit 1
 181}
 182if {[catch {cd [file dirname $gitdir]} err]} {
 183        catch {wm withdraw .}
 184        error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 185        exit 1
 186}
 187
 188set single_commit 0
 189if {$appname eq {git-citool}} {
 190        set single_commit 1
 191}
 192
 193######################################################################
 194##
 195## task management
 196
 197set rescan_active 0
 198set diff_active 0
 199set last_clicked {}
 200
 201set disable_on_lock [list]
 202set index_lock_type none
 203
 204proc lock_index {type} {
 205        global index_lock_type disable_on_lock
 206
 207        if {$index_lock_type eq {none}} {
 208                set index_lock_type $type
 209                foreach w $disable_on_lock {
 210                        uplevel #0 $w disabled
 211                }
 212                return 1
 213        } elseif {$index_lock_type eq "begin-$type"} {
 214                set index_lock_type $type
 215                return 1
 216        }
 217        return 0
 218}
 219
 220proc unlock_index {} {
 221        global index_lock_type disable_on_lock
 222
 223        set index_lock_type none
 224        foreach w $disable_on_lock {
 225                uplevel #0 $w normal
 226        }
 227}
 228
 229######################################################################
 230##
 231## status
 232
 233proc repository_state {hdvar ctvar} {
 234        global gitdir
 235        upvar $hdvar hd $ctvar ct
 236
 237        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 238                set hd {}
 239                set ct initial
 240        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 241                set ct merge
 242        } else {
 243                set ct normal
 244        }
 245}
 246
 247proc PARENT {} {
 248        global PARENT empty_tree
 249
 250        if {$PARENT ne {}} {
 251                return $PARENT
 252        }
 253        if {$empty_tree eq {}} {
 254                set empty_tree [exec git mktree << {}]
 255        }
 256        return $empty_tree
 257}
 258
 259proc rescan {after} {
 260        global HEAD PARENT commit_type
 261        global ui_index ui_other ui_status_value ui_comm
 262        global rescan_active file_states
 263        global repo_config
 264
 265        if {$rescan_active > 0 || ![lock_index read]} return
 266
 267        repository_state new_HEAD new_type
 268        if {[string match amend* $commit_type]
 269                && $new_type eq {normal}
 270                && $new_HEAD eq $HEAD} {
 271        } else {
 272                set HEAD $new_HEAD
 273                set PARENT $new_HEAD
 274                set commit_type $new_type
 275        }
 276
 277        array unset file_states
 278
 279        if {![$ui_comm edit modified]
 280                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 281                if {[load_message GITGUI_MSG]} {
 282                } elseif {[load_message MERGE_MSG]} {
 283                } elseif {[load_message SQUASH_MSG]} {
 284                }
 285                $ui_comm edit modified false
 286                $ui_comm edit reset
 287        }
 288
 289        if {$repo_config(gui.trustmtime) eq {true}} {
 290                rescan_stage2 {} $after
 291        } else {
 292                set rescan_active 1
 293                set ui_status_value {Refreshing file status...}
 294                set cmd [list git update-index]
 295                lappend cmd -q
 296                lappend cmd --unmerged
 297                lappend cmd --ignore-missing
 298                lappend cmd --refresh
 299                set fd_rf [open "| $cmd" r]
 300                fconfigure $fd_rf -blocking 0 -translation binary
 301                fileevent $fd_rf readable \
 302                        [list rescan_stage2 $fd_rf $after]
 303        }
 304}
 305
 306proc rescan_stage2 {fd after} {
 307        global gitdir ui_status_value
 308        global rescan_active buf_rdi buf_rdf buf_rlo
 309
 310        if {$fd ne {}} {
 311                read $fd
 312                if {![eof $fd]} return
 313                close $fd
 314        }
 315
 316        set ls_others [list | git ls-files --others -z \
 317                --exclude-per-directory=.gitignore]
 318        set info_exclude [file join $gitdir info exclude]
 319        if {[file readable $info_exclude]} {
 320                lappend ls_others "--exclude-from=$info_exclude"
 321        }
 322
 323        set buf_rdi {}
 324        set buf_rdf {}
 325        set buf_rlo {}
 326
 327        set rescan_active 3
 328        set ui_status_value {Scanning for modified files ...}
 329        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 330        set fd_df [open "| git diff-files -z" r]
 331        set fd_lo [open $ls_others r]
 332
 333        fconfigure $fd_di -blocking 0 -translation binary
 334        fconfigure $fd_df -blocking 0 -translation binary
 335        fconfigure $fd_lo -blocking 0 -translation binary
 336        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 337        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 338        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 339}
 340
 341proc load_message {file} {
 342        global gitdir ui_comm
 343
 344        set f [file join $gitdir $file]
 345        if {[file isfile $f]} {
 346                if {[catch {set fd [open $f r]}]} {
 347                        return 0
 348                }
 349                set content [string trim [read $fd]]
 350                close $fd
 351                $ui_comm delete 0.0 end
 352                $ui_comm insert end $content
 353                return 1
 354        }
 355        return 0
 356}
 357
 358proc read_diff_index {fd after} {
 359        global buf_rdi
 360
 361        append buf_rdi [read $fd]
 362        set c 0
 363        set n [string length $buf_rdi]
 364        while {$c < $n} {
 365                set z1 [string first "\0" $buf_rdi $c]
 366                if {$z1 == -1} break
 367                incr z1
 368                set z2 [string first "\0" $buf_rdi $z1]
 369                if {$z2 == -1} break
 370
 371                incr c
 372                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 373                merge_state \
 374                        [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 375                        [lindex $i 4]? \
 376                        [list [lindex $i 0] [lindex $i 2]] \
 377                        [list]
 378                set c $z2
 379                incr c
 380        }
 381        if {$c < $n} {
 382                set buf_rdi [string range $buf_rdi $c end]
 383        } else {
 384                set buf_rdi {}
 385        }
 386
 387        rescan_done $fd buf_rdi $after
 388}
 389
 390proc read_diff_files {fd after} {
 391        global buf_rdf
 392
 393        append buf_rdf [read $fd]
 394        set c 0
 395        set n [string length $buf_rdf]
 396        while {$c < $n} {
 397                set z1 [string first "\0" $buf_rdf $c]
 398                if {$z1 == -1} break
 399                incr z1
 400                set z2 [string first "\0" $buf_rdf $z1]
 401                if {$z2 == -1} break
 402
 403                incr c
 404                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 405                merge_state \
 406                        [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 407                        ?[lindex $i 4] \
 408                        [list] \
 409                        [list [lindex $i 0] [lindex $i 2]]
 410                set c $z2
 411                incr c
 412        }
 413        if {$c < $n} {
 414                set buf_rdf [string range $buf_rdf $c end]
 415        } else {
 416                set buf_rdf {}
 417        }
 418
 419        rescan_done $fd buf_rdf $after
 420}
 421
 422proc read_ls_others {fd after} {
 423        global buf_rlo
 424
 425        append buf_rlo [read $fd]
 426        set pck [split $buf_rlo "\0"]
 427        set buf_rlo [lindex $pck end]
 428        foreach p [lrange $pck 0 end-1] {
 429                merge_state $p ?O
 430        }
 431        rescan_done $fd buf_rlo $after
 432}
 433
 434proc rescan_done {fd buf after} {
 435        global rescan_active
 436        global file_states repo_config
 437        upvar $buf to_clear
 438
 439        if {![eof $fd]} return
 440        set to_clear {}
 441        close $fd
 442        if {[incr rescan_active -1] > 0} return
 443
 444        prune_selection
 445        unlock_index
 446        display_all_files
 447
 448        if {$repo_config(gui.partialinclude) ne {true}} {
 449                set pathList [list]
 450                foreach path [array names file_states] {
 451                        switch -- [lindex $file_states($path) 0] {
 452                        AM -
 453                        MM {lappend pathList $path}
 454                        }
 455                }
 456                if {$pathList ne {}} {
 457                        update_index \
 458                                "Updating included files" \
 459                                $pathList \
 460                                [concat {reshow_diff;} $after]
 461                        return
 462                }
 463        }
 464
 465        reshow_diff
 466        uplevel #0 $after
 467}
 468
 469proc prune_selection {} {
 470        global file_states selected_paths
 471
 472        foreach path [array names selected_paths] {
 473                if {[catch {set still_here $file_states($path)}]} {
 474                        unset selected_paths($path)
 475                }
 476        }
 477}
 478
 479######################################################################
 480##
 481## diff
 482
 483proc clear_diff {} {
 484        global ui_diff current_diff ui_index ui_other
 485
 486        $ui_diff conf -state normal
 487        $ui_diff delete 0.0 end
 488        $ui_diff conf -state disabled
 489
 490        set current_diff {}
 491
 492        $ui_index tag remove in_diff 0.0 end
 493        $ui_other tag remove in_diff 0.0 end
 494}
 495
 496proc reshow_diff {} {
 497        global current_diff ui_status_value file_states
 498
 499        if {$current_diff eq {}
 500                || [catch {set s $file_states($current_diff)}]} {
 501                clear_diff
 502        } else {
 503                show_diff $current_diff
 504        }
 505}
 506
 507proc handle_empty_diff {} {
 508        global current_diff file_states file_lists
 509
 510        set path $current_diff
 511        set s $file_states($path)
 512        if {[lindex $s 0] ne {_M}} return
 513
 514        info_popup "No differences detected.
 515
 516[short_path $path] has no changes.
 517
 518The modification date of this file was updated
 519by another application and you currently have
 520the Trust File Modification Timestamps option
 521enabled, so Git did not automatically detect
 522that there are no content differences in this
 523file.
 524
 525This file will now be removed from the modified
 526files list, to prevent possible confusion.
 527"
 528        if {[catch {exec git update-index -- $path} err]} {
 529                error_popup "Failed to refresh index:\n\n$err"
 530        }
 531
 532        clear_diff
 533        set old_w [mapcol [lindex $file_states($path) 0] $path]
 534        set lno [lsearch -sorted $file_lists($old_w) $path]
 535        if {$lno >= 0} {
 536                set file_lists($old_w) \
 537                        [lreplace $file_lists($old_w) $lno $lno]
 538                incr lno
 539                $old_w conf -state normal
 540                $old_w delete $lno.0 [expr {$lno + 1}].0
 541                $old_w conf -state disabled
 542        }
 543}
 544
 545proc show_diff {path {w {}} {lno {}}} {
 546        global file_states file_lists
 547        global is_3way_diff diff_active repo_config
 548        global ui_diff current_diff ui_status_value
 549
 550        if {$diff_active || ![lock_index read]} return
 551
 552        clear_diff
 553        if {$w eq {} || $lno == {}} {
 554                foreach w [array names file_lists] {
 555                        set lno [lsearch -sorted $file_lists($w) $path]
 556                        if {$lno >= 0} {
 557                                incr lno
 558                                break
 559                        }
 560                }
 561        }
 562        if {$w ne {} && $lno >= 1} {
 563                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 564        }
 565
 566        set s $file_states($path)
 567        set m [lindex $s 0]
 568        set is_3way_diff 0
 569        set diff_active 1
 570        set current_diff $path
 571        set ui_status_value "Loading diff of [escape_path $path]..."
 572
 573        set cmd [list | git diff-index]
 574        lappend cmd --no-color
 575        if {$repo_config(gui.diffcontext) > 0} {
 576                lappend cmd "-U$repo_config(gui.diffcontext)"
 577        }
 578        lappend cmd -p
 579
 580        switch $m {
 581        MM {
 582                lappend cmd -c
 583        }
 584        _O {
 585                if {[catch {
 586                                set fd [open $path r]
 587                                set content [read $fd]
 588                                close $fd
 589                        } err ]} {
 590                        set diff_active 0
 591                        unlock_index
 592                        set ui_status_value "Unable to display [escape_path $path]"
 593                        error_popup "Error loading file:\n\n$err"
 594                        return
 595                }
 596                $ui_diff conf -state normal
 597                $ui_diff insert end $content
 598                $ui_diff conf -state disabled
 599                set diff_active 0
 600                unlock_index
 601                set ui_status_value {Ready.}
 602                return
 603        }
 604        }
 605
 606        lappend cmd [PARENT]
 607        lappend cmd --
 608        lappend cmd $path
 609
 610        if {[catch {set fd [open $cmd r]} err]} {
 611                set diff_active 0
 612                unlock_index
 613                set ui_status_value "Unable to display [escape_path $path]"
 614                error_popup "Error loading diff:\n\n$err"
 615                return
 616        }
 617
 618        fconfigure $fd -blocking 0 -translation auto
 619        fileevent $fd readable [list read_diff $fd]
 620}
 621
 622proc read_diff {fd} {
 623        global ui_diff ui_status_value is_3way_diff diff_active
 624        global repo_config
 625
 626        $ui_diff conf -state normal
 627        while {[gets $fd line] >= 0} {
 628                # -- Cleanup uninteresting diff header lines.
 629                #
 630                if {[string match {diff --git *}      $line]} continue
 631                if {[string match {diff --combined *} $line]} continue
 632                if {[string match {--- *}             $line]} continue
 633                if {[string match {+++ *}             $line]} continue
 634                if {$line eq {deleted file mode 120000}} {
 635                        set line "deleted symlink"
 636                }
 637
 638                # -- Automatically detect if this is a 3 way diff.
 639                #
 640                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 641
 642                # -- Reformat a 3 way diff, 'cause its too weird.
 643                #
 644                if {$is_3way_diff} {
 645                        set op [string range $line 0 1]
 646                        switch -- $op {
 647                        {@@} {set tags d_@}
 648                        {++} {set tags d_+ ; set op { +}}
 649                        {--} {set tags d_- ; set op { -}}
 650                        { +} {set tags d_++; set op {++}}
 651                        { -} {set tags d_--; set op {--}}
 652                        {+ } {set tags d_-+; set op {-+}}
 653                        {- } {set tags d_+-; set op {+-}}
 654                        default {set tags {}}
 655                        }
 656                        set line [string replace $line 0 1 $op]
 657                } else {
 658                        switch -- [string index $line 0] {
 659                        @ {set tags d_@}
 660                        + {set tags d_+}
 661                        - {set tags d_-}
 662                        default {set tags {}}
 663                        }
 664                }
 665                $ui_diff insert end $line $tags
 666                $ui_diff insert end "\n" $tags
 667        }
 668        $ui_diff conf -state disabled
 669
 670        if {[eof $fd]} {
 671                close $fd
 672                set diff_active 0
 673                unlock_index
 674                set ui_status_value {Ready.}
 675
 676                if {$repo_config(gui.trustmtime) eq {true}
 677                        && [$ui_diff index end] eq {2.0}} {
 678                        handle_empty_diff
 679                }
 680        }
 681}
 682
 683######################################################################
 684##
 685## commit
 686
 687proc load_last_commit {} {
 688        global HEAD PARENT commit_type ui_comm
 689
 690        if {[string match amend* $commit_type]} return
 691        if {$commit_type ne {normal}} {
 692                error_popup "Can't amend a $commit_type commit."
 693                return
 694        }
 695
 696        set msg {}
 697        set parent {}
 698        set parent_count 0
 699        if {[catch {
 700                        set fd [open "| git cat-file commit $HEAD" r]
 701                        while {[gets $fd line] > 0} {
 702                                if {[string match {parent *} $line]} {
 703                                        set parent [string range $line 7 end]
 704                                        incr parent_count
 705                                }
 706                        }
 707                        set msg [string trim [read $fd]]
 708                        close $fd
 709                } err]} {
 710                error_popup "Error loading commit data for amend:\n\n$err"
 711                return
 712        }
 713
 714        if {$parent_count > 1} {
 715                error_popup {Can't amend a merge commit.}
 716                return
 717        }
 718
 719        if {$parent_count == 0} {
 720                set commit_type amend-initial
 721                set PARENT {}
 722        } elseif {$parent_count == 1} {
 723                set commit_type amend
 724                set PARENT $parent
 725        }
 726
 727        $ui_comm delete 0.0 end
 728        $ui_comm insert end $msg
 729        $ui_comm edit modified false
 730        $ui_comm edit reset
 731        rescan {set ui_status_value {Ready.}}
 732}
 733
 734proc create_new_commit {} {
 735        global commit_type ui_comm
 736
 737        set commit_type normal
 738        $ui_comm delete 0.0 end
 739        $ui_comm edit modified false
 740        $ui_comm edit reset
 741        rescan {set ui_status_value {Ready.}}
 742}
 743
 744set GIT_COMMITTER_IDENT {}
 745
 746proc committer_ident {} {
 747        global GIT_COMMITTER_IDENT
 748
 749        if {$GIT_COMMITTER_IDENT eq {}} {
 750                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 751                        error_popup "Unable to obtain your identity:\n\n$err"
 752                        return {}
 753                }
 754                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 755                        $me me GIT_COMMITTER_IDENT]} {
 756                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 757                        return {}
 758                }
 759        }
 760
 761        return $GIT_COMMITTER_IDENT
 762}
 763
 764proc commit_tree {} {
 765        global HEAD commit_type file_states ui_comm repo_config
 766
 767        if {![lock_index update]} return
 768        if {[committer_ident] eq {}} return
 769
 770        # -- Our in memory state should match the repository.
 771        #
 772        repository_state curHEAD cur_type
 773        if {[string match amend* $commit_type]
 774                && $cur_type eq {normal}
 775                && $curHEAD eq $HEAD} {
 776        } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 777                info_popup {Last scanned state does not match repository state.
 778
 779Another Git program has modified this repository
 780since the last scan.  A rescan must be performed
 781before another commit can be created.
 782
 783The rescan will be automatically started now.
 784}
 785                unlock_index
 786                rescan {set ui_status_value {Ready.}}
 787                return
 788        }
 789
 790        # -- At least one file should differ in the index.
 791        #
 792        set files_ready 0
 793        foreach path [array names file_states] {
 794                switch -glob -- [lindex $file_states($path) 0] {
 795                _? {continue}
 796                A? -
 797                D? -
 798                M? {set files_ready 1; break}
 799                U? {
 800                        error_popup "Unmerged files cannot be committed.
 801
 802File [short_path $path] has merge conflicts.
 803You must resolve them and include the file before committing.
 804"
 805                        unlock_index
 806                        return
 807                }
 808                default {
 809                        error_popup "Unknown file state [lindex $s 0] detected.
 810
 811File [short_path $path] cannot be committed by this program.
 812"
 813                }
 814                }
 815        }
 816        if {!$files_ready} {
 817                error_popup {No included files to commit.
 818
 819You must include at least 1 file before you can commit.
 820}
 821                unlock_index
 822                return
 823        }
 824
 825        # -- A message is required.
 826        #
 827        set msg [string trim [$ui_comm get 1.0 end]]
 828        if {$msg eq {}} {
 829                error_popup {Please supply a commit message.
 830
 831A good commit message has the following format:
 832
 833- First line: Describe in one sentance what you did.
 834- Second line: Blank
 835- Remaining lines: Describe why this change is good.
 836}
 837                unlock_index
 838                return
 839        }
 840
 841        # -- Update included files if partialincludes are off.
 842        #
 843        if {$repo_config(gui.partialinclude) ne {true}} {
 844                set pathList [list]
 845                foreach path [array names file_states] {
 846                        switch -glob -- [lindex $file_states($path) 0] {
 847                        A? -
 848                        M? {lappend pathList $path}
 849                        }
 850                }
 851                if {$pathList ne {}} {
 852                        unlock_index
 853                        update_index \
 854                                "Updating included files" \
 855                                $pathList \
 856                                [concat {lock_index update;} \
 857                                        [list commit_prehook $curHEAD $msg]]
 858                        return
 859                }
 860        }
 861
 862        commit_prehook $curHEAD $msg
 863}
 864
 865proc commit_prehook {curHEAD msg} {
 866        global tcl_platform gitdir ui_status_value pch_error
 867
 868        # On Cygwin [file executable] might lie so we need to ask
 869        # the shell if the hook is executable.  Yes that's annoying.
 870
 871        set pchook [file join $gitdir hooks pre-commit]
 872        if {$tcl_platform(platform) eq {windows}
 873                && [file isfile $pchook]} {
 874                set pchook [list sh -c [concat \
 875                        "if test -x \"$pchook\";" \
 876                        "then exec \"$pchook\" 2>&1;" \
 877                        "fi"]]
 878        } elseif {[file executable $pchook]} {
 879                set pchook [list $pchook |& cat]
 880        } else {
 881                commit_writetree $curHEAD $msg
 882                return
 883        }
 884
 885        set ui_status_value {Calling pre-commit hook...}
 886        set pch_error {}
 887        set fd_ph [open "| $pchook" r]
 888        fconfigure $fd_ph -blocking 0 -translation binary
 889        fileevent $fd_ph readable \
 890                [list commit_prehook_wait $fd_ph $curHEAD $msg]
 891}
 892
 893proc commit_prehook_wait {fd_ph curHEAD msg} {
 894        global pch_error ui_status_value
 895
 896        append pch_error [read $fd_ph]
 897        fconfigure $fd_ph -blocking 1
 898        if {[eof $fd_ph]} {
 899                if {[catch {close $fd_ph}]} {
 900                        set ui_status_value {Commit declined by pre-commit hook.}
 901                        hook_failed_popup pre-commit $pch_error
 902                        unlock_index
 903                } else {
 904                        commit_writetree $curHEAD $msg
 905                }
 906                set pch_error {}
 907                return
 908        }
 909        fconfigure $fd_ph -blocking 0
 910}
 911
 912proc commit_writetree {curHEAD msg} {
 913        global ui_status_value
 914
 915        set ui_status_value {Committing changes...}
 916        set fd_wt [open "| git write-tree" r]
 917        fileevent $fd_wt readable \
 918                [list commit_committree $fd_wt $curHEAD $msg]
 919}
 920
 921proc commit_committree {fd_wt curHEAD msg} {
 922        global single_commit gitdir HEAD PARENT commit_type tcl_platform
 923        global ui_status_value ui_comm selected_commit_type
 924        global file_states selected_paths
 925
 926        gets $fd_wt tree_id
 927        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 928                error_popup "write-tree failed:\n\n$err"
 929                set ui_status_value {Commit failed.}
 930                unlock_index
 931                return
 932        }
 933
 934        # -- Create the commit.
 935        #
 936        set cmd [list git commit-tree $tree_id]
 937        if {$PARENT ne {}} {
 938                lappend cmd -p $PARENT
 939        }
 940        if {$commit_type eq {merge}} {
 941                if {[catch {
 942                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 943                                while {[gets $fd_mh merge_head] >= 0} {
 944                                        lappend cmd -p $merge_head
 945                                }
 946                                close $fd_mh
 947                        } err]} {
 948                        error_popup "Loading MERGE_HEAD failed:\n\n$err"
 949                        set ui_status_value {Commit failed.}
 950                        unlock_index
 951                        return
 952                }
 953        }
 954        if {$PARENT eq {}} {
 955                # git commit-tree writes to stderr during initial commit.
 956                lappend cmd 2>/dev/null
 957        }
 958        lappend cmd << $msg
 959        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 960                error_popup "commit-tree failed:\n\n$err"
 961                set ui_status_value {Commit failed.}
 962                unlock_index
 963                return
 964        }
 965
 966        # -- Update the HEAD ref.
 967        #
 968        set reflogm commit
 969        if {$commit_type ne {normal}} {
 970                append reflogm " ($commit_type)"
 971        }
 972        set i [string first "\n" $msg]
 973        if {$i >= 0} {
 974                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 975        } else {
 976                append reflogm {: } $msg
 977        }
 978        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 979        if {[catch {eval exec $cmd} err]} {
 980                error_popup "update-ref failed:\n\n$err"
 981                set ui_status_value {Commit failed.}
 982                unlock_index
 983                return
 984        }
 985
 986        # -- Cleanup after ourselves.
 987        #
 988        catch {file delete [file join $gitdir MERGE_HEAD]}
 989        catch {file delete [file join $gitdir MERGE_MSG]}
 990        catch {file delete [file join $gitdir SQUASH_MSG]}
 991        catch {file delete [file join $gitdir GITGUI_MSG]}
 992
 993        # -- Let rerere do its thing.
 994        #
 995        if {[file isdirectory [file join $gitdir rr-cache]]} {
 996                catch {exec git rerere}
 997        }
 998
 999        # -- Run the post-commit hook.
1000        #
1001        set pchook [file join $gitdir hooks post-commit]
1002        if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
1003                set pchook [list sh -c [concat \
1004                        "if test -x \"$pchook\";" \
1005                        "then exec \"$pchook\";" \
1006                        "fi"]]
1007        } elseif {![file executable $pchook]} {
1008                set pchook {}
1009        }
1010        if {$pchook ne {}} {
1011                catch {exec $pchook &}
1012        }
1013
1014        $ui_comm delete 0.0 end
1015        $ui_comm edit modified false
1016        $ui_comm edit reset
1017
1018        if {$single_commit} do_quit
1019
1020        # -- Update status without invoking any git commands.
1021        #
1022        set commit_type normal
1023        set selected_commit_type new
1024        set HEAD $cmt_id
1025        set PARENT $cmt_id
1026
1027        foreach path [array names file_states] {
1028                set s $file_states($path)
1029                set m [lindex $s 0]
1030                switch -glob -- $m {
1031                DD -
1032                AO {set m __}
1033                A? -
1034                M? -
1035                D? {set m _[string index $m 1]}
1036                }
1037
1038                if {$m eq {__}} {
1039                        unset file_states($path)
1040                        catch {unset selected_paths($path)}
1041                } else {
1042                        lset file_states($path) 0 $m
1043                }
1044        }
1045
1046        display_all_files
1047        unlock_index
1048        reshow_diff
1049        set ui_status_value \
1050                "Changes committed as [string range $cmt_id 0 7]."
1051}
1052
1053######################################################################
1054##
1055## fetch pull push
1056
1057proc fetch_from {remote} {
1058        set w [new_console "fetch $remote" \
1059                "Fetching new changes from $remote"]
1060        set cmd [list git fetch]
1061        lappend cmd $remote
1062        console_exec $w $cmd
1063}
1064
1065proc pull_remote {remote branch} {
1066        global HEAD commit_type file_states repo_config
1067
1068        if {![lock_index update]} return
1069
1070        # -- Our in memory state should match the repository.
1071        #
1072        repository_state curHEAD cur_type
1073        if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1074                error_popup {Last scanned state does not match repository state.
1075
1076Its highly likely that another Git program modified the
1077repository since our last scan.  A rescan is required
1078before a pull can be started.
1079}
1080                unlock_index
1081                rescan {set ui_status_value {Ready.}}
1082                return
1083        }
1084
1085        # -- No differences should exist before a pull.
1086        #
1087        if {[array size file_states] != 0} {
1088                error_popup {Uncommitted but modified files are present.
1089
1090You should not perform a pull with unmodified files in your working
1091directory as Git would be unable to recover from an incorrect merge.
1092
1093Commit or throw away all changes before starting a pull operation.
1094}
1095                unlock_index
1096                return
1097        }
1098
1099        set w [new_console "pull $remote $branch" \
1100                "Pulling new changes from branch $branch in $remote"]
1101        set cmd [list git pull]
1102        if {$repo_config(gui.pullsummary) eq {false}} {
1103                lappend cmd --no-summary
1104        }
1105        lappend cmd $remote
1106        lappend cmd $branch
1107        console_exec $w $cmd [list post_pull_remote $remote $branch]
1108}
1109
1110proc post_pull_remote {remote branch success} {
1111        global HEAD PARENT commit_type selected_commit_type
1112        global ui_status_value
1113
1114        unlock_index
1115        if {$success} {
1116                repository_state HEAD commit_type
1117                set PARENT $HEAD
1118                set selected_commit_type new
1119                set $ui_status_value "Pulling $branch from $remote complete."
1120        } else {
1121                set m "Conflicts detected while pulling $branch from $remote."
1122                rescan "set ui_status_value {$m}"
1123        }
1124}
1125
1126proc push_to {remote} {
1127        set w [new_console "push $remote" \
1128                "Pushing changes to $remote"]
1129        set cmd [list git push]
1130        lappend cmd $remote
1131        console_exec $w $cmd
1132}
1133
1134######################################################################
1135##
1136## ui helpers
1137
1138proc mapcol {state path} {
1139        global all_cols ui_other
1140
1141        if {[catch {set r $all_cols($state)}]} {
1142                puts "error: no column for state={$state} $path"
1143                return $ui_other
1144        }
1145        return $r
1146}
1147
1148proc mapicon {state path} {
1149        global all_icons
1150
1151        if {[catch {set r $all_icons($state)}]} {
1152                puts "error: no icon for state={$state} $path"
1153                return file_plain
1154        }
1155        return $r
1156}
1157
1158proc mapdesc {state path} {
1159        global all_descs
1160
1161        if {[catch {set r $all_descs($state)}]} {
1162                puts "error: no desc for state={$state} $path"
1163                return $state
1164        }
1165        return $r
1166}
1167
1168proc escape_path {path} {
1169        regsub -all "\n" $path "\\n" path
1170        return $path
1171}
1172
1173proc short_path {path} {
1174        return [escape_path [lindex [file split $path] end]]
1175}
1176
1177set next_icon_id 0
1178set null_sha1 [string repeat 0 40]
1179
1180proc merge_state {path new_state {head_info {}} {index_info {}}} {
1181        global file_states next_icon_id null_sha1
1182
1183        set s0 [string index $new_state 0]
1184        set s1 [string index $new_state 1]
1185
1186        if {[catch {set info $file_states($path)}]} {
1187                set state __
1188                set icon n[incr next_icon_id]
1189        } else {
1190                set state [lindex $info 0]
1191                set icon [lindex $info 1]
1192                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1193                if {$index_info eq {}} {set index_info [lindex $info 3]}
1194        }
1195
1196        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1197        elseif {$s0 eq {_}} {set s0 _}
1198
1199        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1200        elseif {$s1 eq {_}} {set s1 _}
1201
1202        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1203                set head_info [list 0 $null_sha1]
1204        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1205                && $head_info eq {}} {
1206                set head_info $index_info
1207        }
1208
1209        set file_states($path) [list $s0$s1 $icon \
1210                $head_info $index_info \
1211                ]
1212        return $state
1213}
1214
1215proc display_file {path state} {
1216        global file_states file_lists selected_paths
1217
1218        set old_m [merge_state $path $state]
1219        set s $file_states($path)
1220        set new_m [lindex $s 0]
1221        set new_w [mapcol $new_m $path] 
1222        set old_w [mapcol $old_m $path]
1223        set new_icon [mapicon $new_m $path]
1224
1225        if {$new_w ne $old_w} {
1226                set lno [lsearch -sorted $file_lists($old_w) $path]
1227                if {$lno >= 0} {
1228                        incr lno
1229                        $old_w conf -state normal
1230                        $old_w delete $lno.0 [expr {$lno + 1}].0
1231                        $old_w conf -state disabled
1232                }
1233
1234                lappend file_lists($new_w) $path
1235                set file_lists($new_w) [lsort $file_lists($new_w)]
1236                set lno [lsearch -sorted $file_lists($new_w) $path]
1237                incr lno
1238                $new_w conf -state normal
1239                $new_w image create $lno.0 \
1240                        -align center -padx 5 -pady 1 \
1241                        -name [lindex $s 1] \
1242                        -image $new_icon
1243                $new_w insert $lno.1 "[escape_path $path]\n"
1244                if {[catch {set in_sel $selected_paths($path)}]} {
1245                        set in_sel 0
1246                }
1247                if {$in_sel} {
1248                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1249                }
1250                $new_w conf -state disabled
1251        } elseif {$new_icon ne [mapicon $old_m $path]} {
1252                $new_w conf -state normal
1253                $new_w image conf [lindex $s 1] -image $new_icon
1254                $new_w conf -state disabled
1255        }
1256}
1257
1258proc display_all_files {} {
1259        global ui_index ui_other
1260        global file_states file_lists
1261        global last_clicked selected_paths
1262
1263        $ui_index conf -state normal
1264        $ui_other conf -state normal
1265
1266        $ui_index delete 0.0 end
1267        $ui_other delete 0.0 end
1268        set last_clicked {}
1269
1270        set file_lists($ui_index) [list]
1271        set file_lists($ui_other) [list]
1272
1273        foreach path [lsort [array names file_states]] {
1274                set s $file_states($path)
1275                set m [lindex $s 0]
1276                set w [mapcol $m $path]
1277                lappend file_lists($w) $path
1278                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1279                $w image create end \
1280                        -align center -padx 5 -pady 1 \
1281                        -name [lindex $s 1] \
1282                        -image [mapicon $m $path]
1283                $w insert end "[escape_path $path]\n"
1284                if {[catch {set in_sel $selected_paths($path)}]} {
1285                        set in_sel 0
1286                }
1287                if {$in_sel} {
1288                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1289                }
1290        }
1291
1292        $ui_index conf -state disabled
1293        $ui_other conf -state disabled
1294}
1295
1296proc update_indexinfo {msg pathList after} {
1297        global update_index_cp ui_status_value
1298
1299        if {![lock_index update]} return
1300
1301        set update_index_cp 0
1302        set pathList [lsort $pathList]
1303        set totalCnt [llength $pathList]
1304        set batch [expr {int($totalCnt * .01) + 1}]
1305        if {$batch > 25} {set batch 25}
1306
1307        set ui_status_value [format \
1308                "$msg... %i/%i files (%.2f%%)" \
1309                $update_index_cp \
1310                $totalCnt \
1311                0.0]
1312        set fd [open "| git update-index -z --index-info" w]
1313        fconfigure $fd \
1314                -blocking 0 \
1315                -buffering full \
1316                -buffersize 512 \
1317                -translation binary
1318        fileevent $fd writable [list \
1319                write_update_indexinfo \
1320                $fd \
1321                $pathList \
1322                $totalCnt \
1323                $batch \
1324                $msg \
1325                $after \
1326                ]
1327}
1328
1329proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1330        global update_index_cp ui_status_value
1331        global file_states current_diff
1332
1333        if {$update_index_cp >= $totalCnt} {
1334                close $fd
1335                unlock_index
1336                uplevel #0 $after
1337                return
1338        }
1339
1340        for {set i $batch} \
1341                {$update_index_cp < $totalCnt && $i > 0} \
1342                {incr i -1} {
1343                set path [lindex $pathList $update_index_cp]
1344                incr update_index_cp
1345
1346                set s $file_states($path)
1347                switch -glob -- [lindex $s 0] {
1348                A? {set new _O}
1349                M? {set new _M}
1350                D? {set new _?}
1351                ?? {continue}
1352                }
1353                set info [lindex $s 2]
1354                if {$info eq {}} continue
1355
1356                puts -nonewline $fd $info
1357                puts -nonewline $fd "\t"
1358                puts -nonewline $fd $path
1359                puts -nonewline $fd "\0"
1360                display_file $path $new
1361        }
1362
1363        set ui_status_value [format \
1364                "$msg... %i/%i files (%.2f%%)" \
1365                $update_index_cp \
1366                $totalCnt \
1367                [expr {100.0 * $update_index_cp / $totalCnt}]]
1368}
1369
1370proc update_index {msg pathList after} {
1371        global update_index_cp ui_status_value
1372
1373        if {![lock_index update]} return
1374
1375        set update_index_cp 0
1376        set pathList [lsort $pathList]
1377        set totalCnt [llength $pathList]
1378        set batch [expr {int($totalCnt * .01) + 1}]
1379        if {$batch > 25} {set batch 25}
1380
1381        set ui_status_value [format \
1382                "$msg... %i/%i files (%.2f%%)" \
1383                $update_index_cp \
1384                $totalCnt \
1385                0.0]
1386        set fd [open "| git update-index --add --remove -z --stdin" w]
1387        fconfigure $fd \
1388                -blocking 0 \
1389                -buffering full \
1390                -buffersize 512 \
1391                -translation binary
1392        fileevent $fd writable [list \
1393                write_update_index \
1394                $fd \
1395                $pathList \
1396                $totalCnt \
1397                $batch \
1398                $msg \
1399                $after \
1400                ]
1401}
1402
1403proc write_update_index {fd pathList totalCnt batch msg after} {
1404        global update_index_cp ui_status_value
1405        global file_states current_diff
1406
1407        if {$update_index_cp >= $totalCnt} {
1408                close $fd
1409                unlock_index
1410                uplevel #0 $after
1411                return
1412        }
1413
1414        for {set i $batch} \
1415                {$update_index_cp < $totalCnt && $i > 0} \
1416                {incr i -1} {
1417                set path [lindex $pathList $update_index_cp]
1418                incr update_index_cp
1419
1420                switch -glob -- [lindex $file_states($path) 0] {
1421                AD -
1422                MD -
1423                _D {set new DD}
1424
1425                _M -
1426                MM -
1427                M_ {set new M_}
1428
1429                _O -
1430                AM -
1431                A_ {set new A_}
1432
1433                ?? {continue}
1434                }
1435
1436                puts -nonewline $fd $path
1437                puts -nonewline $fd "\0"
1438                display_file $path $new
1439        }
1440
1441        set ui_status_value [format \
1442                "$msg... %i/%i files (%.2f%%)" \
1443                $update_index_cp \
1444                $totalCnt \
1445                [expr {100.0 * $update_index_cp / $totalCnt}]]
1446}
1447
1448######################################################################
1449##
1450## remote management
1451
1452proc load_all_remotes {} {
1453        global gitdir all_remotes repo_config
1454
1455        set all_remotes [list]
1456        set rm_dir [file join $gitdir remotes]
1457        if {[file isdirectory $rm_dir]} {
1458                set all_remotes [concat $all_remotes [glob \
1459                        -types f \
1460                        -tails \
1461                        -nocomplain \
1462                        -directory $rm_dir *]]
1463        }
1464
1465        foreach line [array names repo_config remote.*.url] {
1466                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1467                        lappend all_remotes $name
1468                }
1469        }
1470
1471        set all_remotes [lsort -unique $all_remotes]
1472}
1473
1474proc populate_fetch_menu {m} {
1475        global gitdir all_remotes repo_config
1476
1477        foreach r $all_remotes {
1478                set enable 0
1479                if {![catch {set a $repo_config(remote.$r.url)}]} {
1480                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1481                                set enable 1
1482                        }
1483                } else {
1484                        catch {
1485                                set fd [open [file join $gitdir remotes $r] r]
1486                                while {[gets $fd n] >= 0} {
1487                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1488                                                set enable 1
1489                                                break
1490                                        }
1491                                }
1492                                close $fd
1493                        }
1494                }
1495
1496                if {$enable} {
1497                        $m add command \
1498                                -label "Fetch from $r..." \
1499                                -command [list fetch_from $r] \
1500                                -font font_ui
1501                }
1502        }
1503}
1504
1505proc populate_push_menu {m} {
1506        global gitdir all_remotes repo_config
1507
1508        foreach r $all_remotes {
1509                set enable 0
1510                if {![catch {set a $repo_config(remote.$r.url)}]} {
1511                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1512                                set enable 1
1513                        }
1514                } else {
1515                        catch {
1516                                set fd [open [file join $gitdir remotes $r] r]
1517                                while {[gets $fd n] >= 0} {
1518                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1519                                                set enable 1
1520                                                break
1521                                        }
1522                                }
1523                                close $fd
1524                        }
1525                }
1526
1527                if {$enable} {
1528                        $m add command \
1529                                -label "Push to $r..." \
1530                                -command [list push_to $r] \
1531                                -font font_ui
1532                }
1533        }
1534}
1535
1536proc populate_pull_menu {m} {
1537        global gitdir repo_config all_remotes disable_on_lock
1538
1539        foreach remote $all_remotes {
1540                set rb {}
1541                if {[array get repo_config remote.$remote.url] ne {}} {
1542                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1543                                regexp {^([^:]+):} \
1544                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1545                                        line rb
1546                        }
1547                } else {
1548                        catch {
1549                                set fd [open [file join $gitdir remotes $remote] r]
1550                                while {[gets $fd line] >= 0} {
1551                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1552                                                break
1553                                        }
1554                                }
1555                                close $fd
1556                        }
1557                }
1558
1559                set rb_short $rb
1560                regsub ^refs/heads/ $rb {} rb_short
1561                if {$rb_short ne {}} {
1562                        $m add command \
1563                                -label "Branch $rb_short from $remote..." \
1564                                -command [list pull_remote $remote $rb] \
1565                                -font font_ui
1566                        lappend disable_on_lock \
1567                                [list $m entryconf [$m index last] -state]
1568                }
1569        }
1570}
1571
1572######################################################################
1573##
1574## icons
1575
1576set filemask {
1577#define mask_width 14
1578#define mask_height 15
1579static unsigned char mask_bits[] = {
1580   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1581   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1582   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1583}
1584
1585image create bitmap file_plain -background white -foreground black -data {
1586#define plain_width 14
1587#define plain_height 15
1588static unsigned char plain_bits[] = {
1589   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1590   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1591   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1592} -maskdata $filemask
1593
1594image create bitmap file_mod -background white -foreground blue -data {
1595#define mod_width 14
1596#define mod_height 15
1597static unsigned char mod_bits[] = {
1598   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1599   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1600   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1601} -maskdata $filemask
1602
1603image create bitmap file_fulltick -background white -foreground "#007000" -data {
1604#define file_fulltick_width 14
1605#define file_fulltick_height 15
1606static unsigned char file_fulltick_bits[] = {
1607   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1608   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1609   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1610} -maskdata $filemask
1611
1612image create bitmap file_parttick -background white -foreground "#005050" -data {
1613#define parttick_width 14
1614#define parttick_height 15
1615static unsigned char parttick_bits[] = {
1616   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1617   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1618   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1619} -maskdata $filemask
1620
1621image create bitmap file_question -background white -foreground black -data {
1622#define file_question_width 14
1623#define file_question_height 15
1624static unsigned char file_question_bits[] = {
1625   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1626   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1627   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1628} -maskdata $filemask
1629
1630image create bitmap file_removed -background white -foreground red -data {
1631#define file_removed_width 14
1632#define file_removed_height 15
1633static unsigned char file_removed_bits[] = {
1634   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1635   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1636   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1637} -maskdata $filemask
1638
1639image create bitmap file_merge -background white -foreground blue -data {
1640#define file_merge_width 14
1641#define file_merge_height 15
1642static unsigned char file_merge_bits[] = {
1643   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1644   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1645   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1646} -maskdata $filemask
1647
1648set ui_index .vpane.files.index.list
1649set ui_other .vpane.files.other.list
1650set max_status_desc 0
1651foreach i {
1652                {__ i plain    "Unmodified"}
1653                {_M i mod      "Modified"}
1654                {M_ i fulltick "Included in commit"}
1655                {MM i parttick "Partially included"}
1656
1657                {_O o plain    "Untracked"}
1658                {A_ o fulltick "Added by commit"}
1659                {AM o parttick "Partially added"}
1660                {AD o question "Added (but now gone)"}
1661
1662                {_D i question "Missing"}
1663                {D_ i removed  "Removed by commit"}
1664                {DD i removed  "Removed by commit"}
1665                {DO i removed  "Removed (still exists)"}
1666
1667                {UM i merge    "Merge conflicts"}
1668                {U_ i merge    "Merge conflicts"}
1669        } {
1670        if {$max_status_desc < [string length [lindex $i 3]]} {
1671                set max_status_desc [string length [lindex $i 3]]
1672        }
1673        if {[lindex $i 1] eq {i}} {
1674                set all_cols([lindex $i 0]) $ui_index
1675        } else {
1676                set all_cols([lindex $i 0]) $ui_other
1677        }
1678        set all_icons([lindex $i 0]) file_[lindex $i 2]
1679        set all_descs([lindex $i 0]) [lindex $i 3]
1680}
1681unset filemask i
1682
1683######################################################################
1684##
1685## util
1686
1687proc is_MacOSX {} {
1688        global tcl_platform tk_library
1689        if {$tcl_platform(platform) eq {unix}
1690                && $tcl_platform(os) eq {Darwin}
1691                && [string match /Library/Frameworks/* $tk_library]} {
1692                return 1
1693        }
1694        return 0
1695}
1696
1697proc bind_button3 {w cmd} {
1698        bind $w <Any-Button-3> $cmd
1699        if {[is_MacOSX]} {
1700                bind $w <Control-Button-1> $cmd
1701        }
1702}
1703
1704proc incr_font_size {font {amt 1}} {
1705        set sz [font configure $font -size]
1706        incr sz $amt
1707        font configure $font -size $sz
1708        font configure ${font}bold -size $sz
1709}
1710
1711proc hook_failed_popup {hook msg} {
1712        global gitdir appname
1713
1714        set w .hookfail
1715        toplevel $w
1716
1717        frame $w.m
1718        label $w.m.l1 -text "$hook hook failed:" \
1719                -anchor w \
1720                -justify left \
1721                -font font_uibold
1722        text $w.m.t \
1723                -background white -borderwidth 1 \
1724                -relief sunken \
1725                -width 80 -height 10 \
1726                -font font_diff \
1727                -yscrollcommand [list $w.m.sby set]
1728        label $w.m.l2 \
1729                -text {You must correct the above errors before committing.} \
1730                -anchor w \
1731                -justify left \
1732                -font font_uibold
1733        scrollbar $w.m.sby -command [list $w.m.t yview]
1734        pack $w.m.l1 -side top -fill x
1735        pack $w.m.l2 -side bottom -fill x
1736        pack $w.m.sby -side right -fill y
1737        pack $w.m.t -side left -fill both -expand 1
1738        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1739
1740        $w.m.t insert 1.0 $msg
1741        $w.m.t conf -state disabled
1742
1743        button $w.ok -text OK \
1744                -width 15 \
1745                -font font_ui \
1746                -command "destroy $w"
1747        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1748
1749        bind $w <Visibility> "grab $w; focus $w"
1750        bind $w <Key-Return> "destroy $w"
1751        wm title $w "$appname ([lindex [file split \
1752                [file normalize [file dirname $gitdir]]] \
1753                end]): error"
1754        tkwait window $w
1755}
1756
1757set next_console_id 0
1758
1759proc new_console {short_title long_title} {
1760        global next_console_id console_data
1761        set w .console[incr next_console_id]
1762        set console_data($w) [list $short_title $long_title]
1763        return [console_init $w]
1764}
1765
1766proc console_init {w} {
1767        global console_cr console_data
1768        global gitdir appname M1B
1769
1770        set console_cr($w) 1.0
1771        toplevel $w
1772        frame $w.m
1773        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1774                -anchor w \
1775                -justify left \
1776                -font font_uibold
1777        text $w.m.t \
1778                -background white -borderwidth 1 \
1779                -relief sunken \
1780                -width 80 -height 10 \
1781                -font font_diff \
1782                -state disabled \
1783                -yscrollcommand [list $w.m.sby set]
1784        label $w.m.s -text {Working... please wait...} \
1785                -anchor w \
1786                -justify left \
1787                -font font_uibold
1788        scrollbar $w.m.sby -command [list $w.m.t yview]
1789        pack $w.m.l1 -side top -fill x
1790        pack $w.m.s -side bottom -fill x
1791        pack $w.m.sby -side right -fill y
1792        pack $w.m.t -side left -fill both -expand 1
1793        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1794
1795        menu $w.ctxm -tearoff 0
1796        $w.ctxm add command -label "Copy" \
1797                -font font_ui \
1798                -command "tk_textCopy $w.m.t"
1799        $w.ctxm add command -label "Select All" \
1800                -font font_ui \
1801                -command "$w.m.t tag add sel 0.0 end"
1802        $w.ctxm add command -label "Copy All" \
1803                -font font_ui \
1804                -command "
1805                        $w.m.t tag add sel 0.0 end
1806                        tk_textCopy $w.m.t
1807                        $w.m.t tag remove sel 0.0 end
1808                "
1809
1810        button $w.ok -text {Close} \
1811                -font font_ui \
1812                -state disabled \
1813                -command "destroy $w"
1814        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1815
1816        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1817        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1818        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1819        bind $w <Visibility> "focus $w"
1820        wm title $w "$appname ([lindex [file split \
1821                [file normalize [file dirname $gitdir]]] \
1822                end]): [lindex $console_data($w) 0]"
1823        return $w
1824}
1825
1826proc console_exec {w cmd {after {}}} {
1827        global tcl_platform
1828
1829        # -- Windows tosses the enviroment when we exec our child.
1830        #    But most users need that so we have to relogin. :-(
1831        #
1832        if {$tcl_platform(platform) eq {windows}} {
1833                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1834        }
1835
1836        # -- Tcl won't let us redirect both stdout and stderr to
1837        #    the same pipe.  So pass it through cat...
1838        #
1839        set cmd [concat | $cmd |& cat]
1840
1841        set fd_f [open $cmd r]
1842        fconfigure $fd_f -blocking 0 -translation binary
1843        fileevent $fd_f readable [list console_read $w $fd_f $after]
1844}
1845
1846proc console_read {w fd after} {
1847        global console_cr console_data
1848
1849        set buf [read $fd]
1850        if {$buf ne {}} {
1851                if {![winfo exists $w]} {console_init $w}
1852                $w.m.t conf -state normal
1853                set c 0
1854                set n [string length $buf]
1855                while {$c < $n} {
1856                        set cr [string first "\r" $buf $c]
1857                        set lf [string first "\n" $buf $c]
1858                        if {$cr < 0} {set cr [expr {$n + 1}]}
1859                        if {$lf < 0} {set lf [expr {$n + 1}]}
1860
1861                        if {$lf < $cr} {
1862                                $w.m.t insert end [string range $buf $c $lf]
1863                                set console_cr($w) [$w.m.t index {end -1c}]
1864                                set c $lf
1865                                incr c
1866                        } else {
1867                                $w.m.t delete $console_cr($w) end
1868                                $w.m.t insert end "\n"
1869                                $w.m.t insert end [string range $buf $c $cr]
1870                                set c $cr
1871                                incr c
1872                        }
1873                }
1874                $w.m.t conf -state disabled
1875                $w.m.t see end
1876        }
1877
1878        fconfigure $fd -blocking 1
1879        if {[eof $fd]} {
1880                if {[catch {close $fd}]} {
1881                        if {![winfo exists $w]} {console_init $w}
1882                        $w.m.s conf -background red -text {Error: Command Failed}
1883                        $w.ok conf -state normal
1884                        set ok 0
1885                } elseif {[winfo exists $w]} {
1886                        $w.m.s conf -background green -text {Success}
1887                        $w.ok conf -state normal
1888                        set ok 1
1889                }
1890                array unset console_cr $w
1891                array unset console_data $w
1892                if {$after ne {}} {
1893                        uplevel #0 $after $ok
1894                }
1895                return
1896        }
1897        fconfigure $fd -blocking 0
1898}
1899
1900######################################################################
1901##
1902## ui commands
1903
1904set starting_gitk_msg {Please wait... Starting gitk...}
1905
1906proc do_gitk {} {
1907        global tcl_platform ui_status_value starting_gitk_msg
1908
1909        set ui_status_value $starting_gitk_msg
1910        after 10000 {
1911                if {$ui_status_value eq $starting_gitk_msg} {
1912                        set ui_status_value {Ready.}
1913                }
1914        }
1915
1916        if {$tcl_platform(platform) eq {windows}} {
1917                exec sh -c gitk &
1918        } else {
1919                exec gitk &
1920        }
1921}
1922
1923proc do_repack {} {
1924        set w [new_console "repack" "Repacking the object database"]
1925        set cmd [list git repack]
1926        lappend cmd -a
1927        lappend cmd -d
1928        console_exec $w $cmd
1929}
1930
1931set is_quitting 0
1932
1933proc do_quit {} {
1934        global gitdir ui_comm is_quitting repo_config
1935
1936        if {$is_quitting} return
1937        set is_quitting 1
1938
1939        # -- Stash our current commit buffer.
1940        #
1941        set save [file join $gitdir GITGUI_MSG]
1942        set msg [string trim [$ui_comm get 0.0 end]]
1943        if {[$ui_comm edit modified] && $msg ne {}} {
1944                catch {
1945                        set fd [open $save w]
1946                        puts $fd [string trim [$ui_comm get 0.0 end]]
1947                        close $fd
1948                }
1949        } elseif {$msg eq {} && [file exists $save]} {
1950                file delete $save
1951        }
1952
1953        # -- Stash our current window geometry into this repository.
1954        #
1955        set cfg_geometry [list]
1956        lappend cfg_geometry [wm geometry .]
1957        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1958        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1959        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1960                set rc_geometry {}
1961        }
1962        if {$cfg_geometry ne $rc_geometry} {
1963                catch {exec git repo-config gui.geometry $cfg_geometry}
1964        }
1965
1966        destroy .
1967}
1968
1969proc do_rescan {} {
1970        rescan {set ui_status_value {Ready.}}
1971}
1972
1973proc remove_helper {txt paths} {
1974        global file_states current_diff
1975
1976        if {![lock_index begin-update]} return
1977
1978        set pathList [list]
1979        set after {}
1980        foreach path $paths {
1981                switch -glob -- [lindex $file_states($path) 0] {
1982                A? -
1983                M? -
1984                D? {
1985                        lappend pathList $path
1986                        if {$path eq $current_diff} {
1987                                set after {reshow_diff;}
1988                        }
1989                }
1990                }
1991        }
1992        if {$pathList eq {}} {
1993                unlock_index
1994        } else {
1995                update_indexinfo \
1996                        $txt \
1997                        $pathList \
1998                        [concat $after {set ui_status_value {Ready.}}]
1999        }
2000}
2001
2002proc do_remove_selection {} {
2003        global current_diff selected_paths
2004
2005        if {[array size selected_paths] > 0} {
2006                remove_helper \
2007                        {Removing selected files from commit} \
2008                        [array names selected_paths]
2009        } elseif {$current_diff ne {}} {
2010                remove_helper \
2011                        "Removing [short_path $current_diff] from commit" \
2012                        [list $current_diff]
2013        }
2014}
2015
2016proc include_helper {txt paths} {
2017        global file_states current_diff
2018
2019        if {![lock_index begin-update]} return
2020
2021        set pathList [list]
2022        set after {}
2023        foreach path $paths {
2024                switch -- [lindex $file_states($path) 0] {
2025                AM -
2026                AD -
2027                MM -
2028                UM -
2029                U_ -
2030                _M -
2031                _D -
2032                _O {
2033                        lappend pathList $path
2034                        if {$path eq $current_diff} {
2035                                set after {reshow_diff;}
2036                        }
2037                }
2038                }
2039        }
2040        if {$pathList eq {}} {
2041                unlock_index
2042        } else {
2043                update_index \
2044                        $txt \
2045                        $pathList \
2046                        [concat $after {set ui_status_value {Ready to commit.}}]
2047        }
2048}
2049
2050proc do_include_selection {} {
2051        global current_diff selected_paths
2052
2053        if {[array size selected_paths] > 0} {
2054                include_helper \
2055                        {Including selected files} \
2056                        [array names selected_paths]
2057        } elseif {$current_diff ne {}} {
2058                include_helper \
2059                        "Including [short_path $current_diff]" \
2060                        [list $current_diff]
2061        }
2062}
2063
2064proc do_include_all {} {
2065        global file_states
2066
2067        set paths [list]
2068        foreach path [array names file_states] {
2069                switch -- [lindex $file_states($path) 0] {
2070                AM -
2071                AD -
2072                MM -
2073                _M -
2074                _D {lappend paths $path}
2075                }
2076        }
2077        include_helper \
2078                {Including all modified files} \
2079                $paths
2080}
2081
2082proc do_signoff {} {
2083        global ui_comm
2084
2085        set me [committer_ident]
2086        if {$me eq {}} return
2087
2088        set sob "Signed-off-by: $me"
2089        set last [$ui_comm get {end -1c linestart} {end -1c}]
2090        if {$last ne $sob} {
2091                $ui_comm edit separator
2092                if {$last ne {}
2093                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2094                        $ui_comm insert end "\n"
2095                }
2096                $ui_comm insert end "\n$sob"
2097                $ui_comm edit separator
2098                $ui_comm see end
2099        }
2100}
2101
2102proc do_select_commit_type {} {
2103        global commit_type selected_commit_type
2104
2105        if {$selected_commit_type eq {new}
2106                && [string match amend* $commit_type]} {
2107                create_new_commit
2108        } elseif {$selected_commit_type eq {amend}
2109                && ![string match amend* $commit_type]} {
2110                load_last_commit
2111
2112                # The amend request was rejected...
2113                #
2114                if {![string match amend* $commit_type]} {
2115                        set selected_commit_type new
2116                }
2117        }
2118}
2119
2120proc do_commit {} {
2121        commit_tree
2122}
2123
2124proc do_options {} {
2125        global appname gitdir font_descs
2126        global repo_config global_config
2127        global repo_config_new global_config_new
2128
2129        array unset repo_config_new
2130        array unset global_config_new
2131        foreach name [array names repo_config] {
2132                set repo_config_new($name) $repo_config($name)
2133        }
2134        load_config 1
2135        foreach name [array names repo_config] {
2136                switch -- $name {
2137                gui.diffcontext {continue}
2138                }
2139                set repo_config_new($name) $repo_config($name)
2140        }
2141        foreach name [array names global_config] {
2142                set global_config_new($name) $global_config($name)
2143        }
2144        set reponame [lindex [file split \
2145                [file normalize [file dirname $gitdir]]] \
2146                end]
2147
2148        set w .options_editor
2149        toplevel $w
2150        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2151
2152        label $w.header -text "$appname Options" \
2153                -font font_uibold
2154        pack $w.header -side top -fill x
2155
2156        frame $w.buttons
2157        button $w.buttons.restore -text {Restore Defaults} \
2158                -font font_ui \
2159                -command do_restore_defaults
2160        pack $w.buttons.restore -side left
2161        button $w.buttons.save -text Save \
2162                -font font_ui \
2163                -command [list do_save_config $w]
2164        pack $w.buttons.save -side right
2165        button $w.buttons.cancel -text {Cancel} \
2166                -font font_ui \
2167                -command [list destroy $w]
2168        pack $w.buttons.cancel -side right
2169        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2170
2171        labelframe $w.repo -text "$reponame Repository" \
2172                -font font_ui \
2173                -relief raised -borderwidth 2
2174        labelframe $w.global -text {Global (All Repositories)} \
2175                -font font_ui \
2176                -relief raised -borderwidth 2
2177        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2178        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2179
2180        foreach option {
2181                {b partialinclude {Allow Partially Included Files}}
2182                {b pullsummary {Show Pull Summary}}
2183                {b trustmtime  {Trust File Modification Timestamps}}
2184                {i diffcontext {Number of Diff Context Lines}}
2185                } {
2186                set type [lindex $option 0]
2187                set name [lindex $option 1]
2188                set text [lindex $option 2]
2189                foreach f {repo global} {
2190                        switch $type {
2191                        b {
2192                                checkbutton $w.$f.$name -text $text \
2193                                        -variable ${f}_config_new(gui.$name) \
2194                                        -onvalue true \
2195                                        -offvalue false \
2196                                        -font font_ui
2197                                pack $w.$f.$name -side top -anchor w
2198                        }
2199                        i {
2200                                frame $w.$f.$name
2201                                label $w.$f.$name.l -text "$text:" -font font_ui
2202                                pack $w.$f.$name.l -side left -anchor w -fill x
2203                                spinbox $w.$f.$name.v \
2204                                        -textvariable ${f}_config_new(gui.$name) \
2205                                        -from 1 -to 99 -increment 1 \
2206                                        -width 3 \
2207                                        -font font_ui
2208                                pack $w.$f.$name.v -side right -anchor e
2209                                pack $w.$f.$name -side top -anchor w -fill x
2210                        }
2211                        }
2212                }
2213        }
2214
2215        set all_fonts [lsort [font families]]
2216        foreach option $font_descs {
2217                set name [lindex $option 0]
2218                set font [lindex $option 1]
2219                set text [lindex $option 2]
2220
2221                set global_config_new(gui.$font^^family) \
2222                        [font configure $font -family]
2223                set global_config_new(gui.$font^^size) \
2224                        [font configure $font -size]
2225
2226                frame $w.global.$name
2227                label $w.global.$name.l -text "$text:" -font font_ui
2228                pack $w.global.$name.l -side left -anchor w -fill x
2229                eval tk_optionMenu $w.global.$name.family \
2230                        global_config_new(gui.$font^^family) \
2231                        $all_fonts
2232                spinbox $w.global.$name.size \
2233                        -textvariable global_config_new(gui.$font^^size) \
2234                        -from 2 -to 80 -increment 1 \
2235                        -width 3 \
2236                        -font font_ui
2237                pack $w.global.$name.size -side right -anchor e
2238                pack $w.global.$name.family -side right -anchor e
2239                pack $w.global.$name -side top -anchor w -fill x
2240        }
2241
2242        bind $w <Visibility> "grab $w; focus $w"
2243        bind $w <Key-Escape> "destroy $w"
2244        wm title $w "$appname ($reponame): Options"
2245        tkwait window $w
2246}
2247
2248proc do_restore_defaults {} {
2249        global font_descs default_config repo_config
2250        global repo_config_new global_config_new
2251
2252        foreach name [array names default_config] {
2253                set repo_config_new($name) $default_config($name)
2254                set global_config_new($name) $default_config($name)
2255        }
2256
2257        foreach option $font_descs {
2258                set name [lindex $option 0]
2259                set repo_config(gui.$name) $default_config(gui.$name)
2260        }
2261        apply_config
2262
2263        foreach option $font_descs {
2264                set name [lindex $option 0]
2265                set font [lindex $option 1]
2266                set global_config_new(gui.$font^^family) \
2267                        [font configure $font -family]
2268                set global_config_new(gui.$font^^size) \
2269                        [font configure $font -size]
2270        }
2271}
2272
2273proc do_save_config {w} {
2274        if {[catch {save_config} err]} {
2275                error_popup "Failed to completely save options:\n\n$err"
2276        }
2277        reshow_diff
2278        destroy $w
2279}
2280
2281proc do_windows_shortcut {} {
2282        global gitdir appname argv0
2283
2284        set reponame [lindex [file split \
2285                [file normalize [file dirname $gitdir]]] \
2286                end]
2287
2288        if {[catch {
2289                set desktop [exec cygpath \
2290                        --windows \
2291                        --absolute \
2292                        --long-name \
2293                        --desktop]
2294                }]} {
2295                        set desktop .
2296        }
2297        set fn [tk_getSaveFile \
2298                -parent . \
2299                -title "$appname ($reponame): Create Desktop Icon" \
2300                -initialdir $desktop \
2301                -initialfile "Git $reponame.bat"]
2302        if {$fn != {}} {
2303                if {[catch {
2304                                set fd [open $fn w]
2305                                set sh [exec cygpath \
2306                                        --windows \
2307                                        --absolute \
2308                                        --long-name \
2309                                        /bin/sh]
2310                                set me [exec cygpath \
2311                                        --unix \
2312                                        --absolute \
2313                                        $argv0]
2314                                set gd [exec cygpath \
2315                                        --unix \
2316                                        --absolute \
2317                                        $gitdir]
2318                                regsub -all ' $me "'\\''" me
2319                                regsub -all ' $gd "'\\''" gd
2320                                puts -nonewline $fd "\"$sh\" --login -c \""
2321                                puts -nonewline $fd "GIT_DIR='$gd'"
2322                                puts -nonewline $fd " '$me'"
2323                                puts $fd "&\""
2324                                close $fd
2325                        } err]} {
2326                        error_popup "Cannot write script:\n\n$err"
2327                }
2328        }
2329}
2330
2331proc do_macosx_app {} {
2332        global gitdir appname argv0 env
2333
2334        set reponame [lindex [file split \
2335                [file normalize [file dirname $gitdir]]] \
2336                end]
2337
2338        set fn [tk_getSaveFile \
2339                -parent . \
2340                -title "$appname ($reponame): Create Desktop Icon" \
2341                -initialdir [file join $env(HOME) Desktop] \
2342                -initialfile "Git $reponame.app"]
2343        if {$fn != {}} {
2344                if {[catch {
2345                                set Contents [file join $fn Contents]
2346                                set MacOS [file join $Contents MacOS]
2347                                set exe [file join $MacOS git-gui]
2348
2349                                file mkdir $MacOS
2350
2351                                set fd [open [file join $Contents Info.plist] w]
2352                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2353<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2354<plist version="1.0">
2355<dict>
2356        <key>CFBundleDevelopmentRegion</key>
2357        <string>English</string>
2358        <key>CFBundleExecutable</key>
2359        <string>git-gui</string>
2360        <key>CFBundleIdentifier</key>
2361        <string>org.spearce.git-gui</string>
2362        <key>CFBundleInfoDictionaryVersion</key>
2363        <string>6.0</string>
2364        <key>CFBundlePackageType</key>
2365        <string>APPL</string>
2366        <key>CFBundleSignature</key>
2367        <string>????</string>
2368        <key>CFBundleVersion</key>
2369        <string>1.0</string>
2370        <key>NSPrincipalClass</key>
2371        <string>NSApplication</string>
2372</dict>
2373</plist>}
2374                                close $fd
2375
2376                                set fd [open $exe w]
2377                                set gd [file normalize $gitdir]
2378                                set ep [file normalize [exec git --exec-path]]
2379                                regsub -all ' $gd "'\\''" gd
2380                                regsub -all ' $ep "'\\''" ep
2381                                puts $fd "#!/bin/sh"
2382                                foreach name [array names env] {
2383                                        if {[string match GIT_* $name]} {
2384                                                regsub -all ' $env($name) "'\\''" v
2385                                                puts $fd "export $name='$v'"
2386                                        }
2387                                }
2388                                puts $fd "export PATH='$ep':\$PATH"
2389                                puts $fd "export GIT_DIR='$gd'"
2390                                puts $fd "exec [file normalize $argv0]"
2391                                close $fd
2392
2393                                file attributes $exe -permissions u+x,g+x,o+x
2394                        } err]} {
2395                        error_popup "Cannot write icon:\n\n$err"
2396                }
2397        }
2398}
2399
2400proc toggle_or_diff {w x y} {
2401        global file_states file_lists current_diff ui_index ui_other
2402        global last_clicked selected_paths
2403
2404        set pos [split [$w index @$x,$y] .]
2405        set lno [lindex $pos 0]
2406        set col [lindex $pos 1]
2407        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2408        if {$path eq {}} {
2409                set last_clicked {}
2410                return
2411        }
2412
2413        set last_clicked [list $w $lno]
2414        array unset selected_paths
2415        $ui_index tag remove in_sel 0.0 end
2416        $ui_other tag remove in_sel 0.0 end
2417
2418        if {$col == 0} {
2419                if {$current_diff eq $path} {
2420                        set after {reshow_diff;}
2421                } else {
2422                        set after {}
2423                }
2424                switch -glob -- [lindex $file_states($path) 0] {
2425                A_ -
2426                AO -
2427                M_ -
2428                DD -
2429                D_ {
2430                        update_indexinfo \
2431                                "Removing [short_path $path] from commit" \
2432                                [list $path] \
2433                                [concat $after {set ui_status_value {Ready.}}]
2434                }
2435                ?? {
2436                        update_index \
2437                                "Including [short_path $path]" \
2438                                [list $path] \
2439                                [concat $after {set ui_status_value {Ready.}}]
2440                }
2441                }
2442        } else {
2443                show_diff $path $w $lno
2444        }
2445}
2446
2447proc add_one_to_selection {w x y} {
2448        global file_lists
2449        global last_clicked selected_paths
2450
2451        set pos [split [$w index @$x,$y] .]
2452        set lno [lindex $pos 0]
2453        set col [lindex $pos 1]
2454        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2455        if {$path eq {}} {
2456                set last_clicked {}
2457                return
2458        }
2459
2460        set last_clicked [list $w $lno]
2461        if {[catch {set in_sel $selected_paths($path)}]} {
2462                set in_sel 0
2463        }
2464        if {$in_sel} {
2465                unset selected_paths($path)
2466                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2467        } else {
2468                set selected_paths($path) 1
2469                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2470        }
2471}
2472
2473proc add_range_to_selection {w x y} {
2474        global file_lists
2475        global last_clicked selected_paths
2476
2477        if {[lindex $last_clicked 0] ne $w} {
2478                toggle_or_diff $w $x $y
2479                return
2480        }
2481
2482        set pos [split [$w index @$x,$y] .]
2483        set lno [lindex $pos 0]
2484        set lc [lindex $last_clicked 1]
2485        if {$lc < $lno} {
2486                set begin $lc
2487                set end $lno
2488        } else {
2489                set begin $lno
2490                set end $lc
2491        }
2492
2493        foreach path [lrange $file_lists($w) \
2494                [expr {$begin - 1}] \
2495                [expr {$end - 1}]] {
2496                set selected_paths($path) 1
2497        }
2498        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2499}
2500
2501######################################################################
2502##
2503## config defaults
2504
2505set cursor_ptr arrow
2506font create font_diff -family Courier -size 10
2507font create font_ui
2508catch {
2509        label .dummy
2510        eval font configure font_ui [font actual [.dummy cget -font]]
2511        destroy .dummy
2512}
2513
2514font create font_uibold
2515font create font_diffbold
2516
2517set M1B M1
2518set M1T M1
2519if {$tcl_platform(platform) eq {windows}} {
2520        set M1B Control
2521        set M1T Ctrl
2522} elseif {[is_MacOSX]} {
2523        set M1B M1
2524        set M1T Cmd
2525}
2526
2527proc apply_config {} {
2528        global repo_config font_descs
2529
2530        foreach option $font_descs {
2531                set name [lindex $option 0]
2532                set font [lindex $option 1]
2533                if {[catch {
2534                        foreach {cn cv} $repo_config(gui.$name) {
2535                                font configure $font $cn $cv
2536                        }
2537                        } err]} {
2538                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2539                }
2540                foreach {cn cv} [font configure $font] {
2541                        font configure ${font}bold $cn $cv
2542                }
2543                font configure ${font}bold -weight bold
2544        }
2545}
2546
2547set default_config(gui.trustmtime) false
2548set default_config(gui.pullsummary) true
2549set default_config(gui.partialinclude) false
2550set default_config(gui.diffcontext) 5
2551set default_config(gui.fontui) [font configure font_ui]
2552set default_config(gui.fontdiff) [font configure font_diff]
2553set font_descs {
2554        {fontui   font_ui   {Main Font}}
2555        {fontdiff font_diff {Diff/Console Font}}
2556}
2557load_config 0
2558apply_config
2559
2560######################################################################
2561##
2562## ui construction
2563
2564# -- Menu Bar
2565#
2566menu .mbar -tearoff 0
2567.mbar add cascade -label Project -menu .mbar.project
2568.mbar add cascade -label Edit -menu .mbar.edit
2569.mbar add cascade -label Commit -menu .mbar.commit
2570if {!$single_commit} {
2571        .mbar add cascade -label Fetch -menu .mbar.fetch
2572        .mbar add cascade -label Pull -menu .mbar.pull
2573        .mbar add cascade -label Push -menu .mbar.push
2574}
2575. configure -menu .mbar
2576
2577# -- Project Menu
2578#
2579menu .mbar.project
2580.mbar.project add command -label Visualize \
2581        -command do_gitk \
2582        -font font_ui
2583if {!$single_commit} {
2584        .mbar.project add command -label {Repack Database} \
2585                -command do_repack \
2586                -font font_ui
2587
2588        if {$tcl_platform(platform) eq {windows}} {
2589                .mbar.project add command \
2590                        -label {Create Desktop Icon} \
2591                        -command do_windows_shortcut \
2592                        -font font_ui
2593        } elseif {[is_MacOSX]} {
2594                .mbar.project add command \
2595                        -label {Create Desktop Icon} \
2596                        -command do_macosx_app \
2597                        -font font_ui
2598        }
2599}
2600.mbar.project add command -label Quit \
2601        -command do_quit \
2602        -accelerator $M1T-Q \
2603        -font font_ui
2604
2605# -- Edit Menu
2606#
2607menu .mbar.edit
2608.mbar.edit add command -label Undo \
2609        -command {catch {[focus] edit undo}} \
2610        -accelerator $M1T-Z \
2611        -font font_ui
2612.mbar.edit add command -label Redo \
2613        -command {catch {[focus] edit redo}} \
2614        -accelerator $M1T-Y \
2615        -font font_ui
2616.mbar.edit add separator
2617.mbar.edit add command -label Cut \
2618        -command {catch {tk_textCut [focus]}} \
2619        -accelerator $M1T-X \
2620        -font font_ui
2621.mbar.edit add command -label Copy \
2622        -command {catch {tk_textCopy [focus]}} \
2623        -accelerator $M1T-C \
2624        -font font_ui
2625.mbar.edit add command -label Paste \
2626        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2627        -accelerator $M1T-V \
2628        -font font_ui
2629.mbar.edit add command -label Delete \
2630        -command {catch {[focus] delete sel.first sel.last}} \
2631        -accelerator Del \
2632        -font font_ui
2633.mbar.edit add separator
2634.mbar.edit add command -label {Select All} \
2635        -command {catch {[focus] tag add sel 0.0 end}} \
2636        -accelerator $M1T-A \
2637        -font font_ui
2638.mbar.edit add separator
2639.mbar.edit add command -label {Options...} \
2640        -command do_options \
2641        -font font_ui
2642
2643# -- Commit Menu
2644#
2645menu .mbar.commit
2646
2647.mbar.commit add radiobutton \
2648        -label {New Commit} \
2649        -command do_select_commit_type \
2650        -variable selected_commit_type \
2651        -value new \
2652        -font font_ui
2653lappend disable_on_lock \
2654        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2655
2656.mbar.commit add radiobutton \
2657        -label {Amend Last Commit} \
2658        -command do_select_commit_type \
2659        -variable selected_commit_type \
2660        -value amend \
2661        -font font_ui
2662lappend disable_on_lock \
2663        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2664
2665.mbar.commit add separator
2666
2667.mbar.commit add command -label Rescan \
2668        -command do_rescan \
2669        -accelerator F5 \
2670        -font font_ui
2671lappend disable_on_lock \
2672        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2673
2674.mbar.commit add command -label {Remove From Commit} \
2675        -command do_remove_selection \
2676        -font font_ui
2677lappend disable_on_lock \
2678        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2679
2680.mbar.commit add command -label {Include In Commit} \
2681        -command do_include_selection \
2682        -font font_ui
2683lappend disable_on_lock \
2684        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2685
2686.mbar.commit add command -label {Include All} \
2687        -command do_include_all \
2688        -accelerator $M1T-I \
2689        -font font_ui
2690lappend disable_on_lock \
2691        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2692
2693.mbar.commit add separator
2694
2695.mbar.commit add command -label {Sign Off} \
2696        -command do_signoff \
2697        -accelerator $M1T-S \
2698        -font font_ui
2699
2700.mbar.commit add command -label Commit \
2701        -command do_commit \
2702        -accelerator $M1T-Return \
2703        -font font_ui
2704lappend disable_on_lock \
2705        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2706
2707# -- Transport menus
2708#
2709if {!$single_commit} {
2710        menu .mbar.fetch
2711        menu .mbar.pull
2712        menu .mbar.push
2713}
2714
2715# -- Main Window Layout
2716#
2717panedwindow .vpane -orient vertical
2718panedwindow .vpane.files -orient horizontal
2719.vpane add .vpane.files -sticky nsew -height 100 -width 400
2720pack .vpane -anchor n -side top -fill both -expand 1
2721
2722# -- Index File List
2723#
2724frame .vpane.files.index -height 100 -width 400
2725label .vpane.files.index.title -text {Modified Files} \
2726        -background green \
2727        -font font_ui
2728text $ui_index -background white -borderwidth 0 \
2729        -width 40 -height 10 \
2730        -font font_ui \
2731        -cursor $cursor_ptr \
2732        -yscrollcommand {.vpane.files.index.sb set} \
2733        -state disabled
2734scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2735pack .vpane.files.index.title -side top -fill x
2736pack .vpane.files.index.sb -side right -fill y
2737pack $ui_index -side left -fill both -expand 1
2738.vpane.files add .vpane.files.index -sticky nsew
2739
2740# -- Other (Add) File List
2741#
2742frame .vpane.files.other -height 100 -width 100
2743label .vpane.files.other.title -text {Untracked Files} \
2744        -background red \
2745        -font font_ui
2746text $ui_other -background white -borderwidth 0 \
2747        -width 40 -height 10 \
2748        -font font_ui \
2749        -cursor $cursor_ptr \
2750        -yscrollcommand {.vpane.files.other.sb set} \
2751        -state disabled
2752scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2753pack .vpane.files.other.title -side top -fill x
2754pack .vpane.files.other.sb -side right -fill y
2755pack $ui_other -side left -fill both -expand 1
2756.vpane.files add .vpane.files.other -sticky nsew
2757
2758foreach i [list $ui_index $ui_other] {
2759        $i tag conf in_diff -font font_uibold
2760        $i tag conf in_sel \
2761                -background [$i cget -foreground] \
2762                -foreground [$i cget -background]
2763}
2764unset i
2765
2766# -- Diff and Commit Area
2767#
2768frame .vpane.lower -height 300 -width 400
2769frame .vpane.lower.commarea
2770frame .vpane.lower.diff -relief sunken -borderwidth 1
2771pack .vpane.lower.commarea -side top -fill x
2772pack .vpane.lower.diff -side bottom -fill both -expand 1
2773.vpane add .vpane.lower -stick nsew
2774
2775# -- Commit Area Buttons
2776#
2777frame .vpane.lower.commarea.buttons
2778label .vpane.lower.commarea.buttons.l -text {} \
2779        -anchor w \
2780        -justify left \
2781        -font font_ui
2782pack .vpane.lower.commarea.buttons.l -side top -fill x
2783pack .vpane.lower.commarea.buttons -side left -fill y
2784
2785button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2786        -command do_rescan \
2787        -font font_ui
2788pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2789lappend disable_on_lock \
2790        {.vpane.lower.commarea.buttons.rescan conf -state}
2791
2792button .vpane.lower.commarea.buttons.incall -text {Include All} \
2793        -command do_include_all \
2794        -font font_ui
2795pack .vpane.lower.commarea.buttons.incall -side top -fill x
2796lappend disable_on_lock \
2797        {.vpane.lower.commarea.buttons.incall conf -state}
2798
2799button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2800        -command do_signoff \
2801        -font font_ui
2802pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2803
2804button .vpane.lower.commarea.buttons.commit -text {Commit} \
2805        -command do_commit \
2806        -font font_ui
2807pack .vpane.lower.commarea.buttons.commit -side top -fill x
2808lappend disable_on_lock \
2809        {.vpane.lower.commarea.buttons.commit conf -state}
2810
2811# -- Commit Message Buffer
2812#
2813frame .vpane.lower.commarea.buffer
2814frame .vpane.lower.commarea.buffer.header
2815set ui_comm .vpane.lower.commarea.buffer.t
2816set ui_coml .vpane.lower.commarea.buffer.header.l
2817radiobutton .vpane.lower.commarea.buffer.header.new \
2818        -text {New Commit} \
2819        -command do_select_commit_type \
2820        -variable selected_commit_type \
2821        -value new \
2822        -font font_ui
2823lappend disable_on_lock \
2824        [list .vpane.lower.commarea.buffer.header.new conf -state]
2825radiobutton .vpane.lower.commarea.buffer.header.amend \
2826        -text {Amend Last Commit} \
2827        -command do_select_commit_type \
2828        -variable selected_commit_type \
2829        -value amend \
2830        -font font_ui
2831lappend disable_on_lock \
2832        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2833label $ui_coml \
2834        -anchor w \
2835        -justify left \
2836        -font font_ui
2837proc trace_commit_type {varname args} {
2838        global ui_coml commit_type
2839        switch -glob -- $commit_type {
2840        initial       {set txt {Initial Commit Message:}}
2841        amend         {set txt {Amended Commit Message:}}
2842        amend-initial {set txt {Amended Initial Commit Message:}}
2843        merge         {set txt {Merge Commit Message:}}
2844        *             {set txt {Commit Message:}}
2845        }
2846        $ui_coml conf -text $txt
2847}
2848trace add variable commit_type write trace_commit_type
2849pack $ui_coml -side left -fill x
2850pack .vpane.lower.commarea.buffer.header.amend -side right
2851pack .vpane.lower.commarea.buffer.header.new -side right
2852
2853text $ui_comm -background white -borderwidth 1 \
2854        -undo true \
2855        -maxundo 20 \
2856        -autoseparators true \
2857        -relief sunken \
2858        -width 75 -height 9 -wrap none \
2859        -font font_diff \
2860        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2861scrollbar .vpane.lower.commarea.buffer.sby \
2862        -command [list $ui_comm yview]
2863pack .vpane.lower.commarea.buffer.header -side top -fill x
2864pack .vpane.lower.commarea.buffer.sby -side right -fill y
2865pack $ui_comm -side left -fill y
2866pack .vpane.lower.commarea.buffer -side left -fill y
2867
2868# -- Commit Message Buffer Context Menu
2869#
2870set ctxm .vpane.lower.commarea.buffer.ctxm
2871menu $ctxm -tearoff 0
2872$ctxm add command \
2873        -label {Cut} \
2874        -font font_ui \
2875        -command {tk_textCut $ui_comm}
2876$ctxm add command \
2877        -label {Copy} \
2878        -font font_ui \
2879        -command {tk_textCopy $ui_comm}
2880$ctxm add command \
2881        -label {Paste} \
2882        -font font_ui \
2883        -command {tk_textPaste $ui_comm}
2884$ctxm add command \
2885        -label {Delete} \
2886        -font font_ui \
2887        -command {$ui_comm delete sel.first sel.last}
2888$ctxm add separator
2889$ctxm add command \
2890        -label {Select All} \
2891        -font font_ui \
2892        -command {$ui_comm tag add sel 0.0 end}
2893$ctxm add command \
2894        -label {Copy All} \
2895        -font font_ui \
2896        -command {
2897                $ui_comm tag add sel 0.0 end
2898                tk_textCopy $ui_comm
2899                $ui_comm tag remove sel 0.0 end
2900        }
2901$ctxm add separator
2902$ctxm add command \
2903        -label {Sign Off} \
2904        -font font_ui \
2905        -command do_signoff
2906bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2907
2908# -- Diff Header
2909#
2910set current_diff {}
2911set diff_actions [list]
2912proc trace_current_diff {varname args} {
2913        global current_diff diff_actions file_states
2914        if {$current_diff eq {}} {
2915                set s {}
2916                set f {}
2917                set p {}
2918                set o disabled
2919        } else {
2920                set p $current_diff
2921                set s [mapdesc [lindex $file_states($p) 0] $p]
2922                set f {File:}
2923                set p [escape_path $p]
2924                set o normal
2925        }
2926
2927        .vpane.lower.diff.header.status configure -text $s
2928        .vpane.lower.diff.header.file configure -text $f
2929        .vpane.lower.diff.header.path configure -text $p
2930        foreach w $diff_actions {
2931                uplevel #0 $w $o
2932        }
2933}
2934trace add variable current_diff write trace_current_diff
2935
2936frame .vpane.lower.diff.header -background orange
2937label .vpane.lower.diff.header.status \
2938        -background orange \
2939        -width $max_status_desc \
2940        -anchor w \
2941        -justify left \
2942        -font font_ui
2943label .vpane.lower.diff.header.file \
2944        -background orange \
2945        -anchor w \
2946        -justify left \
2947        -font font_ui
2948label .vpane.lower.diff.header.path \
2949        -background orange \
2950        -anchor w \
2951        -justify left \
2952        -font font_ui
2953pack .vpane.lower.diff.header.status -side left
2954pack .vpane.lower.diff.header.file -side left
2955pack .vpane.lower.diff.header.path -fill x
2956set ctxm .vpane.lower.diff.header.ctxm
2957menu $ctxm -tearoff 0
2958$ctxm add command \
2959        -label {Copy} \
2960        -font font_ui \
2961        -command {
2962                clipboard clear
2963                clipboard append \
2964                        -format STRING \
2965                        -type STRING \
2966                        -- $current_diff
2967        }
2968lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2969bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2970
2971# -- Diff Body
2972#
2973frame .vpane.lower.diff.body
2974set ui_diff .vpane.lower.diff.body.t
2975text $ui_diff -background white -borderwidth 0 \
2976        -width 80 -height 15 -wrap none \
2977        -font font_diff \
2978        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2979        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2980        -state disabled
2981scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2982        -command [list $ui_diff xview]
2983scrollbar .vpane.lower.diff.body.sby -orient vertical \
2984        -command [list $ui_diff yview]
2985pack .vpane.lower.diff.body.sbx -side bottom -fill x
2986pack .vpane.lower.diff.body.sby -side right -fill y
2987pack $ui_diff -side left -fill both -expand 1
2988pack .vpane.lower.diff.header -side top -fill x
2989pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2990
2991$ui_diff tag conf d_@ -font font_diffbold
2992$ui_diff tag conf d_+  -foreground blue
2993$ui_diff tag conf d_-  -foreground red
2994$ui_diff tag conf d_++ -foreground {#00a000}
2995$ui_diff tag conf d_-- -foreground {#a000a0}
2996$ui_diff tag conf d_+- \
2997        -foreground red \
2998        -background {light goldenrod yellow}
2999$ui_diff tag conf d_-+ \
3000        -foreground blue \
3001        -background azure2
3002
3003# -- Diff Body Context Menu
3004#
3005set ctxm .vpane.lower.diff.body.ctxm
3006menu $ctxm -tearoff 0
3007$ctxm add command \
3008        -label {Copy} \
3009        -font font_ui \
3010        -command {tk_textCopy $ui_diff}
3011lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3012$ctxm add command \
3013        -label {Select All} \
3014        -font font_ui \
3015        -command {$ui_diff tag add sel 0.0 end}
3016lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3017$ctxm add command \
3018        -label {Copy All} \
3019        -font font_ui \
3020        -command {
3021                $ui_diff tag add sel 0.0 end
3022                tk_textCopy $ui_diff
3023                $ui_diff tag remove sel 0.0 end
3024        }
3025lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3026$ctxm add separator
3027$ctxm add command \
3028        -label {Decrease Font Size} \
3029        -font font_ui \
3030        -command {incr_font_size font_diff -1}
3031lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3032$ctxm add command \
3033        -label {Increase Font Size} \
3034        -font font_ui \
3035        -command {incr_font_size font_diff 1}
3036lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3037$ctxm add separator
3038$ctxm add command \
3039        -label {Show Less Context} \
3040        -font font_ui \
3041        -command {if {$repo_config(gui.diffcontext) >= 2} {
3042                incr repo_config(gui.diffcontext) -1
3043                reshow_diff
3044        }}
3045lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3046$ctxm add command \
3047        -label {Show More Context} \
3048        -font font_ui \
3049        -command {
3050                incr repo_config(gui.diffcontext)
3051                reshow_diff
3052        }
3053lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3054$ctxm add separator
3055$ctxm add command -label {Options...} \
3056        -font font_ui \
3057        -command do_options
3058bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3059
3060# -- Status Bar
3061#
3062set ui_status_value {Initializing...}
3063label .status -textvariable ui_status_value \
3064        -anchor w \
3065        -justify left \
3066        -borderwidth 1 \
3067        -relief sunken \
3068        -font font_ui
3069pack .status -anchor w -side bottom -fill x
3070
3071# -- Load geometry
3072#
3073catch {
3074set gm $repo_config(gui.geometry)
3075wm geometry . [lindex $gm 0]
3076.vpane sash place 0 \
3077        [lindex [.vpane sash coord 0] 0] \
3078        [lindex $gm 1]
3079.vpane.files sash place 0 \
3080        [lindex $gm 2] \
3081        [lindex [.vpane.files sash coord 0] 1]
3082unset gm
3083}
3084
3085# -- Key Bindings
3086#
3087bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3088bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3089bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3090bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3091bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3092bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3093bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3094bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3095bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3096bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3097bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3098
3099bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3100bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3101bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3102bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3103bind $ui_diff <$M1B-Key-v> {break}
3104bind $ui_diff <$M1B-Key-V> {break}
3105bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3106bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3107bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3108bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3109bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3110bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3111
3112bind .   <Destroy> do_quit
3113bind all <Key-F5> do_rescan
3114bind all <$M1B-Key-r> do_rescan
3115bind all <$M1B-Key-R> do_rescan
3116bind .   <$M1B-Key-s> do_signoff
3117bind .   <$M1B-Key-S> do_signoff
3118bind .   <$M1B-Key-i> do_include_all
3119bind .   <$M1B-Key-I> do_include_all
3120bind .   <$M1B-Key-Return> do_commit
3121bind all <$M1B-Key-q> do_quit
3122bind all <$M1B-Key-Q> do_quit
3123bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3124bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3125foreach i [list $ui_index $ui_other] {
3126        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3127        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3128        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3129}
3130unset i
3131
3132set file_lists($ui_index) [list]
3133set file_lists($ui_other) [list]
3134
3135set HEAD {}
3136set PARENT {}
3137set commit_type {}
3138set empty_tree {}
3139set current_diff {}
3140set selected_commit_type new
3141
3142wm title . "$appname ([file normalize [file dirname $gitdir]])"
3143focus -force $ui_comm
3144if {!$single_commit} {
3145        load_all_remotes
3146        populate_fetch_menu .mbar.fetch
3147        populate_pull_menu .mbar.pull
3148        populate_push_menu .mbar.push
3149}
3150lock_index begin-read
3151after 1 do_rescan