Andrew's git - gitweb.git/blob

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