3f7e40835656bac8ac6eeab1af43d4ca74fdeec5
   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
1177
1178proc merge_state {path new_state {head_info {}} {index_info {}}} {
1179        global file_states next_icon_id
1180
1181        set s0 [string index $new_state 0]
1182        set s1 [string index $new_state 1]
1183
1184        if {[catch {set info $file_states($path)}]} {
1185                set state __
1186                set icon n[incr next_icon_id]
1187        } else {
1188                set state [lindex $info 0]
1189                set icon [lindex $info 1]
1190                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1191                if {$index_info eq {}} {set index_info [lindex $info 3]}
1192        }
1193
1194        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1195        elseif {$s0 eq {_}} {set s0 _}
1196
1197        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1198        elseif {$s1 eq {_}} {set s1 _}
1199
1200        if {$s0 ne {_} && [string index $state 0] eq {_}
1201                && $head_info eq {}} {
1202                set head_info $index_info
1203        }
1204
1205        set file_states($path) [list $s0$s1 $icon \
1206                $head_info $index_info \
1207                ]
1208        return $state
1209}
1210
1211proc display_file {path state} {
1212        global file_states file_lists selected_paths
1213
1214        set old_m [merge_state $path $state]
1215        set s $file_states($path)
1216        set new_m [lindex $s 0]
1217        set new_w [mapcol $new_m $path] 
1218        set old_w [mapcol $old_m $path]
1219        set new_icon [mapicon $new_m $path]
1220
1221        if {$new_w ne $old_w} {
1222                set lno [lsearch -sorted $file_lists($old_w) $path]
1223                if {$lno >= 0} {
1224                        incr lno
1225                        $old_w conf -state normal
1226                        $old_w delete $lno.0 [expr {$lno + 1}].0
1227                        $old_w conf -state disabled
1228                }
1229
1230                lappend file_lists($new_w) $path
1231                set file_lists($new_w) [lsort $file_lists($new_w)]
1232                set lno [lsearch -sorted $file_lists($new_w) $path]
1233                incr lno
1234                $new_w conf -state normal
1235                $new_w image create $lno.0 \
1236                        -align center -padx 5 -pady 1 \
1237                        -name [lindex $s 1] \
1238                        -image $new_icon
1239                $new_w insert $lno.1 "[escape_path $path]\n"
1240                if {[catch {set in_sel $selected_paths($path)}]} {
1241                        set in_sel 0
1242                }
1243                if {$in_sel} {
1244                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1245                }
1246                $new_w conf -state disabled
1247        } elseif {$new_icon ne [mapicon $old_m $path]} {
1248                $new_w conf -state normal
1249                $new_w image conf [lindex $s 1] -image $new_icon
1250                $new_w conf -state disabled
1251        }
1252}
1253
1254proc display_all_files {} {
1255        global ui_index ui_other
1256        global file_states file_lists
1257        global last_clicked selected_paths
1258
1259        $ui_index conf -state normal
1260        $ui_other conf -state normal
1261
1262        $ui_index delete 0.0 end
1263        $ui_other delete 0.0 end
1264        set last_clicked {}
1265
1266        set file_lists($ui_index) [list]
1267        set file_lists($ui_other) [list]
1268
1269        foreach path [lsort [array names file_states]] {
1270                set s $file_states($path)
1271                set m [lindex $s 0]
1272                set w [mapcol $m $path]
1273                lappend file_lists($w) $path
1274                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1275                $w image create end \
1276                        -align center -padx 5 -pady 1 \
1277                        -name [lindex $s 1] \
1278                        -image [mapicon $m $path]
1279                $w insert end "[escape_path $path]\n"
1280                if {[catch {set in_sel $selected_paths($path)}]} {
1281                        set in_sel 0
1282                }
1283                if {$in_sel} {
1284                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1285                }
1286        }
1287
1288        $ui_index conf -state disabled
1289        $ui_other conf -state disabled
1290}
1291
1292proc update_indexinfo {msg pathList after} {
1293        global update_index_cp ui_status_value
1294
1295        if {![lock_index update]} return
1296
1297        set update_index_cp 0
1298        set pathList [lsort $pathList]
1299        set totalCnt [llength $pathList]
1300        set batch [expr {int($totalCnt * .01) + 1}]
1301        if {$batch > 25} {set batch 25}
1302
1303        set ui_status_value [format \
1304                "$msg... %i/%i files (%.2f%%)" \
1305                $update_index_cp \
1306                $totalCnt \
1307                0.0]
1308        set fd [open "| git update-index -z --index-info" w]
1309        fconfigure $fd \
1310                -blocking 0 \
1311                -buffering full \
1312                -buffersize 512 \
1313                -translation binary
1314        fileevent $fd writable [list \
1315                write_update_indexinfo \
1316                $fd \
1317                $pathList \
1318                $totalCnt \
1319                $batch \
1320                $msg \
1321                $after \
1322                ]
1323}
1324
1325proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1326        global update_index_cp ui_status_value
1327        global file_states current_diff
1328
1329        if {$update_index_cp >= $totalCnt} {
1330                close $fd
1331                unlock_index
1332                uplevel #0 $after
1333                return
1334        }
1335
1336        for {set i $batch} \
1337                {$update_index_cp < $totalCnt && $i > 0} \
1338                {incr i -1} {
1339                set path [lindex $pathList $update_index_cp]
1340                incr update_index_cp
1341
1342                set s $file_states($path)
1343                switch -glob -- [lindex $s 0] {
1344                A? {set new _O}
1345                M? {set new _M}
1346                D? {set new _?}
1347                ?? {continue}
1348                }
1349                set info [lindex $s 2]
1350                if {$info eq {}} continue
1351
1352                puts -nonewline $fd $info
1353                puts -nonewline $fd "\t"
1354                puts -nonewline $fd $path
1355                puts -nonewline $fd "\0"
1356                display_file $path $new
1357        }
1358
1359        set ui_status_value [format \
1360                "$msg... %i/%i files (%.2f%%)" \
1361                $update_index_cp \
1362                $totalCnt \
1363                [expr {100.0 * $update_index_cp / $totalCnt}]]
1364}
1365
1366proc update_index {msg pathList after} {
1367        global update_index_cp ui_status_value
1368
1369        if {![lock_index update]} return
1370
1371        set update_index_cp 0
1372        set pathList [lsort $pathList]
1373        set totalCnt [llength $pathList]
1374        set batch [expr {int($totalCnt * .01) + 1}]
1375        if {$batch > 25} {set batch 25}
1376
1377        set ui_status_value [format \
1378                "$msg... %i/%i files (%.2f%%)" \
1379                $update_index_cp \
1380                $totalCnt \
1381                0.0]
1382        set fd [open "| git update-index --add --remove -z --stdin" w]
1383        fconfigure $fd \
1384                -blocking 0 \
1385                -buffering full \
1386                -buffersize 512 \
1387                -translation binary
1388        fileevent $fd writable [list \
1389                write_update_index \
1390                $fd \
1391                $pathList \
1392                $totalCnt \
1393                $batch \
1394                $msg \
1395                $after \
1396                ]
1397}
1398
1399proc write_update_index {fd pathList totalCnt batch msg after} {
1400        global update_index_cp ui_status_value
1401        global file_states current_diff
1402
1403        if {$update_index_cp >= $totalCnt} {
1404                close $fd
1405                unlock_index
1406                uplevel #0 $after
1407                return
1408        }
1409
1410        for {set i $batch} \
1411                {$update_index_cp < $totalCnt && $i > 0} \
1412                {incr i -1} {
1413                set path [lindex $pathList $update_index_cp]
1414                incr update_index_cp
1415
1416                switch -glob -- [lindex $file_states($path) 0] {
1417                AD -
1418                MD -
1419                _D {set new DD}
1420
1421                _M -
1422                MM -
1423                M_ {set new M_}
1424
1425                _O -
1426                AM -
1427                A_ {set new A_}
1428
1429                ?? {continue}
1430                }
1431
1432                puts -nonewline $fd $path
1433                puts -nonewline $fd "\0"
1434                display_file $path $new
1435        }
1436
1437        set ui_status_value [format \
1438                "$msg... %i/%i files (%.2f%%)" \
1439                $update_index_cp \
1440                $totalCnt \
1441                [expr {100.0 * $update_index_cp / $totalCnt}]]
1442}
1443
1444######################################################################
1445##
1446## remote management
1447
1448proc load_all_remotes {} {
1449        global gitdir all_remotes repo_config
1450
1451        set all_remotes [list]
1452        set rm_dir [file join $gitdir remotes]
1453        if {[file isdirectory $rm_dir]} {
1454                set all_remotes [concat $all_remotes [glob \
1455                        -types f \
1456                        -tails \
1457                        -nocomplain \
1458                        -directory $rm_dir *]]
1459        }
1460
1461        foreach line [array names repo_config remote.*.url] {
1462                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1463                        lappend all_remotes $name
1464                }
1465        }
1466
1467        set all_remotes [lsort -unique $all_remotes]
1468}
1469
1470proc populate_fetch_menu {m} {
1471        global gitdir all_remotes repo_config
1472
1473        foreach r $all_remotes {
1474                set enable 0
1475                if {![catch {set a $repo_config(remote.$r.url)}]} {
1476                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1477                                set enable 1
1478                        }
1479                } else {
1480                        catch {
1481                                set fd [open [file join $gitdir remotes $r] r]
1482                                while {[gets $fd n] >= 0} {
1483                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1484                                                set enable 1
1485                                                break
1486                                        }
1487                                }
1488                                close $fd
1489                        }
1490                }
1491
1492                if {$enable} {
1493                        $m add command \
1494                                -label "Fetch from $r..." \
1495                                -command [list fetch_from $r] \
1496                                -font font_ui
1497                }
1498        }
1499}
1500
1501proc populate_push_menu {m} {
1502        global gitdir all_remotes repo_config
1503
1504        foreach r $all_remotes {
1505                set enable 0
1506                if {![catch {set a $repo_config(remote.$r.url)}]} {
1507                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1508                                set enable 1
1509                        }
1510                } else {
1511                        catch {
1512                                set fd [open [file join $gitdir remotes $r] r]
1513                                while {[gets $fd n] >= 0} {
1514                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1515                                                set enable 1
1516                                                break
1517                                        }
1518                                }
1519                                close $fd
1520                        }
1521                }
1522
1523                if {$enable} {
1524                        $m add command \
1525                                -label "Push to $r..." \
1526                                -command [list push_to $r] \
1527                                -font font_ui
1528                }
1529        }
1530}
1531
1532proc populate_pull_menu {m} {
1533        global gitdir repo_config all_remotes disable_on_lock
1534
1535        foreach remote $all_remotes {
1536                set rb {}
1537                if {[array get repo_config remote.$remote.url] ne {}} {
1538                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1539                                regexp {^([^:]+):} \
1540                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1541                                        line rb
1542                        }
1543                } else {
1544                        catch {
1545                                set fd [open [file join $gitdir remotes $remote] r]
1546                                while {[gets $fd line] >= 0} {
1547                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1548                                                break
1549                                        }
1550                                }
1551                                close $fd
1552                        }
1553                }
1554
1555                set rb_short $rb
1556                regsub ^refs/heads/ $rb {} rb_short
1557                if {$rb_short ne {}} {
1558                        $m add command \
1559                                -label "Branch $rb_short from $remote..." \
1560                                -command [list pull_remote $remote $rb] \
1561                                -font font_ui
1562                        lappend disable_on_lock \
1563                                [list $m entryconf [$m index last] -state]
1564                }
1565        }
1566}
1567
1568######################################################################
1569##
1570## icons
1571
1572set filemask {
1573#define mask_width 14
1574#define mask_height 15
1575static unsigned char mask_bits[] = {
1576   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1577   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1578   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1579}
1580
1581image create bitmap file_plain -background white -foreground black -data {
1582#define plain_width 14
1583#define plain_height 15
1584static unsigned char plain_bits[] = {
1585   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1586   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1587   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1588} -maskdata $filemask
1589
1590image create bitmap file_mod -background white -foreground blue -data {
1591#define mod_width 14
1592#define mod_height 15
1593static unsigned char mod_bits[] = {
1594   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1595   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1596   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1597} -maskdata $filemask
1598
1599image create bitmap file_fulltick -background white -foreground "#007000" -data {
1600#define file_fulltick_width 14
1601#define file_fulltick_height 15
1602static unsigned char file_fulltick_bits[] = {
1603   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1604   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1605   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1606} -maskdata $filemask
1607
1608image create bitmap file_parttick -background white -foreground "#005050" -data {
1609#define parttick_width 14
1610#define parttick_height 15
1611static unsigned char parttick_bits[] = {
1612   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1613   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1614   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1615} -maskdata $filemask
1616
1617image create bitmap file_question -background white -foreground black -data {
1618#define file_question_width 14
1619#define file_question_height 15
1620static unsigned char file_question_bits[] = {
1621   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1622   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1623   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1624} -maskdata $filemask
1625
1626image create bitmap file_removed -background white -foreground red -data {
1627#define file_removed_width 14
1628#define file_removed_height 15
1629static unsigned char file_removed_bits[] = {
1630   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1631   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1632   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1633} -maskdata $filemask
1634
1635image create bitmap file_merge -background white -foreground blue -data {
1636#define file_merge_width 14
1637#define file_merge_height 15
1638static unsigned char file_merge_bits[] = {
1639   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1640   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1641   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1642} -maskdata $filemask
1643
1644set ui_index .vpane.files.index.list
1645set ui_other .vpane.files.other.list
1646set max_status_desc 0
1647foreach i {
1648                {__ i plain    "Unmodified"}
1649                {_M i mod      "Modified"}
1650                {M_ i fulltick "Included in commit"}
1651                {MM i parttick "Partially included"}
1652
1653                {_O o plain    "Untracked"}
1654                {A_ o fulltick "Added by commit"}
1655                {AM o parttick "Partially added"}
1656                {AD o question "Added (but now gone)"}
1657
1658                {_D i question "Missing"}
1659                {D_ i removed  "Removed by commit"}
1660                {DD i removed  "Removed by commit"}
1661                {DO i removed  "Removed (still exists)"}
1662
1663                {UM i merge    "Merge conflicts"}
1664                {U_ i merge    "Merge conflicts"}
1665        } {
1666        if {$max_status_desc < [string length [lindex $i 3]]} {
1667                set max_status_desc [string length [lindex $i 3]]
1668        }
1669        if {[lindex $i 1] eq {i}} {
1670                set all_cols([lindex $i 0]) $ui_index
1671        } else {
1672                set all_cols([lindex $i 0]) $ui_other
1673        }
1674        set all_icons([lindex $i 0]) file_[lindex $i 2]
1675        set all_descs([lindex $i 0]) [lindex $i 3]
1676}
1677unset filemask i
1678
1679######################################################################
1680##
1681## util
1682
1683proc is_MacOSX {} {
1684        global tcl_platform tk_library
1685        if {$tcl_platform(platform) eq {unix}
1686                && $tcl_platform(os) eq {Darwin}
1687                && [string match /Library/Frameworks/* $tk_library]} {
1688                return 1
1689        }
1690        return 0
1691}
1692
1693proc bind_button3 {w cmd} {
1694        bind $w <Any-Button-3> $cmd
1695        if {[is_MacOSX]} {
1696                bind $w <Control-Button-1> $cmd
1697        }
1698}
1699
1700proc incr_font_size {font {amt 1}} {
1701        set sz [font configure $font -size]
1702        incr sz $amt
1703        font configure $font -size $sz
1704        font configure ${font}bold -size $sz
1705}
1706
1707proc hook_failed_popup {hook msg} {
1708        global gitdir appname
1709
1710        set w .hookfail
1711        toplevel $w
1712
1713        frame $w.m
1714        label $w.m.l1 -text "$hook hook failed:" \
1715                -anchor w \
1716                -justify left \
1717                -font font_uibold
1718        text $w.m.t \
1719                -background white -borderwidth 1 \
1720                -relief sunken \
1721                -width 80 -height 10 \
1722                -font font_diff \
1723                -yscrollcommand [list $w.m.sby set]
1724        label $w.m.l2 \
1725                -text {You must correct the above errors before committing.} \
1726                -anchor w \
1727                -justify left \
1728                -font font_uibold
1729        scrollbar $w.m.sby -command [list $w.m.t yview]
1730        pack $w.m.l1 -side top -fill x
1731        pack $w.m.l2 -side bottom -fill x
1732        pack $w.m.sby -side right -fill y
1733        pack $w.m.t -side left -fill both -expand 1
1734        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1735
1736        $w.m.t insert 1.0 $msg
1737        $w.m.t conf -state disabled
1738
1739        button $w.ok -text OK \
1740                -width 15 \
1741                -font font_ui \
1742                -command "destroy $w"
1743        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1744
1745        bind $w <Visibility> "grab $w; focus $w"
1746        bind $w <Key-Return> "destroy $w"
1747        wm title $w "$appname ([lindex [file split \
1748                [file normalize [file dirname $gitdir]]] \
1749                end]): error"
1750        tkwait window $w
1751}
1752
1753set next_console_id 0
1754
1755proc new_console {short_title long_title} {
1756        global next_console_id console_data
1757        set w .console[incr next_console_id]
1758        set console_data($w) [list $short_title $long_title]
1759        return [console_init $w]
1760}
1761
1762proc console_init {w} {
1763        global console_cr console_data
1764        global gitdir appname M1B
1765
1766        set console_cr($w) 1.0
1767        toplevel $w
1768        frame $w.m
1769        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1770                -anchor w \
1771                -justify left \
1772                -font font_uibold
1773        text $w.m.t \
1774                -background white -borderwidth 1 \
1775                -relief sunken \
1776                -width 80 -height 10 \
1777                -font font_diff \
1778                -state disabled \
1779                -yscrollcommand [list $w.m.sby set]
1780        label $w.m.s -text {Working... please wait...} \
1781                -anchor w \
1782                -justify left \
1783                -font font_uibold
1784        scrollbar $w.m.sby -command [list $w.m.t yview]
1785        pack $w.m.l1 -side top -fill x
1786        pack $w.m.s -side bottom -fill x
1787        pack $w.m.sby -side right -fill y
1788        pack $w.m.t -side left -fill both -expand 1
1789        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1790
1791        menu $w.ctxm -tearoff 0
1792        $w.ctxm add command -label "Copy" \
1793                -font font_ui \
1794                -command "tk_textCopy $w.m.t"
1795        $w.ctxm add command -label "Select All" \
1796                -font font_ui \
1797                -command "$w.m.t tag add sel 0.0 end"
1798        $w.ctxm add command -label "Copy All" \
1799                -font font_ui \
1800                -command "
1801                        $w.m.t tag add sel 0.0 end
1802                        tk_textCopy $w.m.t
1803                        $w.m.t tag remove sel 0.0 end
1804                "
1805
1806        button $w.ok -text {Close} \
1807                -font font_ui \
1808                -state disabled \
1809                -command "destroy $w"
1810        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1811
1812        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1813        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1814        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1815        bind $w <Visibility> "focus $w"
1816        wm title $w "$appname ([lindex [file split \
1817                [file normalize [file dirname $gitdir]]] \
1818                end]): [lindex $console_data($w) 0]"
1819        return $w
1820}
1821
1822proc console_exec {w cmd {after {}}} {
1823        global tcl_platform
1824
1825        # -- Windows tosses the enviroment when we exec our child.
1826        #    But most users need that so we have to relogin. :-(
1827        #
1828        if {$tcl_platform(platform) eq {windows}} {
1829                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1830        }
1831
1832        # -- Tcl won't let us redirect both stdout and stderr to
1833        #    the same pipe.  So pass it through cat...
1834        #
1835        set cmd [concat | $cmd |& cat]
1836
1837        set fd_f [open $cmd r]
1838        fconfigure $fd_f -blocking 0 -translation binary
1839        fileevent $fd_f readable [list console_read $w $fd_f $after]
1840}
1841
1842proc console_read {w fd after} {
1843        global console_cr console_data
1844
1845        set buf [read $fd]
1846        if {$buf ne {}} {
1847                if {![winfo exists $w]} {console_init $w}
1848                $w.m.t conf -state normal
1849                set c 0
1850                set n [string length $buf]
1851                while {$c < $n} {
1852                        set cr [string first "\r" $buf $c]
1853                        set lf [string first "\n" $buf $c]
1854                        if {$cr < 0} {set cr [expr {$n + 1}]}
1855                        if {$lf < 0} {set lf [expr {$n + 1}]}
1856
1857                        if {$lf < $cr} {
1858                                $w.m.t insert end [string range $buf $c $lf]
1859                                set console_cr($w) [$w.m.t index {end -1c}]
1860                                set c $lf
1861                                incr c
1862                        } else {
1863                                $w.m.t delete $console_cr($w) end
1864                                $w.m.t insert end "\n"
1865                                $w.m.t insert end [string range $buf $c $cr]
1866                                set c $cr
1867                                incr c
1868                        }
1869                }
1870                $w.m.t conf -state disabled
1871                $w.m.t see end
1872        }
1873
1874        fconfigure $fd -blocking 1
1875        if {[eof $fd]} {
1876                if {[catch {close $fd}]} {
1877                        if {![winfo exists $w]} {console_init $w}
1878                        $w.m.s conf -background red -text {Error: Command Failed}
1879                        $w.ok conf -state normal
1880                        set ok 0
1881                } elseif {[winfo exists $w]} {
1882                        $w.m.s conf -background green -text {Success}
1883                        $w.ok conf -state normal
1884                        set ok 1
1885                }
1886                array unset console_cr $w
1887                array unset console_data $w
1888                if {$after ne {}} {
1889                        uplevel #0 $after $ok
1890                }
1891                return
1892        }
1893        fconfigure $fd -blocking 0
1894}
1895
1896######################################################################
1897##
1898## ui commands
1899
1900set starting_gitk_msg {Please wait... Starting gitk...}
1901
1902proc do_gitk {} {
1903        global tcl_platform ui_status_value starting_gitk_msg
1904
1905        set ui_status_value $starting_gitk_msg
1906        after 10000 {
1907                if {$ui_status_value eq $starting_gitk_msg} {
1908                        set ui_status_value {Ready.}
1909                }
1910        }
1911
1912        if {$tcl_platform(platform) eq {windows}} {
1913                exec sh -c gitk &
1914        } else {
1915                exec gitk &
1916        }
1917}
1918
1919proc do_repack {} {
1920        set w [new_console "repack" "Repacking the object database"]
1921        set cmd [list git repack]
1922        lappend cmd -a
1923        lappend cmd -d
1924        console_exec $w $cmd
1925}
1926
1927set is_quitting 0
1928
1929proc do_quit {} {
1930        global gitdir ui_comm is_quitting repo_config
1931
1932        if {$is_quitting} return
1933        set is_quitting 1
1934
1935        # -- Stash our current commit buffer.
1936        #
1937        set save [file join $gitdir GITGUI_MSG]
1938        set msg [string trim [$ui_comm get 0.0 end]]
1939        if {[$ui_comm edit modified] && $msg ne {}} {
1940                catch {
1941                        set fd [open $save w]
1942                        puts $fd [string trim [$ui_comm get 0.0 end]]
1943                        close $fd
1944                }
1945        } elseif {$msg eq {} && [file exists $save]} {
1946                file delete $save
1947        }
1948
1949        # -- Stash our current window geometry into this repository.
1950        #
1951        set cfg_geometry [list]
1952        lappend cfg_geometry [wm geometry .]
1953        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1954        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1955        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1956                set rc_geometry {}
1957        }
1958        if {$cfg_geometry ne $rc_geometry} {
1959                catch {exec git repo-config gui.geometry $cfg_geometry}
1960        }
1961
1962        destroy .
1963}
1964
1965proc do_rescan {} {
1966        rescan {set ui_status_value {Ready.}}
1967}
1968
1969proc remove_helper {txt paths} {
1970        global file_states current_diff
1971
1972        if {![lock_index begin-update]} return
1973
1974        set pathList [list]
1975        set after {}
1976        foreach path $paths {
1977                switch -glob -- [lindex $file_states($path) 0] {
1978                A? -
1979                M? -
1980                D? {
1981                        lappend pathList $path
1982                        if {$path eq $current_diff} {
1983                                set after {reshow_diff;}
1984                        }
1985                }
1986                }
1987        }
1988        if {$pathList eq {}} {
1989                unlock_index
1990        } else {
1991                update_indexinfo \
1992                        $txt \
1993                        $pathList \
1994                        [concat $after {set ui_status_value {Ready.}}]
1995        }
1996}
1997
1998proc do_remove_selection {} {
1999        global current_diff selected_paths
2000
2001        if {[array size selected_paths] > 0} {
2002                remove_helper \
2003                        {Removing selected files from commit} \
2004                        [array names selected_paths]
2005        } elseif {$current_diff ne {}} {
2006                remove_helper \
2007                        "Removing [short_path $current_diff] from commit" \
2008                        [list $current_diff]
2009        }
2010}
2011
2012proc include_helper {txt paths} {
2013        global file_states current_diff
2014
2015        if {![lock_index begin-update]} return
2016
2017        set pathList [list]
2018        set after {}
2019        foreach path $paths {
2020                switch -- [lindex $file_states($path) 0] {
2021                AM -
2022                AD -
2023                MM -
2024                UM -
2025                U_ -
2026                _M -
2027                _D -
2028                _O {
2029                        lappend pathList $path
2030                        if {$path eq $current_diff} {
2031                                set after {reshow_diff;}
2032                        }
2033                }
2034                }
2035        }
2036        if {$pathList eq {}} {
2037                unlock_index
2038        } else {
2039                update_index \
2040                        $txt \
2041                        $pathList \
2042                        [concat $after {set ui_status_value {Ready to commit.}}]
2043        }
2044}
2045
2046proc do_include_selection {} {
2047        global current_diff selected_paths
2048
2049        if {[array size selected_paths] > 0} {
2050                include_helper \
2051                        {Including selected files} \
2052                        [array names selected_paths]
2053        } elseif {$current_diff ne {}} {
2054                include_helper \
2055                        "Including [short_path $current_diff]" \
2056                        [list $current_diff]
2057        }
2058}
2059
2060proc do_include_all {} {
2061        global file_states
2062
2063        set paths [list]
2064        foreach path [array names file_states] {
2065                switch -- [lindex $file_states($path) 0] {
2066                AM -
2067                AD -
2068                MM -
2069                _M -
2070                _D {lappend paths $path}
2071                }
2072        }
2073        include_helper \
2074                {Including all modified files} \
2075                $paths
2076}
2077
2078proc do_signoff {} {
2079        global ui_comm
2080
2081        set me [committer_ident]
2082        if {$me eq {}} return
2083
2084        set sob "Signed-off-by: $me"
2085        set last [$ui_comm get {end -1c linestart} {end -1c}]
2086        if {$last ne $sob} {
2087                $ui_comm edit separator
2088                if {$last ne {}
2089                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2090                        $ui_comm insert end "\n"
2091                }
2092                $ui_comm insert end "\n$sob"
2093                $ui_comm edit separator
2094                $ui_comm see end
2095        }
2096}
2097
2098proc do_select_commit_type {} {
2099        global commit_type selected_commit_type
2100
2101        if {$selected_commit_type eq {new}
2102                && [string match amend* $commit_type]} {
2103                create_new_commit
2104        } elseif {$selected_commit_type eq {amend}
2105                && ![string match amend* $commit_type]} {
2106                load_last_commit
2107
2108                # The amend request was rejected...
2109                #
2110                if {![string match amend* $commit_type]} {
2111                        set selected_commit_type new
2112                }
2113        }
2114}
2115
2116proc do_commit {} {
2117        commit_tree
2118}
2119
2120proc do_options {} {
2121        global appname gitdir font_descs
2122        global repo_config global_config
2123        global repo_config_new global_config_new
2124
2125        array unset repo_config_new
2126        array unset global_config_new
2127        foreach name [array names repo_config] {
2128                set repo_config_new($name) $repo_config($name)
2129        }
2130        load_config 1
2131        foreach name [array names repo_config] {
2132                switch -- $name {
2133                gui.diffcontext {continue}
2134                }
2135                set repo_config_new($name) $repo_config($name)
2136        }
2137        foreach name [array names global_config] {
2138                set global_config_new($name) $global_config($name)
2139        }
2140        set reponame [lindex [file split \
2141                [file normalize [file dirname $gitdir]]] \
2142                end]
2143
2144        set w .options_editor
2145        toplevel $w
2146        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2147
2148        label $w.header -text "$appname Options" \
2149                -font font_uibold
2150        pack $w.header -side top -fill x
2151
2152        frame $w.buttons
2153        button $w.buttons.restore -text {Restore Defaults} \
2154                -font font_ui \
2155                -command do_restore_defaults
2156        pack $w.buttons.restore -side left
2157        button $w.buttons.save -text Save \
2158                -font font_ui \
2159                -command [list do_save_config $w]
2160        pack $w.buttons.save -side right
2161        button $w.buttons.cancel -text {Cancel} \
2162                -font font_ui \
2163                -command [list destroy $w]
2164        pack $w.buttons.cancel -side right
2165        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2166
2167        labelframe $w.repo -text "$reponame Repository" \
2168                -font font_ui \
2169                -relief raised -borderwidth 2
2170        labelframe $w.global -text {Global (All Repositories)} \
2171                -font font_ui \
2172                -relief raised -borderwidth 2
2173        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2174        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2175
2176        foreach option {
2177                {b partialinclude {Allow Partially Included Files}}
2178                {b pullsummary {Show Pull Summary}}
2179                {b trustmtime  {Trust File Modification Timestamps}}
2180                {i diffcontext {Number of Diff Context Lines}}
2181                } {
2182                set type [lindex $option 0]
2183                set name [lindex $option 1]
2184                set text [lindex $option 2]
2185                foreach f {repo global} {
2186                        switch $type {
2187                        b {
2188                                checkbutton $w.$f.$name -text $text \
2189                                        -variable ${f}_config_new(gui.$name) \
2190                                        -onvalue true \
2191                                        -offvalue false \
2192                                        -font font_ui
2193                                pack $w.$f.$name -side top -anchor w
2194                        }
2195                        i {
2196                                frame $w.$f.$name
2197                                label $w.$f.$name.l -text "$text:" -font font_ui
2198                                pack $w.$f.$name.l -side left -anchor w -fill x
2199                                spinbox $w.$f.$name.v \
2200                                        -textvariable ${f}_config_new(gui.$name) \
2201                                        -from 1 -to 99 -increment 1 \
2202                                        -width 3 \
2203                                        -font font_ui
2204                                pack $w.$f.$name.v -side right -anchor e
2205                                pack $w.$f.$name -side top -anchor w -fill x
2206                        }
2207                        }
2208                }
2209        }
2210
2211        set all_fonts [lsort [font families]]
2212        foreach option $font_descs {
2213                set name [lindex $option 0]
2214                set font [lindex $option 1]
2215                set text [lindex $option 2]
2216
2217                set global_config_new(gui.$font^^family) \
2218                        [font configure $font -family]
2219                set global_config_new(gui.$font^^size) \
2220                        [font configure $font -size]
2221
2222                frame $w.global.$name
2223                label $w.global.$name.l -text "$text:" -font font_ui
2224                pack $w.global.$name.l -side left -anchor w -fill x
2225                eval tk_optionMenu $w.global.$name.family \
2226                        global_config_new(gui.$font^^family) \
2227                        $all_fonts
2228                spinbox $w.global.$name.size \
2229                        -textvariable global_config_new(gui.$font^^size) \
2230                        -from 2 -to 80 -increment 1 \
2231                        -width 3 \
2232                        -font font_ui
2233                pack $w.global.$name.size -side right -anchor e
2234                pack $w.global.$name.family -side right -anchor e
2235                pack $w.global.$name -side top -anchor w -fill x
2236        }
2237
2238        bind $w <Visibility> "grab $w; focus $w"
2239        bind $w <Key-Escape> "destroy $w"
2240        wm title $w "$appname ($reponame): Options"
2241        tkwait window $w
2242}
2243
2244proc do_restore_defaults {} {
2245        global font_descs default_config repo_config
2246        global repo_config_new global_config_new
2247
2248        foreach name [array names default_config] {
2249                set repo_config_new($name) $default_config($name)
2250                set global_config_new($name) $default_config($name)
2251        }
2252
2253        foreach option $font_descs {
2254                set name [lindex $option 0]
2255                set repo_config(gui.$name) $default_config(gui.$name)
2256        }
2257        apply_config
2258
2259        foreach option $font_descs {
2260                set name [lindex $option 0]
2261                set font [lindex $option 1]
2262                set global_config_new(gui.$font^^family) \
2263                        [font configure $font -family]
2264                set global_config_new(gui.$font^^size) \
2265                        [font configure $font -size]
2266        }
2267}
2268
2269proc do_save_config {w} {
2270        if {[catch {save_config} err]} {
2271                error_popup "Failed to completely save options:\n\n$err"
2272        }
2273        reshow_diff
2274        destroy $w
2275}
2276
2277proc do_windows_shortcut {} {
2278        global gitdir appname argv0
2279
2280        set reponame [lindex [file split \
2281                [file normalize [file dirname $gitdir]]] \
2282                end]
2283
2284        if {[catch {
2285                set desktop [exec cygpath \
2286                        --windows \
2287                        --absolute \
2288                        --long-name \
2289                        --desktop]
2290                }]} {
2291                        set desktop .
2292        }
2293        set fn [tk_getSaveFile \
2294                -parent . \
2295                -title "$appname ($reponame): Create Desktop Icon" \
2296                -initialdir $desktop \
2297                -initialfile "Git $reponame.bat"]
2298        if {$fn != {}} {
2299                if {[catch {
2300                                set fd [open $fn w]
2301                                set sh [exec cygpath \
2302                                        --windows \
2303                                        --absolute \
2304                                        --long-name \
2305                                        /bin/sh]
2306                                set me [exec cygpath \
2307                                        --unix \
2308                                        --absolute \
2309                                        $argv0]
2310                                set gd [exec cygpath \
2311                                        --unix \
2312                                        --absolute \
2313                                        $gitdir]
2314                                regsub -all ' $me "'\\''" me
2315                                regsub -all ' $gd "'\\''" gd
2316                                puts -nonewline $fd "\"$sh\" --login -c \""
2317                                puts -nonewline $fd "GIT_DIR='$gd'"
2318                                puts -nonewline $fd " '$me'"
2319                                puts $fd "&\""
2320                                close $fd
2321                        } err]} {
2322                        error_popup "Cannot write script:\n\n$err"
2323                }
2324        }
2325}
2326
2327proc do_macosx_app {} {
2328        global gitdir appname argv0 env
2329
2330        set reponame [lindex [file split \
2331                [file normalize [file dirname $gitdir]]] \
2332                end]
2333
2334        set fn [tk_getSaveFile \
2335                -parent . \
2336                -title "$appname ($reponame): Create Desktop Icon" \
2337                -initialdir [file join $env(HOME) Desktop] \
2338                -initialfile "Git $reponame.app"]
2339        if {$fn != {}} {
2340                if {[catch {
2341                                set Contents [file join $fn Contents]
2342                                set MacOS [file join $Contents MacOS]
2343                                set exe [file join $MacOS git-gui]
2344
2345                                file mkdir $MacOS
2346
2347                                set fd [open [file join $Contents Info.plist] w]
2348                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2349<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2350<plist version="1.0">
2351<dict>
2352        <key>CFBundleDevelopmentRegion</key>
2353        <string>English</string>
2354        <key>CFBundleExecutable</key>
2355        <string>git-gui</string>
2356        <key>CFBundleIdentifier</key>
2357        <string>org.spearce.git-gui</string>
2358        <key>CFBundleInfoDictionaryVersion</key>
2359        <string>6.0</string>
2360        <key>CFBundlePackageType</key>
2361        <string>APPL</string>
2362        <key>CFBundleSignature</key>
2363        <string>????</string>
2364        <key>CFBundleVersion</key>
2365        <string>1.0</string>
2366        <key>NSPrincipalClass</key>
2367        <string>NSApplication</string>
2368</dict>
2369</plist>}
2370                                close $fd
2371
2372                                set fd [open $exe w]
2373                                set gd [file normalize $gitdir]
2374                                set ep [file normalize [exec git --exec-path]]
2375                                regsub -all ' $gd "'\\''" gd
2376                                regsub -all ' $ep "'\\''" ep
2377                                puts $fd "#!/bin/sh"
2378                                foreach name [array names env] {
2379                                        if {[string match GIT_* $name]} {
2380                                                regsub -all ' $env($name) "'\\''" v
2381                                                puts $fd "export $name='$v'"
2382                                        }
2383                                }
2384                                puts $fd "export PATH='$ep':\$PATH"
2385                                puts $fd "export GIT_DIR='$gd'"
2386                                puts $fd "exec [file normalize $argv0]"
2387                                close $fd
2388
2389                                file attributes $exe -permissions u+x,g+x,o+x
2390                        } err]} {
2391                        error_popup "Cannot write icon:\n\n$err"
2392                }
2393        }
2394}
2395
2396proc toggle_or_diff {w x y} {
2397        global file_states file_lists current_diff ui_index ui_other
2398        global last_clicked selected_paths
2399
2400        set pos [split [$w index @$x,$y] .]
2401        set lno [lindex $pos 0]
2402        set col [lindex $pos 1]
2403        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2404        if {$path eq {}} {
2405                set last_clicked {}
2406                return
2407        }
2408
2409        set last_clicked [list $w $lno]
2410        array unset selected_paths
2411        $ui_index tag remove in_sel 0.0 end
2412        $ui_other tag remove in_sel 0.0 end
2413
2414        if {$col == 0} {
2415                if {$current_diff eq $path} {
2416                        set after {reshow_diff;}
2417                } else {
2418                        set after {}
2419                }
2420                switch -glob -- [lindex $file_states($path) 0] {
2421                A_ -
2422                AO -
2423                M_ -
2424                DD -
2425                D_ {
2426                        update_indexinfo \
2427                                "Removing [short_path $path] from commit" \
2428                                [list $path] \
2429                                [concat $after {set ui_status_value {Ready.}}]
2430                }
2431                ?? {
2432                        update_index \
2433                                "Including [short_path $path]" \
2434                                [list $path] \
2435                                [concat $after {set ui_status_value {Ready.}}]
2436                }
2437                }
2438        } else {
2439                show_diff $path $w $lno
2440        }
2441}
2442
2443proc add_one_to_selection {w x y} {
2444        global file_lists
2445        global last_clicked selected_paths
2446
2447        set pos [split [$w index @$x,$y] .]
2448        set lno [lindex $pos 0]
2449        set col [lindex $pos 1]
2450        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2451        if {$path eq {}} {
2452                set last_clicked {}
2453                return
2454        }
2455
2456        set last_clicked [list $w $lno]
2457        if {[catch {set in_sel $selected_paths($path)}]} {
2458                set in_sel 0
2459        }
2460        if {$in_sel} {
2461                unset selected_paths($path)
2462                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2463        } else {
2464                set selected_paths($path) 1
2465                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2466        }
2467}
2468
2469proc add_range_to_selection {w x y} {
2470        global file_lists
2471        global last_clicked selected_paths
2472
2473        if {[lindex $last_clicked 0] ne $w} {
2474                toggle_or_diff $w $x $y
2475                return
2476        }
2477
2478        set pos [split [$w index @$x,$y] .]
2479        set lno [lindex $pos 0]
2480        set lc [lindex $last_clicked 1]
2481        if {$lc < $lno} {
2482                set begin $lc
2483                set end $lno
2484        } else {
2485                set begin $lno
2486                set end $lc
2487        }
2488
2489        foreach path [lrange $file_lists($w) \
2490                [expr {$begin - 1}] \
2491                [expr {$end - 1}]] {
2492                set selected_paths($path) 1
2493        }
2494        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2495}
2496
2497######################################################################
2498##
2499## config defaults
2500
2501set cursor_ptr arrow
2502font create font_diff -family Courier -size 10
2503font create font_ui
2504catch {
2505        label .dummy
2506        eval font configure font_ui [font actual [.dummy cget -font]]
2507        destroy .dummy
2508}
2509
2510font create font_uibold
2511font create font_diffbold
2512
2513set M1B M1
2514set M1T M1
2515if {$tcl_platform(platform) eq {windows}} {
2516        set M1B Control
2517        set M1T Ctrl
2518} elseif {[is_MacOSX]} {
2519        set M1B M1
2520        set M1T Cmd
2521}
2522
2523proc apply_config {} {
2524        global repo_config font_descs
2525
2526        foreach option $font_descs {
2527                set name [lindex $option 0]
2528                set font [lindex $option 1]
2529                if {[catch {
2530                        foreach {cn cv} $repo_config(gui.$name) {
2531                                font configure $font $cn $cv
2532                        }
2533                        } err]} {
2534                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2535                }
2536                foreach {cn cv} [font configure $font] {
2537                        font configure ${font}bold $cn $cv
2538                }
2539                font configure ${font}bold -weight bold
2540        }
2541}
2542
2543set default_config(gui.trustmtime) false
2544set default_config(gui.pullsummary) true
2545set default_config(gui.partialinclude) false
2546set default_config(gui.diffcontext) 5
2547set default_config(gui.fontui) [font configure font_ui]
2548set default_config(gui.fontdiff) [font configure font_diff]
2549set font_descs {
2550        {fontui   font_ui   {Main Font}}
2551        {fontdiff font_diff {Diff/Console Font}}
2552}
2553load_config 0
2554apply_config
2555
2556######################################################################
2557##
2558## ui construction
2559
2560# -- Menu Bar
2561#
2562menu .mbar -tearoff 0
2563.mbar add cascade -label Project -menu .mbar.project
2564.mbar add cascade -label Edit -menu .mbar.edit
2565.mbar add cascade -label Commit -menu .mbar.commit
2566if {!$single_commit} {
2567        .mbar add cascade -label Fetch -menu .mbar.fetch
2568        .mbar add cascade -label Pull -menu .mbar.pull
2569        .mbar add cascade -label Push -menu .mbar.push
2570}
2571. configure -menu .mbar
2572
2573# -- Project Menu
2574#
2575menu .mbar.project
2576.mbar.project add command -label Visualize \
2577        -command do_gitk \
2578        -font font_ui
2579if {!$single_commit} {
2580        .mbar.project add command -label {Repack Database} \
2581                -command do_repack \
2582                -font font_ui
2583
2584        if {$tcl_platform(platform) eq {windows}} {
2585                .mbar.project add command \
2586                        -label {Create Desktop Icon} \
2587                        -command do_windows_shortcut \
2588                        -font font_ui
2589        } elseif {[is_MacOSX]} {
2590                .mbar.project add command \
2591                        -label {Create Desktop Icon} \
2592                        -command do_macosx_app \
2593                        -font font_ui
2594        }
2595}
2596.mbar.project add command -label Quit \
2597        -command do_quit \
2598        -accelerator $M1T-Q \
2599        -font font_ui
2600
2601# -- Edit Menu
2602#
2603menu .mbar.edit
2604.mbar.edit add command -label Undo \
2605        -command {catch {[focus] edit undo}} \
2606        -accelerator $M1T-Z \
2607        -font font_ui
2608.mbar.edit add command -label Redo \
2609        -command {catch {[focus] edit redo}} \
2610        -accelerator $M1T-Y \
2611        -font font_ui
2612.mbar.edit add separator
2613.mbar.edit add command -label Cut \
2614        -command {catch {tk_textCut [focus]}} \
2615        -accelerator $M1T-X \
2616        -font font_ui
2617.mbar.edit add command -label Copy \
2618        -command {catch {tk_textCopy [focus]}} \
2619        -accelerator $M1T-C \
2620        -font font_ui
2621.mbar.edit add command -label Paste \
2622        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2623        -accelerator $M1T-V \
2624        -font font_ui
2625.mbar.edit add command -label Delete \
2626        -command {catch {[focus] delete sel.first sel.last}} \
2627        -accelerator Del \
2628        -font font_ui
2629.mbar.edit add separator
2630.mbar.edit add command -label {Select All} \
2631        -command {catch {[focus] tag add sel 0.0 end}} \
2632        -accelerator $M1T-A \
2633        -font font_ui
2634.mbar.edit add separator
2635.mbar.edit add command -label {Options...} \
2636        -command do_options \
2637        -font font_ui
2638
2639# -- Commit Menu
2640#
2641menu .mbar.commit
2642
2643.mbar.commit add radiobutton \
2644        -label {New Commit} \
2645        -command do_select_commit_type \
2646        -variable selected_commit_type \
2647        -value new \
2648        -font font_ui
2649lappend disable_on_lock \
2650        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2651
2652.mbar.commit add radiobutton \
2653        -label {Amend Last Commit} \
2654        -command do_select_commit_type \
2655        -variable selected_commit_type \
2656        -value amend \
2657        -font font_ui
2658lappend disable_on_lock \
2659        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2660
2661.mbar.commit add separator
2662
2663.mbar.commit add command -label Rescan \
2664        -command do_rescan \
2665        -accelerator F5 \
2666        -font font_ui
2667lappend disable_on_lock \
2668        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2669
2670.mbar.commit add command -label {Remove From Commit} \
2671        -command do_remove_selection \
2672        -font font_ui
2673lappend disable_on_lock \
2674        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2675
2676.mbar.commit add command -label {Include In Commit} \
2677        -command do_include_selection \
2678        -font font_ui
2679lappend disable_on_lock \
2680        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2681
2682.mbar.commit add command -label {Include All} \
2683        -command do_include_all \
2684        -accelerator $M1T-I \
2685        -font font_ui
2686lappend disable_on_lock \
2687        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2688
2689.mbar.commit add separator
2690
2691.mbar.commit add command -label {Sign Off} \
2692        -command do_signoff \
2693        -accelerator $M1T-S \
2694        -font font_ui
2695
2696.mbar.commit add command -label Commit \
2697        -command do_commit \
2698        -accelerator $M1T-Return \
2699        -font font_ui
2700lappend disable_on_lock \
2701        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2702
2703# -- Transport menus
2704#
2705if {!$single_commit} {
2706        menu .mbar.fetch
2707        menu .mbar.pull
2708        menu .mbar.push
2709}
2710
2711# -- Main Window Layout
2712#
2713panedwindow .vpane -orient vertical
2714panedwindow .vpane.files -orient horizontal
2715.vpane add .vpane.files -sticky nsew -height 100 -width 400
2716pack .vpane -anchor n -side top -fill both -expand 1
2717
2718# -- Index File List
2719#
2720frame .vpane.files.index -height 100 -width 400
2721label .vpane.files.index.title -text {Modified Files} \
2722        -background green \
2723        -font font_ui
2724text $ui_index -background white -borderwidth 0 \
2725        -width 40 -height 10 \
2726        -font font_ui \
2727        -cursor $cursor_ptr \
2728        -yscrollcommand {.vpane.files.index.sb set} \
2729        -state disabled
2730scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2731pack .vpane.files.index.title -side top -fill x
2732pack .vpane.files.index.sb -side right -fill y
2733pack $ui_index -side left -fill both -expand 1
2734.vpane.files add .vpane.files.index -sticky nsew
2735
2736# -- Other (Add) File List
2737#
2738frame .vpane.files.other -height 100 -width 100
2739label .vpane.files.other.title -text {Untracked Files} \
2740        -background red \
2741        -font font_ui
2742text $ui_other -background white -borderwidth 0 \
2743        -width 40 -height 10 \
2744        -font font_ui \
2745        -cursor $cursor_ptr \
2746        -yscrollcommand {.vpane.files.other.sb set} \
2747        -state disabled
2748scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2749pack .vpane.files.other.title -side top -fill x
2750pack .vpane.files.other.sb -side right -fill y
2751pack $ui_other -side left -fill both -expand 1
2752.vpane.files add .vpane.files.other -sticky nsew
2753
2754foreach i [list $ui_index $ui_other] {
2755        $i tag conf in_diff -font font_uibold
2756        $i tag conf in_sel \
2757                -background [$i cget -foreground] \
2758                -foreground [$i cget -background]
2759}
2760unset i
2761
2762# -- Diff and Commit Area
2763#
2764frame .vpane.lower -height 300 -width 400
2765frame .vpane.lower.commarea
2766frame .vpane.lower.diff -relief sunken -borderwidth 1
2767pack .vpane.lower.commarea -side top -fill x
2768pack .vpane.lower.diff -side bottom -fill both -expand 1
2769.vpane add .vpane.lower -stick nsew
2770
2771# -- Commit Area Buttons
2772#
2773frame .vpane.lower.commarea.buttons
2774label .vpane.lower.commarea.buttons.l -text {} \
2775        -anchor w \
2776        -justify left \
2777        -font font_ui
2778pack .vpane.lower.commarea.buttons.l -side top -fill x
2779pack .vpane.lower.commarea.buttons -side left -fill y
2780
2781button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2782        -command do_rescan \
2783        -font font_ui
2784pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2785lappend disable_on_lock \
2786        {.vpane.lower.commarea.buttons.rescan conf -state}
2787
2788button .vpane.lower.commarea.buttons.incall -text {Include All} \
2789        -command do_include_all \
2790        -font font_ui
2791pack .vpane.lower.commarea.buttons.incall -side top -fill x
2792lappend disable_on_lock \
2793        {.vpane.lower.commarea.buttons.incall conf -state}
2794
2795button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2796        -command do_signoff \
2797        -font font_ui
2798pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2799
2800button .vpane.lower.commarea.buttons.commit -text {Commit} \
2801        -command do_commit \
2802        -font font_ui
2803pack .vpane.lower.commarea.buttons.commit -side top -fill x
2804lappend disable_on_lock \
2805        {.vpane.lower.commarea.buttons.commit conf -state}
2806
2807# -- Commit Message Buffer
2808#
2809frame .vpane.lower.commarea.buffer
2810frame .vpane.lower.commarea.buffer.header
2811set ui_comm .vpane.lower.commarea.buffer.t
2812set ui_coml .vpane.lower.commarea.buffer.header.l
2813radiobutton .vpane.lower.commarea.buffer.header.new \
2814        -text {New Commit} \
2815        -command do_select_commit_type \
2816        -variable selected_commit_type \
2817        -value new \
2818        -font font_ui
2819lappend disable_on_lock \
2820        [list .vpane.lower.commarea.buffer.header.new conf -state]
2821radiobutton .vpane.lower.commarea.buffer.header.amend \
2822        -text {Amend Last Commit} \
2823        -command do_select_commit_type \
2824        -variable selected_commit_type \
2825        -value amend \
2826        -font font_ui
2827lappend disable_on_lock \
2828        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2829label $ui_coml \
2830        -anchor w \
2831        -justify left \
2832        -font font_ui
2833proc trace_commit_type {varname args} {
2834        global ui_coml commit_type
2835        switch -glob -- $commit_type {
2836        initial       {set txt {Initial Commit Message:}}
2837        amend         {set txt {Amended Commit Message:}}
2838        amend-initial {set txt {Amended Initial Commit Message:}}
2839        merge         {set txt {Merge Commit Message:}}
2840        *             {set txt {Commit Message:}}
2841        }
2842        $ui_coml conf -text $txt
2843}
2844trace add variable commit_type write trace_commit_type
2845pack $ui_coml -side left -fill x
2846pack .vpane.lower.commarea.buffer.header.amend -side right
2847pack .vpane.lower.commarea.buffer.header.new -side right
2848
2849text $ui_comm -background white -borderwidth 1 \
2850        -undo true \
2851        -maxundo 20 \
2852        -autoseparators true \
2853        -relief sunken \
2854        -width 75 -height 9 -wrap none \
2855        -font font_diff \
2856        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2857scrollbar .vpane.lower.commarea.buffer.sby \
2858        -command [list $ui_comm yview]
2859pack .vpane.lower.commarea.buffer.header -side top -fill x
2860pack .vpane.lower.commarea.buffer.sby -side right -fill y
2861pack $ui_comm -side left -fill y
2862pack .vpane.lower.commarea.buffer -side left -fill y
2863
2864# -- Commit Message Buffer Context Menu
2865#
2866set ctxm .vpane.lower.commarea.buffer.ctxm
2867menu $ctxm -tearoff 0
2868$ctxm add command \
2869        -label {Cut} \
2870        -font font_ui \
2871        -command {tk_textCut $ui_comm}
2872$ctxm add command \
2873        -label {Copy} \
2874        -font font_ui \
2875        -command {tk_textCopy $ui_comm}
2876$ctxm add command \
2877        -label {Paste} \
2878        -font font_ui \
2879        -command {tk_textPaste $ui_comm}
2880$ctxm add command \
2881        -label {Delete} \
2882        -font font_ui \
2883        -command {$ui_comm delete sel.first sel.last}
2884$ctxm add separator
2885$ctxm add command \
2886        -label {Select All} \
2887        -font font_ui \
2888        -command {$ui_comm tag add sel 0.0 end}
2889$ctxm add command \
2890        -label {Copy All} \
2891        -font font_ui \
2892        -command {
2893                $ui_comm tag add sel 0.0 end
2894                tk_textCopy $ui_comm
2895                $ui_comm tag remove sel 0.0 end
2896        }
2897$ctxm add separator
2898$ctxm add command \
2899        -label {Sign Off} \
2900        -font font_ui \
2901        -command do_signoff
2902bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2903
2904# -- Diff Header
2905#
2906set current_diff {}
2907set diff_actions [list]
2908proc trace_current_diff {varname args} {
2909        global current_diff diff_actions file_states
2910        if {$current_diff eq {}} {
2911                set s {}
2912                set f {}
2913                set p {}
2914                set o disabled
2915        } else {
2916                set p $current_diff
2917                set s [mapdesc [lindex $file_states($p) 0] $p]
2918                set f {File:}
2919                set p [escape_path $p]
2920                set o normal
2921        }
2922
2923        .vpane.lower.diff.header.status configure -text $s
2924        .vpane.lower.diff.header.file configure -text $f
2925        .vpane.lower.diff.header.path configure -text $p
2926        foreach w $diff_actions {
2927                uplevel #0 $w $o
2928        }
2929}
2930trace add variable current_diff write trace_current_diff
2931
2932frame .vpane.lower.diff.header -background orange
2933label .vpane.lower.diff.header.status \
2934        -background orange \
2935        -width $max_status_desc \
2936        -anchor w \
2937        -justify left \
2938        -font font_ui
2939label .vpane.lower.diff.header.file \
2940        -background orange \
2941        -anchor w \
2942        -justify left \
2943        -font font_ui
2944label .vpane.lower.diff.header.path \
2945        -background orange \
2946        -anchor w \
2947        -justify left \
2948        -font font_ui
2949pack .vpane.lower.diff.header.status -side left
2950pack .vpane.lower.diff.header.file -side left
2951pack .vpane.lower.diff.header.path -fill x
2952set ctxm .vpane.lower.diff.header.ctxm
2953menu $ctxm -tearoff 0
2954$ctxm add command \
2955        -label {Copy} \
2956        -font font_ui \
2957        -command {
2958                clipboard clear
2959                clipboard append \
2960                        -format STRING \
2961                        -type STRING \
2962                        -- $current_diff
2963        }
2964lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2965bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2966
2967# -- Diff Body
2968#
2969frame .vpane.lower.diff.body
2970set ui_diff .vpane.lower.diff.body.t
2971text $ui_diff -background white -borderwidth 0 \
2972        -width 80 -height 15 -wrap none \
2973        -font font_diff \
2974        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2975        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2976        -state disabled
2977scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2978        -command [list $ui_diff xview]
2979scrollbar .vpane.lower.diff.body.sby -orient vertical \
2980        -command [list $ui_diff yview]
2981pack .vpane.lower.diff.body.sbx -side bottom -fill x
2982pack .vpane.lower.diff.body.sby -side right -fill y
2983pack $ui_diff -side left -fill both -expand 1
2984pack .vpane.lower.diff.header -side top -fill x
2985pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2986
2987$ui_diff tag conf dm -foreground red
2988$ui_diff tag conf dp -foreground blue
2989$ui_diff tag conf di -foreground {#00a000}
2990$ui_diff tag conf dni -foreground {#a000a0}
2991$ui_diff tag conf da -font font_diffbold
2992$ui_diff tag conf bold -font font_diffbold
2993
2994# -- Diff Body Context Menu
2995#
2996set ctxm .vpane.lower.diff.body.ctxm
2997menu $ctxm -tearoff 0
2998$ctxm add command \
2999        -label {Copy} \
3000        -font font_ui \
3001        -command {tk_textCopy $ui_diff}
3002lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3003$ctxm add command \
3004        -label {Select All} \
3005        -font font_ui \
3006        -command {$ui_diff tag add sel 0.0 end}
3007lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3008$ctxm add command \
3009        -label {Copy All} \
3010        -font font_ui \
3011        -command {
3012                $ui_diff tag add sel 0.0 end
3013                tk_textCopy $ui_diff
3014                $ui_diff tag remove sel 0.0 end
3015        }
3016lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3017$ctxm add separator
3018$ctxm add command \
3019        -label {Decrease Font Size} \
3020        -font font_ui \
3021        -command {incr_font_size font_diff -1}
3022lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3023$ctxm add command \
3024        -label {Increase Font Size} \
3025        -font font_ui \
3026        -command {incr_font_size font_diff 1}
3027lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3028$ctxm add separator
3029$ctxm add command \
3030        -label {Show Less Context} \
3031        -font font_ui \
3032        -command {if {$repo_config(gui.diffcontext) >= 2} {
3033                incr repo_config(gui.diffcontext) -1
3034                reshow_diff
3035        }}
3036lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3037$ctxm add command \
3038        -label {Show More Context} \
3039        -font font_ui \
3040        -command {
3041                incr repo_config(gui.diffcontext)
3042                reshow_diff
3043        }
3044lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3045$ctxm add separator
3046$ctxm add command -label {Options...} \
3047        -font font_ui \
3048        -command do_options
3049bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3050
3051# -- Status Bar
3052#
3053set ui_status_value {Initializing...}
3054label .status -textvariable ui_status_value \
3055        -anchor w \
3056        -justify left \
3057        -borderwidth 1 \
3058        -relief sunken \
3059        -font font_ui
3060pack .status -anchor w -side bottom -fill x
3061
3062# -- Load geometry
3063#
3064catch {
3065set gm $repo_config(gui.geometry)
3066wm geometry . [lindex $gm 0]
3067.vpane sash place 0 \
3068        [lindex [.vpane sash coord 0] 0] \
3069        [lindex $gm 1]
3070.vpane.files sash place 0 \
3071        [lindex $gm 2] \
3072        [lindex [.vpane.files sash coord 0] 1]
3073unset gm
3074}
3075
3076# -- Key Bindings
3077#
3078bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3079bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3080bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3081bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3082bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3083bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3084bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3085bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3086bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3087bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3088bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3089
3090bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3091bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3092bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3093bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3094bind $ui_diff <$M1B-Key-v> {break}
3095bind $ui_diff <$M1B-Key-V> {break}
3096bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3097bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3098bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3099bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3100bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3101bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3102
3103bind .   <Destroy> do_quit
3104bind all <Key-F5> do_rescan
3105bind all <$M1B-Key-r> do_rescan
3106bind all <$M1B-Key-R> do_rescan
3107bind .   <$M1B-Key-s> do_signoff
3108bind .   <$M1B-Key-S> do_signoff
3109bind .   <$M1B-Key-i> do_include_all
3110bind .   <$M1B-Key-I> do_include_all
3111bind .   <$M1B-Key-Return> do_commit
3112bind all <$M1B-Key-q> do_quit
3113bind all <$M1B-Key-Q> do_quit
3114bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3115bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3116foreach i [list $ui_index $ui_other] {
3117        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3118        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3119        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3120}
3121unset i
3122
3123set file_lists($ui_index) [list]
3124set file_lists($ui_other) [list]
3125
3126set HEAD {}
3127set PARENT {}
3128set commit_type {}
3129set empty_tree {}
3130set current_diff {}
3131set selected_commit_type new
3132
3133wm title . "$appname ([file normalize [file dirname $gitdir]])"
3134focus -force $ui_comm
3135if {!$single_commit} {
3136        load_all_remotes
3137        populate_fetch_menu .mbar.fetch
3138        populate_pull_menu .mbar.pull
3139        populate_push_menu .mbar.push
3140}
3141lock_index begin-read
3142after 1 do_rescan