Andrew's git - gitweb.git/blob

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