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