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