Code

git-gui: Don't crash when starting gitk from a browser session
[git.git] / git-gui.sh
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3  if test "z$*" = zversion \
4  || test "z$*" = z--version; \
5  then \
6         echo 'git-gui version @@GITGUI_VERSION@@'; \
7         exit; \
8  fi; \
9  exec wish "$0" -- "$@"
11 set appvers {@@GITGUI_VERSION@@}
12 set copyright {
13 Copyright © 2006, 2007 Shawn Pearce, et. al.
15 This program is free software; you can redistribute it and/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation; either version 2 of the License, or
18 (at your option) any later version.
20 This program is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23 GNU General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
29 ######################################################################
30 ##
31 ## Tcl/Tk sanity check
33 if {[catch {package require Tcl 8.4} err]
34  || [catch {package require Tk  8.4} err]
35 } {
36         catch {wm withdraw .}
37         tk_messageBox \
38                 -icon error \
39                 -type ok \
40                 -title "git-gui: fatal error" \
41                 -message $err
42         exit 1
43 }
45 catch {rename send {}} ; # What an evil concept...
47 ######################################################################
48 ##
49 ## enable verbose loading?
51 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
52         unset _verbose
53         rename auto_load real__auto_load
54         proc auto_load {name args} {
55                 puts stderr "auto_load $name"
56                 return [uplevel 1 real__auto_load $name $args]
57         }
58         rename source real__source
59         proc source {name} {
60                 puts stderr "source    $name"
61                 uplevel 1 real__source $name
62         }
63 }
65 ######################################################################
66 ##
67 ## Fake internationalization to ease backporting of changes.
69 proc mc {fmt args} {
70         set cmk [string first @@ $fmt]
71         if {$cmk > 0} {
72                 set fmt [string range $fmt 0 [expr {$cmk - 1}]]
73         }
74         return [eval [list format $fmt] $args]
75 }
77 ######################################################################
78 ##
79 ## read only globals
81 set _appname [lindex [file split $argv0] end]
82 set _gitdir {}
83 set _gitexec {}
84 set _reponame {}
85 set _iscygwin {}
86 set _search_path {}
88 proc appname {} {
89         global _appname
90         return $_appname
91 }
93 proc gitdir {args} {
94         global _gitdir
95         if {$args eq {}} {
96                 return $_gitdir
97         }
98         return [eval [list file join $_gitdir] $args]
99 }
101 proc gitexec {args} {
102         global _gitexec
103         if {$_gitexec eq {}} {
104                 if {[catch {set _gitexec [git --exec-path]} err]} {
105                         error "Git not installed?\n\n$err"
106                 }
107                 if {[is_Cygwin]} {
108                         set _gitexec [exec cygpath \
109                                 --windows \
110                                 --absolute \
111                                 $_gitexec]
112                 } else {
113                         set _gitexec [file normalize $_gitexec]
114                 }
115         }
116         if {$args eq {}} {
117                 return $_gitexec
118         }
119         return [eval [list file join $_gitexec] $args]
122 proc reponame {} {
123         return $::_reponame
126 proc is_MacOSX {} {
127         if {[tk windowingsystem] eq {aqua}} {
128                 return 1
129         }
130         return 0
133 proc is_Windows {} {
134         if {$::tcl_platform(platform) eq {windows}} {
135                 return 1
136         }
137         return 0
140 proc is_Cygwin {} {
141         global _iscygwin
142         if {$_iscygwin eq {}} {
143                 if {$::tcl_platform(platform) eq {windows}} {
144                         if {[catch {set p [exec cygpath --windir]} err]} {
145                                 set _iscygwin 0
146                         } else {
147                                 set _iscygwin 1
148                         }
149                 } else {
150                         set _iscygwin 0
151                 }
152         }
153         return $_iscygwin
156 proc is_enabled {option} {
157         global enabled_options
158         if {[catch {set on $enabled_options($option)}]} {return 0}
159         return $on
162 proc enable_option {option} {
163         global enabled_options
164         set enabled_options($option) 1
167 proc disable_option {option} {
168         global enabled_options
169         set enabled_options($option) 0
172 ######################################################################
173 ##
174 ## config
176 proc is_many_config {name} {
177         switch -glob -- $name {
178         remote.*.fetch -
179         remote.*.push
180                 {return 1}
181         *
182                 {return 0}
183         }
186 proc is_config_true {name} {
187         global repo_config
188         if {[catch {set v $repo_config($name)}]} {
189                 return 0
190         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
191                 return 1
192         } else {
193                 return 0
194         }
197 proc get_config {name} {
198         global repo_config
199         if {[catch {set v $repo_config($name)}]} {
200                 return {}
201         } else {
202                 return $v
203         }
206 proc load_config {include_global} {
207         global repo_config global_config default_config
209         array unset global_config
210         if {$include_global} {
211                 catch {
212                         set fd_rc [git_read config --global --list]
213                         while {[gets $fd_rc line] >= 0} {
214                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
215                                         if {[is_many_config $name]} {
216                                                 lappend global_config($name) $value
217                                         } else {
218                                                 set global_config($name) $value
219                                         }
220                                 }
221                         }
222                         close $fd_rc
223                 }
224         }
226         array unset repo_config
227         catch {
228                 set fd_rc [git_read config --list]
229                 while {[gets $fd_rc line] >= 0} {
230                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
231                                 if {[is_many_config $name]} {
232                                         lappend repo_config($name) $value
233                                 } else {
234                                         set repo_config($name) $value
235                                 }
236                         }
237                 }
238                 close $fd_rc
239         }
241         foreach name [array names default_config] {
242                 if {[catch {set v $global_config($name)}]} {
243                         set global_config($name) $default_config($name)
244                 }
245                 if {[catch {set v $repo_config($name)}]} {
246                         set repo_config($name) $default_config($name)
247                 }
248         }
251 ######################################################################
252 ##
253 ## handy utils
255 proc _git_cmd {name} {
256         global _git_cmd_path
258         if {[catch {set v $_git_cmd_path($name)}]} {
259                 switch -- $name {
260                   version   -
261                 --version   -
262                 --exec-path { return [list $::_git $name] }
263                 }
265                 set p [gitexec git-$name$::_search_exe]
266                 if {[file exists $p]} {
267                         set v [list $p]
268                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
269                         # Try to determine what sort of magic will make
270                         # git-$name go and do its thing, because native
271                         # Tcl on Windows doesn't know it.
272                         #
273                         set p [gitexec git-$name]
274                         set f [open $p r]
275                         set s [gets $f]
276                         close $f
278                         switch -glob -- [lindex $s 0] {
279                         #!*sh     { set i sh     }
280                         #!*perl   { set i perl   }
281                         #!*python { set i python }
282                         default   { error "git-$name is not supported: $s" }
283                         }
285                         upvar #0 _$i interp
286                         if {![info exists interp]} {
287                                 set interp [_which $i]
288                         }
289                         if {$interp eq {}} {
290                                 error "git-$name requires $i (not in PATH)"
291                         }
292                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
293                 } else {
294                         # Assume it is builtin to git somehow and we
295                         # aren't actually able to see a file for it.
296                         #
297                         set v [list $::_git $name]
298                 }
299                 set _git_cmd_path($name) $v
300         }
301         return $v
304 proc _which {what} {
305         global env _search_exe _search_path
307         if {$_search_path eq {}} {
308                 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
309                         set _search_path [split [exec cygpath \
310                                 --windows \
311                                 --path \
312                                 --absolute \
313                                 $env(PATH)] {;}]
314                         set _search_exe .exe
315                 } elseif {[is_Windows]} {
316                         set _search_path [split $env(PATH) {;}]
317                         set _search_exe .exe
318                 } else {
319                         set _search_path [split $env(PATH) :]
320                         set _search_exe {}
321                 }
322         }
324         foreach p $_search_path {
325                 set p [file join $p $what$_search_exe]
326                 if {[file exists $p]} {
327                         return [file normalize $p]
328                 }
329         }
330         return {}
333 proc _lappend_nice {cmd_var} {
334         global _nice
335         upvar $cmd_var cmd
337         if {![info exists _nice]} {
338                 set _nice [_which nice]
339         }
340         if {$_nice ne {}} {
341                 lappend cmd $_nice
342         }
345 proc git {args} {
346         set opt [list exec]
348         while {1} {
349                 switch -- [lindex $args 0] {
350                 --nice {
351                         _lappend_nice opt
352                 }
354                 default {
355                         break
356                 }
358                 }
360                 set args [lrange $args 1 end]
361         }
363         set cmdp [_git_cmd [lindex $args 0]]
364         set args [lrange $args 1 end]
366         return [eval $opt $cmdp $args]
369 proc _open_stdout_stderr {cmd} {
370         if {[catch {
371                         set fd [open $cmd r]
372                 } err]} {
373                 if {   [lindex $cmd end] eq {2>@1}
374                     && $err eq {can not find channel named "1"}
375                         } {
376                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
377                         # redirect operator.  Fallback to |& cat for those.
378                         # The command was not actually started, so its safe
379                         # to try to start it a second time.
380                         #
381                         set fd [open [concat \
382                                 [lrange $cmd 0 end-1] \
383                                 [list |& cat] \
384                                 ] r]
385                 } else {
386                         error $err
387                 }
388         }
389         fconfigure $fd -eofchar {}
390         return $fd
393 proc git_read {args} {
394         set opt [list |]
396         while {1} {
397                 switch -- [lindex $args 0] {
398                 --nice {
399                         _lappend_nice opt
400                 }
402                 --stderr {
403                         lappend args 2>@1
404                 }
406                 default {
407                         break
408                 }
410                 }
412                 set args [lrange $args 1 end]
413         }
415         set cmdp [_git_cmd [lindex $args 0]]
416         set args [lrange $args 1 end]
418         return [_open_stdout_stderr [concat $opt $cmdp $args]]
421 proc git_write {args} {
422         set opt [list |]
424         while {1} {
425                 switch -- [lindex $args 0] {
426                 --nice {
427                         _lappend_nice opt
428                 }
430                 default {
431                         break
432                 }
434                 }
436                 set args [lrange $args 1 end]
437         }
439         set cmdp [_git_cmd [lindex $args 0]]
440         set args [lrange $args 1 end]
442         return [open [concat $opt $cmdp $args] w]
445 proc sq {value} {
446         regsub -all ' $value "'\\''" value
447         return "'$value'"
450 proc load_current_branch {} {
451         global current_branch is_detached
453         set fd [open [gitdir HEAD] r]
454         if {[gets $fd ref] < 1} {
455                 set ref {}
456         }
457         close $fd
459         set pfx {ref: refs/heads/}
460         set len [string length $pfx]
461         if {[string equal -length $len $pfx $ref]} {
462                 # We're on a branch.  It might not exist.  But
463                 # HEAD looks good enough to be a branch.
464                 #
465                 set current_branch [string range $ref $len end]
466                 set is_detached 0
467         } else {
468                 # Assume this is a detached head.
469                 #
470                 set current_branch HEAD
471                 set is_detached 1
472         }
475 auto_load tk_optionMenu
476 rename tk_optionMenu real__tkOptionMenu
477 proc tk_optionMenu {w varName args} {
478         set m [eval real__tkOptionMenu $w $varName $args]
479         $m configure -font font_ui
480         $w configure -font font_ui
481         return $m
484 proc rmsel_tag {text} {
485         $text tag conf sel \
486                 -background [$text cget -background] \
487                 -foreground [$text cget -foreground] \
488                 -borderwidth 0
489         $text tag conf in_sel -background lightgray
490         bind $text <Motion> break
491         return $text
494 ######################################################################
495 ##
496 ## find git
498 set _git  [_which git]
499 if {$_git eq {}} {
500         catch {wm withdraw .}
501         tk_messageBox \
502                 -icon error \
503                 -type ok \
504                 -title [mc "git-gui: fatal error"] \
505                 -message [mc "Cannot find git in PATH."]
506         exit 1
509 ######################################################################
510 ##
511 ## version check
513 if {[catch {set _git_version [git --version]} err]} {
514         catch {wm withdraw .}
515         tk_messageBox \
516                 -icon error \
517                 -type ok \
518                 -title "git-gui: fatal error" \
519                 -message "Cannot determine Git version:
521 $err
523 [appname] requires Git 1.5.0 or later."
524         exit 1
526 if {![regsub {^git version } $_git_version {} _git_version]} {
527         catch {wm withdraw .}
528         tk_messageBox \
529                 -icon error \
530                 -type ok \
531                 -title "git-gui: fatal error" \
532                 -message "Cannot parse Git version string:\n\n$_git_version"
533         exit 1
536 set _real_git_version $_git_version
537 regsub -- {-dirty$} $_git_version {} _git_version
538 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
539 regsub {\.rc[0-9]+$} $_git_version {} _git_version
540 regsub {\.GIT$} $_git_version {} _git_version
542 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
543         catch {wm withdraw .}
544         if {[tk_messageBox \
545                 -icon warning \
546                 -type yesno \
547                 -default no \
548                 -title "[appname]: warning" \
549                 -message "Git version cannot be determined.
551 $_git claims it is version '$_real_git_version'.
553 [appname] requires at least Git 1.5.0 or later.
555 Assume '$_real_git_version' is version 1.5.0?
556 "] eq {yes}} {
557                 set _git_version 1.5.0
558         } else {
559                 exit 1
560         }
562 unset _real_git_version
564 proc git-version {args} {
565         global _git_version
567         switch [llength $args] {
568         0 {
569                 return $_git_version
570         }
572         2 {
573                 set op [lindex $args 0]
574                 set vr [lindex $args 1]
575                 set cm [package vcompare $_git_version $vr]
576                 return [expr $cm $op 0]
577         }
579         4 {
580                 set type [lindex $args 0]
581                 set name [lindex $args 1]
582                 set parm [lindex $args 2]
583                 set body [lindex $args 3]
585                 if {($type ne {proc} && $type ne {method})} {
586                         error "Invalid arguments to git-version"
587                 }
588                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
589                         error "Last arm of $type $name must be default"
590                 }
592                 foreach {op vr cb} [lrange $body 0 end-2] {
593                         if {[git-version $op $vr]} {
594                                 return [uplevel [list $type $name $parm $cb]]
595                         }
596                 }
598                 return [uplevel [list $type $name $parm [lindex $body end]]]
599         }
601         default {
602                 error "git-version >= x"
603         }
605         }
608 if {[git-version < 1.5]} {
609         catch {wm withdraw .}
610         tk_messageBox \
611                 -icon error \
612                 -type ok \
613                 -title "git-gui: fatal error" \
614                 -message "[appname] requires Git 1.5.0 or later.
616 You are using [git-version]:
618 [git --version]"
619         exit 1
622 ######################################################################
623 ##
624 ## configure our library
626 set oguilib {@@GITGUI_LIBDIR@@}
627 set oguirel {@@GITGUI_RELATIVE@@}
628 if {$oguirel eq {1}} {
629         set oguilib [file dirname [file dirname [file normalize $argv0]]]
630         set oguilib [file join $oguilib share git-gui lib]
631 } elseif {[string match @@* $oguirel]} {
632         set oguilib [file join [file dirname [file normalize $argv0]] lib]
635 set idx [file join $oguilib tclIndex]
636 if {[catch {set fd [open $idx r]} err]} {
637         catch {wm withdraw .}
638         tk_messageBox \
639                 -icon error \
640                 -type ok \
641                 -title "git-gui: fatal error" \
642                 -message $err
643         exit 1
645 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
646         set idx [list]
647         while {[gets $fd n] >= 0} {
648                 if {$n ne {} && ![string match #* $n]} {
649                         lappend idx $n
650                 }
651         }
652 } else {
653         set idx {}
655 close $fd
657 if {$idx ne {}} {
658         set loaded [list]
659         foreach p $idx {
660                 if {[lsearch -exact $loaded $p] >= 0} continue
661                 source [file join $oguilib $p]
662                 lappend loaded $p
663         }
664         unset loaded p
665 } else {
666         set auto_path [concat [list $oguilib] $auto_path]
668 unset -nocomplain oguirel idx fd
670 ######################################################################
671 ##
672 ## feature option selection
674 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
675         unset _junk
676 } else {
677         set subcommand gui
679 if {$subcommand eq {gui.sh}} {
680         set subcommand gui
682 if {$subcommand eq {gui} && [llength $argv] > 0} {
683         set subcommand [lindex $argv 0]
684         set argv [lrange $argv 1 end]
687 enable_option multicommit
688 enable_option branch
689 enable_option transport
690 disable_option bare
692 switch -- $subcommand {
693 browser -
694 blame {
695         enable_option bare
697         disable_option multicommit
698         disable_option branch
699         disable_option transport
701 citool {
702         enable_option singlecommit
704         disable_option multicommit
705         disable_option branch
706         disable_option transport
710 ######################################################################
711 ##
712 ## repository setup
714 if {[catch {
715                 set _gitdir $env(GIT_DIR)
716                 set _prefix {}
717                 }]
718         && [catch {
719                 set _gitdir [git rev-parse --git-dir]
720                 set _prefix [git rev-parse --show-prefix]
721         } err]} {
722         catch {wm withdraw .}
723         error_popup "Cannot find the git directory:\n\n$err"
724         exit 1
726 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
727         catch {set _gitdir [exec cygpath --unix $_gitdir]}
729 if {![file isdirectory $_gitdir]} {
730         catch {wm withdraw .}
731         error_popup "Git directory not found:\n\n$_gitdir"
732         exit 1
734 if {$_prefix ne {}} {
735         regsub -all {[^/]+/} $_prefix ../ cdup
736         if {[catch {cd $cdup} err]} {
737                 catch {wm withdraw .}
738                 error_popup "Cannot move to top of working directory:\n\n$err"
739                 exit 1
740         }
741         unset cdup
742 } elseif {![is_enabled bare]} {
743         if {[lindex [file split $_gitdir] end] ne {.git}} {
744                 catch {wm withdraw .}
745                 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
746                 exit 1
747         }
748         if {[catch {cd [file dirname $_gitdir]} err]} {
749                 catch {wm withdraw .}
750                 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
751                 exit 1
752         }
754 set _reponame [file split [file normalize $_gitdir]]
755 if {[lindex $_reponame end] eq {.git}} {
756         set _reponame [lindex $_reponame end-1]
757 } else {
758         set _reponame [lindex $_reponame end]
761 ######################################################################
762 ##
763 ## global init
765 set current_diff_path {}
766 set current_diff_side {}
767 set diff_actions [list]
769 set HEAD {}
770 set PARENT {}
771 set MERGE_HEAD [list]
772 set commit_type {}
773 set empty_tree {}
774 set current_branch {}
775 set is_detached 0
776 set current_diff_path {}
777 set is_3way_diff 0
778 set selected_commit_type new
780 ######################################################################
781 ##
782 ## task management
784 set rescan_active 0
785 set diff_active 0
786 set last_clicked {}
788 set disable_on_lock [list]
789 set index_lock_type none
791 proc lock_index {type} {
792         global index_lock_type disable_on_lock
794         if {$index_lock_type eq {none}} {
795                 set index_lock_type $type
796                 foreach w $disable_on_lock {
797                         uplevel #0 $w disabled
798                 }
799                 return 1
800         } elseif {$index_lock_type eq "begin-$type"} {
801                 set index_lock_type $type
802                 return 1
803         }
804         return 0
807 proc unlock_index {} {
808         global index_lock_type disable_on_lock
810         set index_lock_type none
811         foreach w $disable_on_lock {
812                 uplevel #0 $w normal
813         }
816 ######################################################################
817 ##
818 ## status
820 proc repository_state {ctvar hdvar mhvar} {
821         global current_branch
822         upvar $ctvar ct $hdvar hd $mhvar mh
824         set mh [list]
826         load_current_branch
827         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
828                 set hd {}
829                 set ct initial
830                 return
831         }
833         set merge_head [gitdir MERGE_HEAD]
834         if {[file exists $merge_head]} {
835                 set ct merge
836                 set fd_mh [open $merge_head r]
837                 while {[gets $fd_mh line] >= 0} {
838                         lappend mh $line
839                 }
840                 close $fd_mh
841                 return
842         }
844         set ct normal
847 proc PARENT {} {
848         global PARENT empty_tree
850         set p [lindex $PARENT 0]
851         if {$p ne {}} {
852                 return $p
853         }
854         if {$empty_tree eq {}} {
855                 set empty_tree [git mktree << {}]
856         }
857         return $empty_tree
860 proc rescan {after {honor_trustmtime 1}} {
861         global HEAD PARENT MERGE_HEAD commit_type
862         global ui_index ui_workdir ui_comm
863         global rescan_active file_states
864         global repo_config
866         if {$rescan_active > 0 || ![lock_index read]} return
868         repository_state newType newHEAD newMERGE_HEAD
869         if {[string match amend* $commit_type]
870                 && $newType eq {normal}
871                 && $newHEAD eq $HEAD} {
872         } else {
873                 set HEAD $newHEAD
874                 set PARENT $newHEAD
875                 set MERGE_HEAD $newMERGE_HEAD
876                 set commit_type $newType
877         }
879         array unset file_states
881         if {!$::GITGUI_BCK_exists &&
882                 (![$ui_comm edit modified]
883                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
884                 if {[string match amend* $commit_type]} {
885                 } elseif {[load_message GITGUI_MSG]} {
886                 } elseif {[load_message MERGE_MSG]} {
887                 } elseif {[load_message SQUASH_MSG]} {
888                 }
889                 $ui_comm edit reset
890                 $ui_comm edit modified false
891         }
893         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
894                 rescan_stage2 {} $after
895         } else {
896                 set rescan_active 1
897                 ui_status {Refreshing file status...}
898                 set fd_rf [git_read update-index \
899                         -q \
900                         --unmerged \
901                         --ignore-missing \
902                         --refresh \
903                         ]
904                 fconfigure $fd_rf -blocking 0 -translation binary
905                 fileevent $fd_rf readable \
906                         [list rescan_stage2 $fd_rf $after]
907         }
910 if {[is_Cygwin]} {
911         set is_git_info_link {}
912         set is_git_info_exclude {}
913         proc have_info_exclude {} {
914                 global is_git_info_link is_git_info_exclude
916                 if {$is_git_info_link eq {}} {
917                         set is_git_info_link [file isfile [gitdir info.lnk]]
918                 }
920                 if {$is_git_info_link} {
921                         if {$is_git_info_exclude eq {}} {
922                                 if {[catch {exec test -f [gitdir info exclude]}]} {
923                                         set is_git_info_exclude 0
924                                 } else {
925                                         set is_git_info_exclude 1
926                                 }
927                         }
928                         return $is_git_info_exclude
929                 } else {
930                         return [file readable [gitdir info exclude]]
931                 }
932         }
933 } else {
934         proc have_info_exclude {} {
935                 return [file readable [gitdir info exclude]]
936         }
939 proc rescan_stage2 {fd after} {
940         global rescan_active buf_rdi buf_rdf buf_rlo
942         if {$fd ne {}} {
943                 read $fd
944                 if {![eof $fd]} return
945                 close $fd
946         }
948         set ls_others [list --exclude-per-directory=.gitignore]
949         if {[have_info_exclude]} {
950                 lappend ls_others "--exclude-from=[gitdir info exclude]"
951         }
952         set user_exclude [get_config core.excludesfile]
953         if {$user_exclude ne {} && [file readable $user_exclude]} {
954                 lappend ls_others "--exclude-from=$user_exclude"
955         }
957         set buf_rdi {}
958         set buf_rdf {}
959         set buf_rlo {}
961         set rescan_active 3
962         ui_status {Scanning for modified files ...}
963         set fd_di [git_read diff-index --cached -z [PARENT]]
964         set fd_df [git_read diff-files -z]
965         set fd_lo [eval git_read ls-files --others -z $ls_others]
967         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
968         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
969         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
970         fileevent $fd_di readable [list read_diff_index $fd_di $after]
971         fileevent $fd_df readable [list read_diff_files $fd_df $after]
972         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
975 proc load_message {file} {
976         global ui_comm
978         set f [gitdir $file]
979         if {[file isfile $f]} {
980                 if {[catch {set fd [open $f r]}]} {
981                         return 0
982                 }
983                 fconfigure $fd -eofchar {}
984                 set content [string trim [read $fd]]
985                 close $fd
986                 regsub -all -line {[ \r\t]+$} $content {} content
987                 $ui_comm delete 0.0 end
988                 $ui_comm insert end $content
989                 return 1
990         }
991         return 0
994 proc read_diff_index {fd after} {
995         global buf_rdi
997         append buf_rdi [read $fd]
998         set c 0
999         set n [string length $buf_rdi]
1000         while {$c < $n} {
1001                 set z1 [string first "\0" $buf_rdi $c]
1002                 if {$z1 == -1} break
1003                 incr z1
1004                 set z2 [string first "\0" $buf_rdi $z1]
1005                 if {$z2 == -1} break
1007                 incr c
1008                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1009                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1010                 merge_state \
1011                         [encoding convertfrom $p] \
1012                         [lindex $i 4]? \
1013                         [list [lindex $i 0] [lindex $i 2]] \
1014                         [list]
1015                 set c $z2
1016                 incr c
1017         }
1018         if {$c < $n} {
1019                 set buf_rdi [string range $buf_rdi $c end]
1020         } else {
1021                 set buf_rdi {}
1022         }
1024         rescan_done $fd buf_rdi $after
1027 proc read_diff_files {fd after} {
1028         global buf_rdf
1030         append buf_rdf [read $fd]
1031         set c 0
1032         set n [string length $buf_rdf]
1033         while {$c < $n} {
1034                 set z1 [string first "\0" $buf_rdf $c]
1035                 if {$z1 == -1} break
1036                 incr z1
1037                 set z2 [string first "\0" $buf_rdf $z1]
1038                 if {$z2 == -1} break
1040                 incr c
1041                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1042                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1043                 merge_state \
1044                         [encoding convertfrom $p] \
1045                         ?[lindex $i 4] \
1046                         [list] \
1047                         [list [lindex $i 0] [lindex $i 2]]
1048                 set c $z2
1049                 incr c
1050         }
1051         if {$c < $n} {
1052                 set buf_rdf [string range $buf_rdf $c end]
1053         } else {
1054                 set buf_rdf {}
1055         }
1057         rescan_done $fd buf_rdf $after
1060 proc read_ls_others {fd after} {
1061         global buf_rlo
1063         append buf_rlo [read $fd]
1064         set pck [split $buf_rlo "\0"]
1065         set buf_rlo [lindex $pck end]
1066         foreach p [lrange $pck 0 end-1] {
1067                 set p [encoding convertfrom $p]
1068                 if {[string index $p end] eq {/}} {
1069                         set p [string range $p 0 end-1]
1070                 }
1071                 merge_state $p ?O
1072         }
1073         rescan_done $fd buf_rlo $after
1076 proc rescan_done {fd buf after} {
1077         global rescan_active current_diff_path
1078         global file_states repo_config
1079         upvar $buf to_clear
1081         if {![eof $fd]} return
1082         set to_clear {}
1083         close $fd
1084         if {[incr rescan_active -1] > 0} return
1086         prune_selection
1087         unlock_index
1088         display_all_files
1089         if {$current_diff_path ne {}} reshow_diff
1090         uplevel #0 $after
1093 proc prune_selection {} {
1094         global file_states selected_paths
1096         foreach path [array names selected_paths] {
1097                 if {[catch {set still_here $file_states($path)}]} {
1098                         unset selected_paths($path)
1099                 }
1100         }
1103 ######################################################################
1104 ##
1105 ## ui helpers
1107 proc mapicon {w state path} {
1108         global all_icons
1110         if {[catch {set r $all_icons($state$w)}]} {
1111                 puts "error: no icon for $w state={$state} $path"
1112                 return file_plain
1113         }
1114         return $r
1117 proc mapdesc {state path} {
1118         global all_descs
1120         if {[catch {set r $all_descs($state)}]} {
1121                 puts "error: no desc for state={$state} $path"
1122                 return $state
1123         }
1124         return $r
1127 proc ui_status {msg} {
1128         global main_status
1129         if {[info exists main_status]} {
1130                 $main_status show $msg
1131         }
1134 proc ui_ready {{test {}}} {
1135         global main_status
1136         if {[info exists main_status]} {
1137                 $main_status show [mc "Ready."] $test
1138         }
1141 proc escape_path {path} {
1142         regsub -all {\\} $path "\\\\" path
1143         regsub -all "\n" $path "\\n" path
1144         return $path
1147 proc short_path {path} {
1148         return [escape_path [lindex [file split $path] end]]
1151 set next_icon_id 0
1152 set null_sha1 [string repeat 0 40]
1154 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1155         global file_states next_icon_id null_sha1
1157         set s0 [string index $new_state 0]
1158         set s1 [string index $new_state 1]
1160         if {[catch {set info $file_states($path)}]} {
1161                 set state __
1162                 set icon n[incr next_icon_id]
1163         } else {
1164                 set state [lindex $info 0]
1165                 set icon [lindex $info 1]
1166                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1167                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1168         }
1170         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1171         elseif {$s0 eq {_}} {set s0 _}
1173         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1174         elseif {$s1 eq {_}} {set s1 _}
1176         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1177                 set head_info [list 0 $null_sha1]
1178         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1179                 && $head_info eq {}} {
1180                 set head_info $index_info
1181         }
1183         set file_states($path) [list $s0$s1 $icon \
1184                 $head_info $index_info \
1185                 ]
1186         return $state
1189 proc display_file_helper {w path icon_name old_m new_m} {
1190         global file_lists
1192         if {$new_m eq {_}} {
1193                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1194                 if {$lno >= 0} {
1195                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1196                         incr lno
1197                         $w conf -state normal
1198                         $w delete $lno.0 [expr {$lno + 1}].0
1199                         $w conf -state disabled
1200                 }
1201         } elseif {$old_m eq {_} && $new_m ne {_}} {
1202                 lappend file_lists($w) $path
1203                 set file_lists($w) [lsort -unique $file_lists($w)]
1204                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1205                 incr lno
1206                 $w conf -state normal
1207                 $w image create $lno.0 \
1208                         -align center -padx 5 -pady 1 \
1209                         -name $icon_name \
1210                         -image [mapicon $w $new_m $path]
1211                 $w insert $lno.1 "[escape_path $path]\n"
1212                 $w conf -state disabled
1213         } elseif {$old_m ne $new_m} {
1214                 $w conf -state normal
1215                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1216                 $w conf -state disabled
1217         }
1220 proc display_file {path state} {
1221         global file_states selected_paths
1222         global ui_index ui_workdir
1224         set old_m [merge_state $path $state]
1225         set s $file_states($path)
1226         set new_m [lindex $s 0]
1227         set icon_name [lindex $s 1]
1229         set o [string index $old_m 0]
1230         set n [string index $new_m 0]
1231         if {$o eq {U}} {
1232                 set o _
1233         }
1234         if {$n eq {U}} {
1235                 set n _
1236         }
1237         display_file_helper     $ui_index $path $icon_name $o $n
1239         if {[string index $old_m 0] eq {U}} {
1240                 set o U
1241         } else {
1242                 set o [string index $old_m 1]
1243         }
1244         if {[string index $new_m 0] eq {U}} {
1245                 set n U
1246         } else {
1247                 set n [string index $new_m 1]
1248         }
1249         display_file_helper     $ui_workdir $path $icon_name $o $n
1251         if {$new_m eq {__}} {
1252                 unset file_states($path)
1253                 catch {unset selected_paths($path)}
1254         }
1257 proc display_all_files_helper {w path icon_name m} {
1258         global file_lists
1260         lappend file_lists($w) $path
1261         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1262         $w image create end \
1263                 -align center -padx 5 -pady 1 \
1264                 -name $icon_name \
1265                 -image [mapicon $w $m $path]
1266         $w insert end "[escape_path $path]\n"
1269 proc display_all_files {} {
1270         global ui_index ui_workdir
1271         global file_states file_lists
1272         global last_clicked
1274         $ui_index conf -state normal
1275         $ui_workdir conf -state normal
1277         $ui_index delete 0.0 end
1278         $ui_workdir delete 0.0 end
1279         set last_clicked {}
1281         set file_lists($ui_index) [list]
1282         set file_lists($ui_workdir) [list]
1284         foreach path [lsort [array names file_states]] {
1285                 set s $file_states($path)
1286                 set m [lindex $s 0]
1287                 set icon_name [lindex $s 1]
1289                 set s [string index $m 0]
1290                 if {$s ne {U} && $s ne {_}} {
1291                         display_all_files_helper $ui_index $path \
1292                                 $icon_name $s
1293                 }
1295                 if {[string index $m 0] eq {U}} {
1296                         set s U
1297                 } else {
1298                         set s [string index $m 1]
1299                 }
1300                 if {$s ne {_}} {
1301                         display_all_files_helper $ui_workdir $path \
1302                                 $icon_name $s
1303                 }
1304         }
1306         $ui_index conf -state disabled
1307         $ui_workdir conf -state disabled
1310 ######################################################################
1311 ##
1312 ## icons
1314 set filemask {
1315 #define mask_width 14
1316 #define mask_height 15
1317 static unsigned char mask_bits[] = {
1318    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1319    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1320    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1323 image create bitmap file_plain -background white -foreground black -data {
1324 #define plain_width 14
1325 #define plain_height 15
1326 static unsigned char plain_bits[] = {
1327    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1328    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1329    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1330 } -maskdata $filemask
1332 image create bitmap file_mod -background white -foreground blue -data {
1333 #define mod_width 14
1334 #define mod_height 15
1335 static unsigned char mod_bits[] = {
1336    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1337    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1338    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1339 } -maskdata $filemask
1341 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1342 #define file_fulltick_width 14
1343 #define file_fulltick_height 15
1344 static unsigned char file_fulltick_bits[] = {
1345    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1346    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1347    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1348 } -maskdata $filemask
1350 image create bitmap file_parttick -background white -foreground "#005050" -data {
1351 #define parttick_width 14
1352 #define parttick_height 15
1353 static unsigned char parttick_bits[] = {
1354    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1355    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1356    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1357 } -maskdata $filemask
1359 image create bitmap file_question -background white -foreground black -data {
1360 #define file_question_width 14
1361 #define file_question_height 15
1362 static unsigned char file_question_bits[] = {
1363    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1364    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1365    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1366 } -maskdata $filemask
1368 image create bitmap file_removed -background white -foreground red -data {
1369 #define file_removed_width 14
1370 #define file_removed_height 15
1371 static unsigned char file_removed_bits[] = {
1372    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1373    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1374    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1375 } -maskdata $filemask
1377 image create bitmap file_merge -background white -foreground blue -data {
1378 #define file_merge_width 14
1379 #define file_merge_height 15
1380 static unsigned char file_merge_bits[] = {
1381    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1382    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1383    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1384 } -maskdata $filemask
1386 set ui_index .vpane.files.index.list
1387 set ui_workdir .vpane.files.workdir.list
1389 set all_icons(_$ui_index)   file_plain
1390 set all_icons(A$ui_index)   file_fulltick
1391 set all_icons(M$ui_index)   file_fulltick
1392 set all_icons(D$ui_index)   file_removed
1393 set all_icons(U$ui_index)   file_merge
1395 set all_icons(_$ui_workdir) file_plain
1396 set all_icons(M$ui_workdir) file_mod
1397 set all_icons(D$ui_workdir) file_question
1398 set all_icons(U$ui_workdir) file_merge
1399 set all_icons(O$ui_workdir) file_plain
1401 set max_status_desc 0
1402 foreach i {
1403                 {__ "Unmodified"}
1405                 {_M "Modified, not staged"}
1406                 {M_ "Staged for commit"}
1407                 {MM "Portions staged for commit"}
1408                 {MD "Staged for commit, missing"}
1410                 {_O "Untracked, not staged"}
1411                 {A_ "Staged for commit"}
1412                 {AM "Portions staged for commit"}
1413                 {AD "Staged for commit, missing"}
1415                 {_D "Missing"}
1416                 {D_ "Staged for removal"}
1417                 {DO "Staged for removal, still present"}
1419                 {U_ "Requires merge resolution"}
1420                 {UU "Requires merge resolution"}
1421                 {UM "Requires merge resolution"}
1422                 {UD "Requires merge resolution"}
1423         } {
1424         if {$max_status_desc < [string length [lindex $i 1]]} {
1425                 set max_status_desc [string length [lindex $i 1]]
1426         }
1427         set all_descs([lindex $i 0]) [lindex $i 1]
1429 unset i
1431 ######################################################################
1432 ##
1433 ## util
1435 proc bind_button3 {w cmd} {
1436         bind $w <Any-Button-3> $cmd
1437         if {[is_MacOSX]} {
1438                 # Mac OS X sends Button-2 on right click through three-button mouse,
1439                 # or through trackpad right-clicking (two-finger touch + click).
1440                 bind $w <Any-Button-2> $cmd
1441                 bind $w <Control-Button-1> $cmd
1442         }
1445 proc scrollbar2many {list mode args} {
1446         foreach w $list {eval $w $mode $args}
1449 proc many2scrollbar {list mode sb top bottom} {
1450         $sb set $top $bottom
1451         foreach w $list {$w $mode moveto $top}
1454 proc incr_font_size {font {amt 1}} {
1455         set sz [font configure $font -size]
1456         incr sz $amt
1457         font configure $font -size $sz
1458         font configure ${font}bold -size $sz
1459         font configure ${font}italic -size $sz
1462 ######################################################################
1463 ##
1464 ## ui commands
1466 set starting_gitk_msg {Starting gitk... please wait...}
1468 proc do_gitk {revs} {
1469         # -- Always start gitk through whatever we were loaded with.  This
1470         #    lets us bypass using shell process on Windows systems.
1471         #
1472         set exe [file join [file dirname $::_git] gitk]
1473         set cmd [list [info nameofexecutable] $exe]
1474         if {! [file exists $exe]} {
1475                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1476         } else {
1477                 global env
1479                 if {[info exists env(GIT_DIR)]} {
1480                         set old_GIT_DIR $env(GIT_DIR)
1481                 } else {
1482                         set old_GIT_DIR {}
1483                 }
1485                 set pwd [pwd]
1486                 cd [file dirname [gitdir]]
1487                 set env(GIT_DIR) [file tail [gitdir]]
1489                 eval exec $cmd $revs &
1491                 if {$old_GIT_DIR eq {}} {
1492                         unset env(GIT_DIR)
1493                 } else {
1494                         set env(GIT_DIR) $old_GIT_DIR
1495                 }
1496                 cd $pwd
1498                 ui_status $::starting_gitk_msg
1499                 after 10000 {
1500                         ui_ready $starting_gitk_msg
1501                 }
1502         }
1505 set is_quitting 0
1507 proc do_quit {} {
1508         global ui_comm is_quitting repo_config commit_type
1509         global GITGUI_BCK_exists GITGUI_BCK_i
1511         if {$is_quitting} return
1512         set is_quitting 1
1514         if {[winfo exists $ui_comm]} {
1515                 # -- Stash our current commit buffer.
1516                 #
1517                 set save [gitdir GITGUI_MSG]
1518                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1519                         file rename -force [gitdir GITGUI_BCK] $save
1520                         set GITGUI_BCK_exists 0
1521                 } else {
1522                         set msg [string trim [$ui_comm get 0.0 end]]
1523                         regsub -all -line {[ \r\t]+$} $msg {} msg
1524                         if {(![string match amend* $commit_type]
1525                                 || [$ui_comm edit modified])
1526                                 && $msg ne {}} {
1527                                 catch {
1528                                         set fd [open $save w]
1529                                         puts -nonewline $fd $msg
1530                                         close $fd
1531                                 }
1532                         } else {
1533                                 catch {file delete $save}
1534                         }
1535                 }
1537                 # -- Remove our editor backup, its not needed.
1538                 #
1539                 after cancel $GITGUI_BCK_i
1540                 if {$GITGUI_BCK_exists} {
1541                         catch {file delete [gitdir GITGUI_BCK]}
1542                 }
1544                 # -- Stash our current window geometry into this repository.
1545                 #
1546                 set cfg_geometry [list]
1547                 lappend cfg_geometry [wm geometry .]
1548                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1549                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1550                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1551                         set rc_geometry {}
1552                 }
1553                 if {$cfg_geometry ne $rc_geometry} {
1554                         catch {git config gui.geometry $cfg_geometry}
1555                 }
1556         }
1558         destroy .
1561 proc do_rescan {} {
1562         rescan ui_ready
1565 proc do_commit {} {
1566         commit_tree
1569 proc toggle_or_diff {w x y} {
1570         global file_states file_lists current_diff_path ui_index ui_workdir
1571         global last_clicked selected_paths
1573         set pos [split [$w index @$x,$y] .]
1574         set lno [lindex $pos 0]
1575         set col [lindex $pos 1]
1576         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1577         if {$path eq {}} {
1578                 set last_clicked {}
1579                 return
1580         }
1582         set last_clicked [list $w $lno]
1583         array unset selected_paths
1584         $ui_index tag remove in_sel 0.0 end
1585         $ui_workdir tag remove in_sel 0.0 end
1587         if {$col == 0} {
1588                 if {$current_diff_path eq $path} {
1589                         set after {reshow_diff;}
1590                 } else {
1591                         set after {}
1592                 }
1593                 if {$w eq $ui_index} {
1594                         update_indexinfo \
1595                                 "Unstaging [short_path $path] from commit" \
1596                                 [list $path] \
1597                                 [concat $after [list ui_ready]]
1598                 } elseif {$w eq $ui_workdir} {
1599                         update_index \
1600                                 "Adding [short_path $path]" \
1601                                 [list $path] \
1602                                 [concat $after [list ui_ready]]
1603                 }
1604         } else {
1605                 show_diff $path $w $lno
1606         }
1609 proc add_one_to_selection {w x y} {
1610         global file_lists last_clicked selected_paths
1612         set lno [lindex [split [$w index @$x,$y] .] 0]
1613         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1614         if {$path eq {}} {
1615                 set last_clicked {}
1616                 return
1617         }
1619         if {$last_clicked ne {}
1620                 && [lindex $last_clicked 0] ne $w} {
1621                 array unset selected_paths
1622                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1623         }
1625         set last_clicked [list $w $lno]
1626         if {[catch {set in_sel $selected_paths($path)}]} {
1627                 set in_sel 0
1628         }
1629         if {$in_sel} {
1630                 unset selected_paths($path)
1631                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1632         } else {
1633                 set selected_paths($path) 1
1634                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1635         }
1638 proc add_range_to_selection {w x y} {
1639         global file_lists last_clicked selected_paths
1641         if {[lindex $last_clicked 0] ne $w} {
1642                 toggle_or_diff $w $x $y
1643                 return
1644         }
1646         set lno [lindex [split [$w index @$x,$y] .] 0]
1647         set lc [lindex $last_clicked 1]
1648         if {$lc < $lno} {
1649                 set begin $lc
1650                 set end $lno
1651         } else {
1652                 set begin $lno
1653                 set end $lc
1654         }
1656         foreach path [lrange $file_lists($w) \
1657                 [expr {$begin - 1}] \
1658                 [expr {$end - 1}]] {
1659                 set selected_paths($path) 1
1660         }
1661         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1664 ######################################################################
1665 ##
1666 ## config defaults
1668 set cursor_ptr arrow
1669 font create font_diff -family Courier -size 10
1670 font create font_ui
1671 catch {
1672         label .dummy
1673         eval font configure font_ui [font actual [.dummy cget -font]]
1674         destroy .dummy
1677 font create font_uiitalic
1678 font create font_uibold
1679 font create font_diffbold
1680 font create font_diffitalic
1682 foreach class {Button Checkbutton Entry Label
1683                 Labelframe Listbox Menu Message
1684                 Radiobutton Spinbox Text} {
1685         option add *$class.font font_ui
1687 unset class
1689 if {[is_Windows] || [is_MacOSX]} {
1690         option add *Menu.tearOff 0
1693 if {[is_MacOSX]} {
1694         set M1B M1
1695         set M1T Cmd
1696 } else {
1697         set M1B Control
1698         set M1T Ctrl
1701 proc apply_config {} {
1702         global repo_config font_descs
1704         foreach option $font_descs {
1705                 set name [lindex $option 0]
1706                 set font [lindex $option 1]
1707                 if {[catch {
1708                         foreach {cn cv} $repo_config(gui.$name) {
1709                                 font configure $font $cn $cv -weight normal
1710                         }
1711                         } err]} {
1712                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1713                 }
1714                 foreach {cn cv} [font configure $font] {
1715                         font configure ${font}bold $cn $cv
1716                         font configure ${font}italic $cn $cv
1717                 }
1718                 font configure ${font}bold -weight bold
1719                 font configure ${font}italic -slant italic
1720         }
1723 set default_config(merge.diffstat) true
1724 set default_config(merge.summary) false
1725 set default_config(merge.verbosity) 2
1726 set default_config(user.name) {}
1727 set default_config(user.email) {}
1729 set default_config(gui.matchtrackingbranch) false
1730 set default_config(gui.pruneduringfetch) false
1731 set default_config(gui.trustmtime) false
1732 set default_config(gui.diffcontext) 5
1733 set default_config(gui.newbranchtemplate) {}
1734 set default_config(gui.fontui) [font configure font_ui]
1735 set default_config(gui.fontdiff) [font configure font_diff]
1736 set font_descs {
1737         {fontui   font_ui   {Main Font}}
1738         {fontdiff font_diff {Diff/Console Font}}
1740 load_config 0
1741 apply_config
1743 ######################################################################
1744 ##
1745 ## ui construction
1747 set ui_comm {}
1749 # -- Menu Bar
1751 menu .mbar -tearoff 0
1752 .mbar add cascade -label Repository -menu .mbar.repository
1753 .mbar add cascade -label Edit -menu .mbar.edit
1754 if {[is_enabled branch]} {
1755         .mbar add cascade -label Branch -menu .mbar.branch
1757 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1758         .mbar add cascade -label Commit -menu .mbar.commit
1760 if {[is_enabled transport]} {
1761         .mbar add cascade -label Merge -menu .mbar.merge
1762         .mbar add cascade -label Fetch -menu .mbar.fetch
1763         .mbar add cascade -label Push -menu .mbar.push
1765 . configure -menu .mbar
1767 # -- Repository Menu
1769 menu .mbar.repository
1771 .mbar.repository add command \
1772         -label {Browse Current Branch's Files} \
1773         -command {browser::new $current_branch}
1774 set ui_browse_current [.mbar.repository index last]
1775 .mbar.repository add command \
1776         -label {Browse Branch Files...} \
1777         -command browser_open::dialog
1778 .mbar.repository add separator
1780 .mbar.repository add command \
1781         -label {Visualize Current Branch's History} \
1782         -command {do_gitk $current_branch}
1783 set ui_visualize_current [.mbar.repository index last]
1784 .mbar.repository add command \
1785         -label {Visualize All Branch History} \
1786         -command {do_gitk --all}
1787 .mbar.repository add separator
1789 proc current_branch_write {args} {
1790         global current_branch
1791         .mbar.repository entryconf $::ui_browse_current \
1792                 -label "Browse $current_branch's Files"
1793         .mbar.repository entryconf $::ui_visualize_current \
1794                 -label "Visualize $current_branch's History"
1796 trace add variable current_branch write current_branch_write
1798 if {[is_enabled multicommit]} {
1799         .mbar.repository add command -label {Database Statistics} \
1800                 -command do_stats
1802         .mbar.repository add command -label {Compress Database} \
1803                 -command do_gc
1805         .mbar.repository add command -label {Verify Database} \
1806                 -command do_fsck_objects
1808         .mbar.repository add separator
1810         if {[is_Cygwin]} {
1811                 .mbar.repository add command \
1812                         -label {Create Desktop Icon} \
1813                         -command do_cygwin_shortcut
1814         } elseif {[is_Windows]} {
1815                 .mbar.repository add command \
1816                         -label {Create Desktop Icon} \
1817                         -command do_windows_shortcut
1818         } elseif {[is_MacOSX]} {
1819                 .mbar.repository add command \
1820                         -label {Create Desktop Icon} \
1821                         -command do_macosx_app
1822         }
1825 .mbar.repository add command -label Quit \
1826         -command do_quit \
1827         -accelerator $M1T-Q
1829 # -- Edit Menu
1831 menu .mbar.edit
1832 .mbar.edit add command -label Undo \
1833         -command {catch {[focus] edit undo}} \
1834         -accelerator $M1T-Z
1835 .mbar.edit add command -label Redo \
1836         -command {catch {[focus] edit redo}} \
1837         -accelerator $M1T-Y
1838 .mbar.edit add separator
1839 .mbar.edit add command -label Cut \
1840         -command {catch {tk_textCut [focus]}} \
1841         -accelerator $M1T-X
1842 .mbar.edit add command -label Copy \
1843         -command {catch {tk_textCopy [focus]}} \
1844         -accelerator $M1T-C
1845 .mbar.edit add command -label Paste \
1846         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1847         -accelerator $M1T-V
1848 .mbar.edit add command -label Delete \
1849         -command {catch {[focus] delete sel.first sel.last}} \
1850         -accelerator Del
1851 .mbar.edit add separator
1852 .mbar.edit add command -label {Select All} \
1853         -command {catch {[focus] tag add sel 0.0 end}} \
1854         -accelerator $M1T-A
1856 # -- Branch Menu
1858 if {[is_enabled branch]} {
1859         menu .mbar.branch
1861         .mbar.branch add command -label {Create...} \
1862                 -command branch_create::dialog \
1863                 -accelerator $M1T-N
1864         lappend disable_on_lock [list .mbar.branch entryconf \
1865                 [.mbar.branch index last] -state]
1867         .mbar.branch add command -label {Checkout...} \
1868                 -command branch_checkout::dialog \
1869                 -accelerator $M1T-O
1870         lappend disable_on_lock [list .mbar.branch entryconf \
1871                 [.mbar.branch index last] -state]
1873         .mbar.branch add command -label {Rename...} \
1874                 -command branch_rename::dialog
1875         lappend disable_on_lock [list .mbar.branch entryconf \
1876                 [.mbar.branch index last] -state]
1878         .mbar.branch add command -label {Delete...} \
1879                 -command branch_delete::dialog
1880         lappend disable_on_lock [list .mbar.branch entryconf \
1881                 [.mbar.branch index last] -state]
1883         .mbar.branch add command -label {Reset...} \
1884                 -command merge::reset_hard
1885         lappend disable_on_lock [list .mbar.branch entryconf \
1886                 [.mbar.branch index last] -state]
1889 # -- Commit Menu
1891 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1892         menu .mbar.commit
1894         .mbar.commit add radiobutton \
1895                 -label {New Commit} \
1896                 -command do_select_commit_type \
1897                 -variable selected_commit_type \
1898                 -value new
1899         lappend disable_on_lock \
1900                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1902         .mbar.commit add radiobutton \
1903                 -label {Amend Last Commit} \
1904                 -command do_select_commit_type \
1905                 -variable selected_commit_type \
1906                 -value amend
1907         lappend disable_on_lock \
1908                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1910         .mbar.commit add separator
1912         .mbar.commit add command -label Rescan \
1913                 -command do_rescan \
1914                 -accelerator F5
1915         lappend disable_on_lock \
1916                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1918         .mbar.commit add command -label {Stage To Commit} \
1919                 -command do_add_selection
1920         lappend disable_on_lock \
1921                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1923         .mbar.commit add command -label {Stage Changed Files To Commit} \
1924                 -command do_add_all \
1925                 -accelerator $M1T-I
1926         lappend disable_on_lock \
1927                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1929         .mbar.commit add command -label {Unstage From Commit} \
1930                 -command do_unstage_selection
1931         lappend disable_on_lock \
1932                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1934         .mbar.commit add command -label {Revert Changes} \
1935                 -command do_revert_selection
1936         lappend disable_on_lock \
1937                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1939         .mbar.commit add separator
1941         .mbar.commit add command -label {Sign Off} \
1942                 -command do_signoff \
1943                 -accelerator $M1T-S
1945         .mbar.commit add command -label Commit \
1946                 -command do_commit \
1947                 -accelerator $M1T-Return
1948         lappend disable_on_lock \
1949                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1952 # -- Merge Menu
1954 if {[is_enabled branch]} {
1955         menu .mbar.merge
1956         .mbar.merge add command -label {Local Merge...} \
1957                 -command merge::dialog \
1958                 -accelerator $M1T-M
1959         lappend disable_on_lock \
1960                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1961         .mbar.merge add command -label {Abort Merge...} \
1962                 -command merge::reset_hard
1963         lappend disable_on_lock \
1964                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1967 # -- Transport Menu
1969 if {[is_enabled transport]} {
1970         menu .mbar.fetch
1972         menu .mbar.push
1973         .mbar.push add command -label {Push...} \
1974                 -command do_push_anywhere \
1975                 -accelerator $M1T-P
1976         .mbar.push add command -label {Delete...} \
1977                 -command remote_branch_delete::dialog
1980 if {[is_MacOSX]} {
1981         # -- Apple Menu (Mac OS X only)
1982         #
1983         .mbar add cascade -label Apple -menu .mbar.apple
1984         menu .mbar.apple
1986         .mbar.apple add command -label "About [appname]" \
1987                 -command do_about
1988         .mbar.apple add command -label "Options..." \
1989                 -command do_options
1990 } else {
1991         # -- Edit Menu
1992         #
1993         .mbar.edit add separator
1994         .mbar.edit add command -label {Options...} \
1995                 -command do_options
1998 # -- Help Menu
2000 .mbar add cascade -label Help -menu .mbar.help
2001 menu .mbar.help
2003 if {![is_MacOSX]} {
2004         .mbar.help add command -label "About [appname]" \
2005                 -command do_about
2008 set browser {}
2009 catch {set browser $repo_config(instaweb.browser)}
2010 set doc_path [file dirname [gitexec]]
2011 set doc_path [file join $doc_path Documentation index.html]
2013 if {[is_Cygwin]} {
2014         set doc_path [exec cygpath --mixed $doc_path]
2017 if {$browser eq {}} {
2018         if {[is_MacOSX]} {
2019                 set browser open
2020         } elseif {[is_Cygwin]} {
2021                 set program_files [file dirname [exec cygpath --windir]]
2022                 set program_files [file join $program_files {Program Files}]
2023                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2024                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2025                 if {[file exists $firefox]} {
2026                         set browser $firefox
2027                 } elseif {[file exists $ie]} {
2028                         set browser $ie
2029                 }
2030                 unset program_files firefox ie
2031         }
2034 if {[file isfile $doc_path]} {
2035         set doc_url "file:$doc_path"
2036 } else {
2037         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2040 if {$browser ne {}} {
2041         .mbar.help add command -label {Online Documentation} \
2042                 -command [list exec $browser $doc_url &]
2044 unset browser doc_path doc_url
2046 set root_exists 0
2047 bind . <Visibility> {
2048         bind . <Visibility> {}
2049         set root_exists 1
2052 # -- Standard bindings
2054 wm protocol . WM_DELETE_WINDOW do_quit
2055 bind all <$M1B-Key-q> do_quit
2056 bind all <$M1B-Key-Q> do_quit
2057 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2058 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2060 set subcommand_args {}
2061 proc usage {} {
2062         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2063         exit 1
2066 # -- Not a normal commit type invocation?  Do that instead!
2068 switch -- $subcommand {
2069 browser -
2070 blame {
2071         set subcommand_args {rev? path}
2072         if {$argv eq {}} usage
2073         set head {}
2074         set path {}
2075         set is_path 0
2076         foreach a $argv {
2077                 if {$is_path || [file exists $_prefix$a]} {
2078                         if {$path ne {}} usage
2079                         set path $_prefix$a
2080                         break
2081                 } elseif {$a eq {--}} {
2082                         if {$path ne {}} {
2083                                 if {$head ne {}} usage
2084                                 set head $path
2085                                 set path {}
2086                         }
2087                         set is_path 1
2088                 } elseif {$head eq {}} {
2089                         if {$head ne {}} usage
2090                         set head $a
2091                         set is_path 1
2092                 } else {
2093                         usage
2094                 }
2095         }
2096         unset is_path
2098         if {$head ne {} && $path eq {}} {
2099                 set path $_prefix$head
2100                 set head {}
2101         }
2103         if {$head eq {}} {
2104                 load_current_branch
2105         } else {
2106                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2107                         if {[catch {
2108                                         set head [git rev-parse --verify $head]
2109                                 } err]} {
2110                                 puts stderr $err
2111                                 exit 1
2112                         }
2113                 }
2114                 set current_branch $head
2115         }
2117         switch -- $subcommand {
2118         browser {
2119                 if {$head eq {}} {
2120                         if {$path ne {} && [file isdirectory $path]} {
2121                                 set head $current_branch
2122                         } else {
2123                                 set head $path
2124                                 set path {}
2125                         }
2126                 }
2127                 browser::new $head $path
2128         }
2129         blame   {
2130                 if {$head eq {} && ![file exists $path]} {
2131                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2132                         exit 1
2133                 }
2134                 blame::new $head $path
2135         }
2136         }
2137         return
2139 citool -
2140 gui {
2141         if {[llength $argv] != 0} {
2142                 puts -nonewline stderr "usage: $argv0"
2143                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2144                         puts -nonewline stderr " $subcommand"
2145                 }
2146                 puts stderr {}
2147                 exit 1
2148         }
2149         # fall through to setup UI for commits
2151 default {
2152         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2153         exit 1
2157 # -- Branch Control
2159 frame .branch \
2160         -borderwidth 1 \
2161         -relief sunken
2162 label .branch.l1 \
2163         -text {Current Branch:} \
2164         -anchor w \
2165         -justify left
2166 label .branch.cb \
2167         -textvariable current_branch \
2168         -anchor w \
2169         -justify left
2170 pack .branch.l1 -side left
2171 pack .branch.cb -side left -fill x
2172 pack .branch -side top -fill x
2174 # -- Main Window Layout
2176 panedwindow .vpane -orient vertical
2177 panedwindow .vpane.files -orient horizontal
2178 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2179 pack .vpane -anchor n -side top -fill both -expand 1
2181 # -- Index File List
2183 frame .vpane.files.index -height 100 -width 200
2184 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2185         -background lightgreen
2186 text $ui_index -background white -borderwidth 0 \
2187         -width 20 -height 10 \
2188         -wrap none \
2189         -cursor $cursor_ptr \
2190         -xscrollcommand {.vpane.files.index.sx set} \
2191         -yscrollcommand {.vpane.files.index.sy set} \
2192         -state disabled
2193 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2194 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2195 pack .vpane.files.index.title -side top -fill x
2196 pack .vpane.files.index.sx -side bottom -fill x
2197 pack .vpane.files.index.sy -side right -fill y
2198 pack $ui_index -side left -fill both -expand 1
2199 .vpane.files add .vpane.files.index -sticky nsew
2201 # -- Working Directory File List
2203 frame .vpane.files.workdir -height 100 -width 200
2204 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2205         -background lightsalmon
2206 text $ui_workdir -background white -borderwidth 0 \
2207         -width 20 -height 10 \
2208         -wrap none \
2209         -cursor $cursor_ptr \
2210         -xscrollcommand {.vpane.files.workdir.sx set} \
2211         -yscrollcommand {.vpane.files.workdir.sy set} \
2212         -state disabled
2213 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2214 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2215 pack .vpane.files.workdir.title -side top -fill x
2216 pack .vpane.files.workdir.sx -side bottom -fill x
2217 pack .vpane.files.workdir.sy -side right -fill y
2218 pack $ui_workdir -side left -fill both -expand 1
2219 .vpane.files add .vpane.files.workdir -sticky nsew
2221 foreach i [list $ui_index $ui_workdir] {
2222         rmsel_tag $i
2223         $i tag conf in_diff -background [$i tag cget in_sel -background]
2225 unset i
2227 # -- Diff and Commit Area
2229 frame .vpane.lower -height 300 -width 400
2230 frame .vpane.lower.commarea
2231 frame .vpane.lower.diff -relief sunken -borderwidth 1
2232 pack .vpane.lower.commarea -side top -fill x
2233 pack .vpane.lower.diff -side bottom -fill both -expand 1
2234 .vpane add .vpane.lower -sticky nsew
2236 # -- Commit Area Buttons
2238 frame .vpane.lower.commarea.buttons
2239 label .vpane.lower.commarea.buttons.l -text {} \
2240         -anchor w \
2241         -justify left
2242 pack .vpane.lower.commarea.buttons.l -side top -fill x
2243 pack .vpane.lower.commarea.buttons -side left -fill y
2245 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2246         -command do_rescan
2247 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2248 lappend disable_on_lock \
2249         {.vpane.lower.commarea.buttons.rescan conf -state}
2251 button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2252         -command do_add_all
2253 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2254 lappend disable_on_lock \
2255         {.vpane.lower.commarea.buttons.incall conf -state}
2257 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2258         -command do_signoff
2259 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2261 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2262         -command do_commit
2263 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2264 lappend disable_on_lock \
2265         {.vpane.lower.commarea.buttons.commit conf -state}
2267 button .vpane.lower.commarea.buttons.push -text {Push} \
2268         -command do_push_anywhere
2269 pack .vpane.lower.commarea.buttons.push -side top -fill x
2271 # -- Commit Message Buffer
2273 frame .vpane.lower.commarea.buffer
2274 frame .vpane.lower.commarea.buffer.header
2275 set ui_comm .vpane.lower.commarea.buffer.t
2276 set ui_coml .vpane.lower.commarea.buffer.header.l
2277 radiobutton .vpane.lower.commarea.buffer.header.new \
2278         -text {New Commit} \
2279         -command do_select_commit_type \
2280         -variable selected_commit_type \
2281         -value new
2282 lappend disable_on_lock \
2283         [list .vpane.lower.commarea.buffer.header.new conf -state]
2284 radiobutton .vpane.lower.commarea.buffer.header.amend \
2285         -text {Amend Last Commit} \
2286         -command do_select_commit_type \
2287         -variable selected_commit_type \
2288         -value amend
2289 lappend disable_on_lock \
2290         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2291 label $ui_coml \
2292         -anchor w \
2293         -justify left
2294 proc trace_commit_type {varname args} {
2295         global ui_coml commit_type
2296         switch -glob -- $commit_type {
2297         initial       {set txt {Initial Commit Message:}}
2298         amend         {set txt {Amended Commit Message:}}
2299         amend-initial {set txt {Amended Initial Commit Message:}}
2300         amend-merge   {set txt {Amended Merge Commit Message:}}
2301         merge         {set txt {Merge Commit Message:}}
2302         *             {set txt {Commit Message:}}
2303         }
2304         $ui_coml conf -text $txt
2306 trace add variable commit_type write trace_commit_type
2307 pack $ui_coml -side left -fill x
2308 pack .vpane.lower.commarea.buffer.header.amend -side right
2309 pack .vpane.lower.commarea.buffer.header.new -side right
2311 text $ui_comm -background white -borderwidth 1 \
2312         -undo true \
2313         -maxundo 20 \
2314         -autoseparators true \
2315         -relief sunken \
2316         -width 75 -height 9 -wrap none \
2317         -font font_diff \
2318         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2319 scrollbar .vpane.lower.commarea.buffer.sby \
2320         -command [list $ui_comm yview]
2321 pack .vpane.lower.commarea.buffer.header -side top -fill x
2322 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2323 pack $ui_comm -side left -fill y
2324 pack .vpane.lower.commarea.buffer -side left -fill y
2326 # -- Commit Message Buffer Context Menu
2328 set ctxm .vpane.lower.commarea.buffer.ctxm
2329 menu $ctxm -tearoff 0
2330 $ctxm add command \
2331         -label {Cut} \
2332         -command {tk_textCut $ui_comm}
2333 $ctxm add command \
2334         -label {Copy} \
2335         -command {tk_textCopy $ui_comm}
2336 $ctxm add command \
2337         -label {Paste} \
2338         -command {tk_textPaste $ui_comm}
2339 $ctxm add command \
2340         -label {Delete} \
2341         -command {$ui_comm delete sel.first sel.last}
2342 $ctxm add separator
2343 $ctxm add command \
2344         -label {Select All} \
2345         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2346 $ctxm add command \
2347         -label {Copy All} \
2348         -command {
2349                 $ui_comm tag add sel 0.0 end
2350                 tk_textCopy $ui_comm
2351                 $ui_comm tag remove sel 0.0 end
2352         }
2353 $ctxm add separator
2354 $ctxm add command \
2355         -label {Sign Off} \
2356         -command do_signoff
2357 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2359 # -- Diff Header
2361 proc trace_current_diff_path {varname args} {
2362         global current_diff_path diff_actions file_states
2363         if {$current_diff_path eq {}} {
2364                 set s {}
2365                 set f {}
2366                 set p {}
2367                 set o disabled
2368         } else {
2369                 set p $current_diff_path
2370                 set s [mapdesc [lindex $file_states($p) 0] $p]
2371                 set f {File:}
2372                 set p [escape_path $p]
2373                 set o normal
2374         }
2376         .vpane.lower.diff.header.status configure -text $s
2377         .vpane.lower.diff.header.file configure -text $f
2378         .vpane.lower.diff.header.path configure -text $p
2379         foreach w $diff_actions {
2380                 uplevel #0 $w $o
2381         }
2383 trace add variable current_diff_path write trace_current_diff_path
2385 frame .vpane.lower.diff.header -background gold
2386 label .vpane.lower.diff.header.status \
2387         -background gold \
2388         -width $max_status_desc \
2389         -anchor w \
2390         -justify left
2391 label .vpane.lower.diff.header.file \
2392         -background gold \
2393         -anchor w \
2394         -justify left
2395 label .vpane.lower.diff.header.path \
2396         -background gold \
2397         -anchor w \
2398         -justify left
2399 pack .vpane.lower.diff.header.status -side left
2400 pack .vpane.lower.diff.header.file -side left
2401 pack .vpane.lower.diff.header.path -fill x
2402 set ctxm .vpane.lower.diff.header.ctxm
2403 menu $ctxm -tearoff 0
2404 $ctxm add command \
2405         -label {Copy} \
2406         -command {
2407                 clipboard clear
2408                 clipboard append \
2409                         -format STRING \
2410                         -type STRING \
2411                         -- $current_diff_path
2412         }
2413 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2414 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2416 # -- Diff Body
2418 frame .vpane.lower.diff.body
2419 set ui_diff .vpane.lower.diff.body.t
2420 text $ui_diff -background white -borderwidth 0 \
2421         -width 80 -height 15 -wrap none \
2422         -font font_diff \
2423         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2424         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2425         -state disabled
2426 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2427         -command [list $ui_diff xview]
2428 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2429         -command [list $ui_diff yview]
2430 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2431 pack .vpane.lower.diff.body.sby -side right -fill y
2432 pack $ui_diff -side left -fill both -expand 1
2433 pack .vpane.lower.diff.header -side top -fill x
2434 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2436 $ui_diff tag conf d_cr -elide true
2437 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2438 $ui_diff tag conf d_+ -foreground {#00a000}
2439 $ui_diff tag conf d_- -foreground red
2441 $ui_diff tag conf d_++ -foreground {#00a000}
2442 $ui_diff tag conf d_-- -foreground red
2443 $ui_diff tag conf d_+s \
2444         -foreground {#00a000} \
2445         -background {#e2effa}
2446 $ui_diff tag conf d_-s \
2447         -foreground red \
2448         -background {#e2effa}
2449 $ui_diff tag conf d_s+ \
2450         -foreground {#00a000} \
2451         -background ivory1
2452 $ui_diff tag conf d_s- \
2453         -foreground red \
2454         -background ivory1
2456 $ui_diff tag conf d<<<<<<< \
2457         -foreground orange \
2458         -font font_diffbold
2459 $ui_diff tag conf d======= \
2460         -foreground orange \
2461         -font font_diffbold
2462 $ui_diff tag conf d>>>>>>> \
2463         -foreground orange \
2464         -font font_diffbold
2466 $ui_diff tag raise sel
2468 # -- Diff Body Context Menu
2470 set ctxm .vpane.lower.diff.body.ctxm
2471 menu $ctxm -tearoff 0
2472 $ctxm add command \
2473         -label {Refresh} \
2474         -command reshow_diff
2475 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2476 $ctxm add command \
2477         -label {Copy} \
2478         -command {tk_textCopy $ui_diff}
2479 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2480 $ctxm add command \
2481         -label {Select All} \
2482         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2483 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2484 $ctxm add command \
2485         -label {Copy All} \
2486         -command {
2487                 $ui_diff tag add sel 0.0 end
2488                 tk_textCopy $ui_diff
2489                 $ui_diff tag remove sel 0.0 end
2490         }
2491 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2492 $ctxm add separator
2493 $ctxm add command \
2494         -label {Apply/Reverse Hunk} \
2495         -command {apply_hunk $cursorX $cursorY}
2496 set ui_diff_applyhunk [$ctxm index last]
2497 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2498 $ctxm add separator
2499 $ctxm add command \
2500         -label {Decrease Font Size} \
2501         -command {incr_font_size font_diff -1}
2502 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2503 $ctxm add command \
2504         -label {Increase Font Size} \
2505         -command {incr_font_size font_diff 1}
2506 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2507 $ctxm add separator
2508 $ctxm add command \
2509         -label {Show Less Context} \
2510         -command {if {$repo_config(gui.diffcontext) >= 1} {
2511                 incr repo_config(gui.diffcontext) -1
2512                 reshow_diff
2513         }}
2514 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2515 $ctxm add command \
2516         -label {Show More Context} \
2517         -command {if {$repo_config(gui.diffcontext) < 99} {
2518                 incr repo_config(gui.diffcontext)
2519                 reshow_diff
2520         }}
2521 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2522 $ctxm add separator
2523 $ctxm add command -label {Options...} \
2524         -command do_options
2525 proc popup_diff_menu {ctxm x y X Y} {
2526         global current_diff_path file_states
2527         set ::cursorX $x
2528         set ::cursorY $y
2529         if {$::ui_index eq $::current_diff_side} {
2530                 set l "Unstage Hunk From Commit"
2531         } else {
2532                 set l "Stage Hunk For Commit"
2533         }
2534         if {$::is_3way_diff
2535                 || $current_diff_path eq {}
2536                 || ![info exists file_states($current_diff_path)]
2537                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2538                 set s disabled
2539         } else {
2540                 set s normal
2541         }
2542         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2543         tk_popup $ctxm $X $Y
2545 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2547 # -- Status Bar
2549 set main_status [::status_bar::new .status]
2550 pack .status -anchor w -side bottom -fill x
2551 $main_status show {Initializing...}
2553 # -- Load geometry
2555 catch {
2556 set gm $repo_config(gui.geometry)
2557 wm geometry . [lindex $gm 0]
2558 .vpane sash place 0 \
2559         [lindex [.vpane sash coord 0] 0] \
2560         [lindex $gm 1]
2561 .vpane.files sash place 0 \
2562         [lindex $gm 2] \
2563         [lindex [.vpane.files sash coord 0] 1]
2564 unset gm
2567 # -- Key Bindings
2569 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2570 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2571 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2572 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2573 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2574 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2575 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2576 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2577 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2578 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2579 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2581 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2582 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2583 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2584 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2585 bind $ui_diff <$M1B-Key-v> {break}
2586 bind $ui_diff <$M1B-Key-V> {break}
2587 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2588 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2589 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2590 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2591 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2592 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2593 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2594 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2595 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2596 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2597 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2598 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2599 bind $ui_diff <Button-1>   {focus %W}
2601 if {[is_enabled branch]} {
2602         bind . <$M1B-Key-n> branch_create::dialog
2603         bind . <$M1B-Key-N> branch_create::dialog
2604         bind . <$M1B-Key-o> branch_checkout::dialog
2605         bind . <$M1B-Key-O> branch_checkout::dialog
2606         bind . <$M1B-Key-m> merge::dialog
2607         bind . <$M1B-Key-M> merge::dialog
2609 if {[is_enabled transport]} {
2610         bind . <$M1B-Key-p> do_push_anywhere
2611         bind . <$M1B-Key-P> do_push_anywhere
2614 bind .   <Key-F5>     do_rescan
2615 bind .   <$M1B-Key-r> do_rescan
2616 bind .   <$M1B-Key-R> do_rescan
2617 bind .   <$M1B-Key-s> do_signoff
2618 bind .   <$M1B-Key-S> do_signoff
2619 bind .   <$M1B-Key-i> do_add_all
2620 bind .   <$M1B-Key-I> do_add_all
2621 bind .   <$M1B-Key-Return> do_commit
2622 foreach i [list $ui_index $ui_workdir] {
2623         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2624         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2625         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2627 unset i
2629 set file_lists($ui_index) [list]
2630 set file_lists($ui_workdir) [list]
2632 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2633 focus -force $ui_comm
2635 # -- Warn the user about environmental problems.  Cygwin's Tcl
2636 #    does *not* pass its env array onto any processes it spawns.
2637 #    This means that git processes get none of our environment.
2639 if {[is_Cygwin]} {
2640         set ignored_env 0
2641         set suggest_user {}
2642         set msg "Possible environment issues exist.
2644 The following environment variables are probably
2645 going to be ignored by any Git subprocess run
2646 by [appname]:
2649         foreach name [array names env] {
2650                 switch -regexp -- $name {
2651                 {^GIT_INDEX_FILE$} -
2652                 {^GIT_OBJECT_DIRECTORY$} -
2653                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2654                 {^GIT_DIFF_OPTS$} -
2655                 {^GIT_EXTERNAL_DIFF$} -
2656                 {^GIT_PAGER$} -
2657                 {^GIT_TRACE$} -
2658                 {^GIT_CONFIG$} -
2659                 {^GIT_CONFIG_LOCAL$} -
2660                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2661                         append msg " - $name\n"
2662                         incr ignored_env
2663                 }
2664                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2665                         append msg " - $name\n"
2666                         incr ignored_env
2667                         set suggest_user $name
2668                 }
2669                 }
2670         }
2671         if {$ignored_env > 0} {
2672                 append msg "
2673 This is due to a known issue with the
2674 Tcl binary distributed by Cygwin."
2676                 if {$suggest_user ne {}} {
2677                         append msg "
2679 A good replacement for $suggest_user
2680 is placing values for the user.name and
2681 user.email settings into your personal
2682 ~/.gitconfig file.
2684                 }
2685                 warn_popup $msg
2686         }
2687         unset ignored_env msg suggest_user name
2690 # -- Only initialize complex UI if we are going to stay running.
2692 if {[is_enabled transport]} {
2693         load_all_remotes
2695         populate_fetch_menu
2696         populate_push_menu
2699 if {[winfo exists $ui_comm]} {
2700         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2702         # -- If both our backup and message files exist use the
2703         #    newer of the two files to initialize the buffer.
2704         #
2705         if {$GITGUI_BCK_exists} {
2706                 set m [gitdir GITGUI_MSG]
2707                 if {[file isfile $m]} {
2708                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2709                                 catch {file delete [gitdir GITGUI_MSG]}
2710                         } else {
2711                                 $ui_comm delete 0.0 end
2712                                 $ui_comm edit reset
2713                                 $ui_comm edit modified false
2714                                 catch {file delete [gitdir GITGUI_BCK]}
2715                                 set GITGUI_BCK_exists 0
2716                         }
2717                 }
2718                 unset m
2719         }
2721         proc backup_commit_buffer {} {
2722                 global ui_comm GITGUI_BCK_exists
2724                 set m [$ui_comm edit modified]
2725                 if {$m || $GITGUI_BCK_exists} {
2726                         set msg [string trim [$ui_comm get 0.0 end]]
2727                         regsub -all -line {[ \r\t]+$} $msg {} msg
2729                         if {$msg eq {}} {
2730                                 if {$GITGUI_BCK_exists} {
2731                                         catch {file delete [gitdir GITGUI_BCK]}
2732                                         set GITGUI_BCK_exists 0
2733                                 }
2734                         } elseif {$m} {
2735                                 catch {
2736                                         set fd [open [gitdir GITGUI_BCK] w]
2737                                         puts -nonewline $fd $msg
2738                                         close $fd
2739                                         set GITGUI_BCK_exists 1
2740                                 }
2741                         }
2743                         $ui_comm edit modified false
2744                 }
2746                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2747         }
2749         backup_commit_buffer
2752 lock_index begin-read
2753 if {![winfo ismapped .]} {
2754         wm deiconify .
2756 after 1 do_rescan
2757 if {[is_enabled multicommit]} {
2758         after 1000 hint_gc