Code

git-gui: Bind Meta-T for "Stage To Commit" menu action
[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  argv0=$0; \
10  exec wish "$argv0" -- "$@"
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [encoding convertfrom utf-8 {
14 Copyright © 2006, 2007 Shawn Pearce, et. al.
16 This program is free software; you can redistribute it and/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation; either version 2 of the License, or
19 (at your option) any later version.
21 This program is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program; if not, write to the Free Software
28 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}]
30 ######################################################################
31 ##
32 ## Tcl/Tk sanity check
34 if {[catch {package require Tcl 8.4} err]
35  || [catch {package require Tk  8.4} err]
36 } {
37         catch {wm withdraw .}
38         tk_messageBox \
39                 -icon error \
40                 -type ok \
41                 -title [mc "git-gui: fatal error"] \
42                 -message $err
43         exit 1
44 }
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
49 ##
50 ## locate our library
52 set oguilib {@@GITGUI_LIBDIR@@}
53 set oguirel {@@GITGUI_RELATIVE@@}
54 if {$oguirel eq {1}} {
55         set oguilib [file dirname [file dirname [file normalize $argv0]]]
56         set oguilib [file join $oguilib share git-gui lib]
57         set oguimsg [file join $oguilib msgs]
58 } elseif {[string match @@* $oguirel]} {
59         set oguilib [file join [file dirname [file normalize $argv0]] lib]
60         set oguimsg [file join [file dirname [file normalize $argv0]] po]
61 } else {
62         set oguimsg [file join $oguilib msgs]
63 }
64 unset oguirel
66 ######################################################################
67 ##
68 ## enable verbose loading?
70 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
71         unset _verbose
72         rename auto_load real__auto_load
73         proc auto_load {name args} {
74                 puts stderr "auto_load $name"
75                 return [uplevel 1 real__auto_load $name $args]
76         }
77         rename source real__source
78         proc source {name} {
79                 puts stderr "source    $name"
80                 uplevel 1 real__source $name
81         }
82 }
84 ######################################################################
85 ##
86 ## Internationalization (i18n) through msgcat and gettext. See
87 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
89 package require msgcat
91 proc _mc_trim {fmt} {
92         set cmk [string first @@ $fmt]
93         if {$cmk > 0} {
94                 return [string range $fmt 0 [expr {$cmk - 1}]]
95         }
96         return $fmt
97 }
99 proc mc {en_fmt args} {
100         set fmt [_mc_trim [::msgcat::mc $en_fmt]]
101         if {[catch {set msg [eval [list format $fmt] $args]} err]} {
102                 set msg [eval [list format [_mc_trim $en_fmt]] $args]
103         }
104         return $msg
107 proc strcat {args} {
108         return [join $args {}]
111 ::msgcat::mcload $oguimsg
112 unset oguimsg
114 ######################################################################
115 ##
116 ## read only globals
118 set _appname {Git Gui}
119 set _gitdir {}
120 set _gitexec {}
121 set _reponame {}
122 set _iscygwin {}
123 set _search_path {}
125 proc appname {} {
126         global _appname
127         return $_appname
130 proc gitdir {args} {
131         global _gitdir
132         if {$args eq {}} {
133                 return $_gitdir
134         }
135         return [eval [list file join $_gitdir] $args]
138 proc gitexec {args} {
139         global _gitexec
140         if {$_gitexec eq {}} {
141                 if {[catch {set _gitexec [git --exec-path]} err]} {
142                         error "Git not installed?\n\n$err"
143                 }
144                 if {[is_Cygwin]} {
145                         set _gitexec [exec cygpath \
146                                 --windows \
147                                 --absolute \
148                                 $_gitexec]
149                 } else {
150                         set _gitexec [file normalize $_gitexec]
151                 }
152         }
153         if {$args eq {}} {
154                 return $_gitexec
155         }
156         return [eval [list file join $_gitexec] $args]
159 proc reponame {} {
160         return $::_reponame
163 proc is_MacOSX {} {
164         if {[tk windowingsystem] eq {aqua}} {
165                 return 1
166         }
167         return 0
170 proc is_Windows {} {
171         if {$::tcl_platform(platform) eq {windows}} {
172                 return 1
173         }
174         return 0
177 proc is_Cygwin {} {
178         global _iscygwin
179         if {$_iscygwin eq {}} {
180                 if {$::tcl_platform(platform) eq {windows}} {
181                         if {[catch {set p [exec cygpath --windir]} err]} {
182                                 set _iscygwin 0
183                         } else {
184                                 set _iscygwin 1
185                         }
186                 } else {
187                         set _iscygwin 0
188                 }
189         }
190         return $_iscygwin
193 proc is_enabled {option} {
194         global enabled_options
195         if {[catch {set on $enabled_options($option)}]} {return 0}
196         return $on
199 proc enable_option {option} {
200         global enabled_options
201         set enabled_options($option) 1
204 proc disable_option {option} {
205         global enabled_options
206         set enabled_options($option) 0
209 ######################################################################
210 ##
211 ## config
213 proc is_many_config {name} {
214         switch -glob -- $name {
215         gui.recentrepo -
216         remote.*.fetch -
217         remote.*.push
218                 {return 1}
219         *
220                 {return 0}
221         }
224 proc is_config_true {name} {
225         global repo_config
226         if {[catch {set v $repo_config($name)}]} {
227                 return 0
228         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
229                 return 1
230         } else {
231                 return 0
232         }
235 proc get_config {name} {
236         global repo_config
237         if {[catch {set v $repo_config($name)}]} {
238                 return {}
239         } else {
240                 return $v
241         }
244 ######################################################################
245 ##
246 ## handy utils
248 proc _git_cmd {name} {
249         global _git_cmd_path
251         if {[catch {set v $_git_cmd_path($name)}]} {
252                 switch -- $name {
253                   version   -
254                 --version   -
255                 --exec-path { return [list $::_git $name] }
256                 }
258                 set p [gitexec git-$name$::_search_exe]
259                 if {[file exists $p]} {
260                         set v [list $p]
261                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
262                         # Try to determine what sort of magic will make
263                         # git-$name go and do its thing, because native
264                         # Tcl on Windows doesn't know it.
265                         #
266                         set p [gitexec git-$name]
267                         set f [open $p r]
268                         set s [gets $f]
269                         close $f
271                         switch -glob -- [lindex $s 0] {
272                         #!*sh     { set i sh     }
273                         #!*perl   { set i perl   }
274                         #!*python { set i python }
275                         default   { error "git-$name is not supported: $s" }
276                         }
278                         upvar #0 _$i interp
279                         if {![info exists interp]} {
280                                 set interp [_which $i]
281                         }
282                         if {$interp eq {}} {
283                                 error "git-$name requires $i (not in PATH)"
284                         }
285                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
286                 } else {
287                         # Assume it is builtin to git somehow and we
288                         # aren't actually able to see a file for it.
289                         #
290                         set v [list $::_git $name]
291                 }
292                 set _git_cmd_path($name) $v
293         }
294         return $v
297 proc _which {what} {
298         global env _search_exe _search_path
300         if {$_search_path eq {}} {
301                 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
302                         set _search_path [split [exec cygpath \
303                                 --windows \
304                                 --path \
305                                 --absolute \
306                                 $env(PATH)] {;}]
307                         set _search_exe .exe
308                 } elseif {[is_Windows]} {
309                         set gitguidir [file dirname [info script]]
310                         regsub -all ";" $gitguidir "\\;" gitguidir
311                         set env(PATH) "$gitguidir;$env(PATH)"
312                         set _search_path [split $env(PATH) {;}]
313                         set _search_exe .exe
314                 } else {
315                         set _search_path [split $env(PATH) :]
316                         set _search_exe {}
317                 }
318         }
320         foreach p $_search_path {
321                 set p [file join $p $what$_search_exe]
322                 if {[file exists $p]} {
323                         return [file normalize $p]
324                 }
325         }
326         return {}
329 proc _lappend_nice {cmd_var} {
330         global _nice
331         upvar $cmd_var cmd
333         if {![info exists _nice]} {
334                 set _nice [_which nice]
335         }
336         if {$_nice ne {}} {
337                 lappend cmd $_nice
338         }
341 proc git {args} {
342         set opt [list exec]
344         while {1} {
345                 switch -- [lindex $args 0] {
346                 --nice {
347                         _lappend_nice opt
348                 }
350                 default {
351                         break
352                 }
354                 }
356                 set args [lrange $args 1 end]
357         }
359         set cmdp [_git_cmd [lindex $args 0]]
360         set args [lrange $args 1 end]
362         return [eval $opt $cmdp $args]
365 proc _open_stdout_stderr {cmd} {
366         if {[catch {
367                         set fd [open $cmd r]
368                 } err]} {
369                 if {   [lindex $cmd end] eq {2>@1}
370                     && $err eq {can not find channel named "1"}
371                         } {
372                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
373                         # redirect operator.  Fallback to |& cat for those.
374                         # The command was not actually started, so its safe
375                         # to try to start it a second time.
376                         #
377                         set fd [open [concat \
378                                 [lrange $cmd 0 end-1] \
379                                 [list |& cat] \
380                                 ] r]
381                 } else {
382                         error $err
383                 }
384         }
385         fconfigure $fd -eofchar {}
386         return $fd
389 proc git_read {args} {
390         set opt [list |]
392         while {1} {
393                 switch -- [lindex $args 0] {
394                 --nice {
395                         _lappend_nice opt
396                 }
398                 --stderr {
399                         lappend args 2>@1
400                 }
402                 default {
403                         break
404                 }
406                 }
408                 set args [lrange $args 1 end]
409         }
411         set cmdp [_git_cmd [lindex $args 0]]
412         set args [lrange $args 1 end]
414         return [_open_stdout_stderr [concat $opt $cmdp $args]]
417 proc git_write {args} {
418         set opt [list |]
420         while {1} {
421                 switch -- [lindex $args 0] {
422                 --nice {
423                         _lappend_nice opt
424                 }
426                 default {
427                         break
428                 }
430                 }
432                 set args [lrange $args 1 end]
433         }
435         set cmdp [_git_cmd [lindex $args 0]]
436         set args [lrange $args 1 end]
438         return [open [concat $opt $cmdp $args] w]
441 proc sq {value} {
442         regsub -all ' $value "'\\''" value
443         return "'$value'"
446 proc load_current_branch {} {
447         global current_branch is_detached
449         set fd [open [gitdir HEAD] r]
450         if {[gets $fd ref] < 1} {
451                 set ref {}
452         }
453         close $fd
455         set pfx {ref: refs/heads/}
456         set len [string length $pfx]
457         if {[string equal -length $len $pfx $ref]} {
458                 # We're on a branch.  It might not exist.  But
459                 # HEAD looks good enough to be a branch.
460                 #
461                 set current_branch [string range $ref $len end]
462                 set is_detached 0
463         } else {
464                 # Assume this is a detached head.
465                 #
466                 set current_branch HEAD
467                 set is_detached 1
468         }
471 auto_load tk_optionMenu
472 rename tk_optionMenu real__tkOptionMenu
473 proc tk_optionMenu {w varName args} {
474         set m [eval real__tkOptionMenu $w $varName $args]
475         $m configure -font font_ui
476         $w configure -font font_ui
477         return $m
480 proc rmsel_tag {text} {
481         $text tag conf sel \
482                 -background [$text cget -background] \
483                 -foreground [$text cget -foreground] \
484                 -borderwidth 0
485         $text tag conf in_sel -background lightgray
486         bind $text <Motion> break
487         return $text
490 set root_exists 0
491 bind . <Visibility> {
492         bind . <Visibility> {}
493         set root_exists 1
496 if {[is_Windows]} {
497         wm iconbitmap . -default $oguilib/git-gui.ico
500 ######################################################################
501 ##
502 ## config defaults
504 set cursor_ptr arrow
505 font create font_diff -family Courier -size 10
506 font create font_ui
507 catch {
508         label .dummy
509         eval font configure font_ui [font actual [.dummy cget -font]]
510         destroy .dummy
513 font create font_uiitalic
514 font create font_uibold
515 font create font_diffbold
516 font create font_diffitalic
518 foreach class {Button Checkbutton Entry Label
519                 Labelframe Listbox Menu Message
520                 Radiobutton Spinbox Text} {
521         option add *$class.font font_ui
523 unset class
525 if {[is_Windows] || [is_MacOSX]} {
526         option add *Menu.tearOff 0
529 if {[is_MacOSX]} {
530         set M1B M1
531         set M1T Cmd
532 } else {
533         set M1B Control
534         set M1T Ctrl
537 proc bind_button3 {w cmd} {
538         bind $w <Any-Button-3> $cmd
539         if {[is_MacOSX]} {
540                 # Mac OS X sends Button-2 on right click through three-button mouse,
541                 # or through trackpad right-clicking (two-finger touch + click).
542                 bind $w <Any-Button-2> $cmd
543                 bind $w <Control-Button-1> $cmd
544         }
547 proc apply_config {} {
548         global repo_config font_descs
550         foreach option $font_descs {
551                 set name [lindex $option 0]
552                 set font [lindex $option 1]
553                 if {[catch {
554                         set need_weight 1
555                         foreach {cn cv} $repo_config(gui.$name) {
556                                 if {$cn eq {-weight}} {
557                                         set need_weight 0
558                                 }
559                                 font configure $font $cn $cv
560                         }
561                         if {$need_weight} {
562                                 font configure $font -weight normal
563                         }
564                         } err]} {
565                         error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
566                 }
567                 foreach {cn cv} [font configure $font] {
568                         font configure ${font}bold $cn $cv
569                         font configure ${font}italic $cn $cv
570                 }
571                 font configure ${font}bold -weight bold
572                 font configure ${font}italic -slant italic
573         }
576 set default_config(merge.diffstat) true
577 set default_config(merge.summary) false
578 set default_config(merge.verbosity) 2
579 set default_config(user.name) {}
580 set default_config(user.email) {}
582 set default_config(gui.matchtrackingbranch) false
583 set default_config(gui.pruneduringfetch) false
584 set default_config(gui.trustmtime) false
585 set default_config(gui.diffcontext) 5
586 set default_config(gui.newbranchtemplate) {}
587 set default_config(gui.fontui) [font configure font_ui]
588 set default_config(gui.fontdiff) [font configure font_diff]
589 set font_descs {
590         {fontui   font_ui   {mc "Main Font"}}
591         {fontdiff font_diff {mc "Diff/Console Font"}}
594 ######################################################################
595 ##
596 ## find git
598 set _git  [_which git]
599 if {$_git eq {}} {
600         catch {wm withdraw .}
601         tk_messageBox \
602                 -icon error \
603                 -type ok \
604                 -title [mc "git-gui: fatal error"] \
605                 -message [mc "Cannot find git in PATH."]
606         exit 1
609 ######################################################################
610 ##
611 ## version check
613 if {[catch {set _git_version [git --version]} err]} {
614         catch {wm withdraw .}
615         tk_messageBox \
616                 -icon error \
617                 -type ok \
618                 -title [mc "git-gui: fatal error"] \
619                 -message "Cannot determine Git version:
621 $err
623 [appname] requires Git 1.5.0 or later."
624         exit 1
626 if {![regsub {^git version } $_git_version {} _git_version]} {
627         catch {wm withdraw .}
628         tk_messageBox \
629                 -icon error \
630                 -type ok \
631                 -title [mc "git-gui: fatal error"] \
632                 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
633         exit 1
636 set _real_git_version $_git_version
637 regsub -- {-dirty$} $_git_version {} _git_version
638 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
639 regsub {\.rc[0-9]+$} $_git_version {} _git_version
640 regsub {\.GIT$} $_git_version {} _git_version
641 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
643 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
644         catch {wm withdraw .}
645         if {[tk_messageBox \
646                 -icon warning \
647                 -type yesno \
648                 -default no \
649                 -title "[appname]: warning" \
650                  -message [mc "Git version cannot be determined.
652 %s claims it is version '%s'.
654 %s requires at least Git 1.5.0 or later.
656 Assume '%s' is version 1.5.0?
657 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
658                 set _git_version 1.5.0
659         } else {
660                 exit 1
661         }
663 unset _real_git_version
665 proc git-version {args} {
666         global _git_version
668         switch [llength $args] {
669         0 {
670                 return $_git_version
671         }
673         2 {
674                 set op [lindex $args 0]
675                 set vr [lindex $args 1]
676                 set cm [package vcompare $_git_version $vr]
677                 return [expr $cm $op 0]
678         }
680         4 {
681                 set type [lindex $args 0]
682                 set name [lindex $args 1]
683                 set parm [lindex $args 2]
684                 set body [lindex $args 3]
686                 if {($type ne {proc} && $type ne {method})} {
687                         error "Invalid arguments to git-version"
688                 }
689                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
690                         error "Last arm of $type $name must be default"
691                 }
693                 foreach {op vr cb} [lrange $body 0 end-2] {
694                         if {[git-version $op $vr]} {
695                                 return [uplevel [list $type $name $parm $cb]]
696                         }
697                 }
699                 return [uplevel [list $type $name $parm [lindex $body end]]]
700         }
702         default {
703                 error "git-version >= x"
704         }
706         }
709 if {[git-version < 1.5]} {
710         catch {wm withdraw .}
711         tk_messageBox \
712                 -icon error \
713                 -type ok \
714                 -title [mc "git-gui: fatal error"] \
715                 -message "[appname] requires Git 1.5.0 or later.
717 You are using [git-version]:
719 [git --version]"
720         exit 1
723 ######################################################################
724 ##
725 ## configure our library
727 set idx [file join $oguilib tclIndex]
728 if {[catch {set fd [open $idx r]} err]} {
729         catch {wm withdraw .}
730         tk_messageBox \
731                 -icon error \
732                 -type ok \
733                 -title [mc "git-gui: fatal error"] \
734                 -message $err
735         exit 1
737 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
738         set idx [list]
739         while {[gets $fd n] >= 0} {
740                 if {$n ne {} && ![string match #* $n]} {
741                         lappend idx $n
742                 }
743         }
744 } else {
745         set idx {}
747 close $fd
749 if {$idx ne {}} {
750         set loaded [list]
751         foreach p $idx {
752                 if {[lsearch -exact $loaded $p] >= 0} continue
753                 source [file join $oguilib $p]
754                 lappend loaded $p
755         }
756         unset loaded p
757 } else {
758         set auto_path [concat [list $oguilib] $auto_path]
760 unset -nocomplain idx fd
762 ######################################################################
763 ##
764 ## config file parsing
766 git-version proc _parse_config {arr_name args} {
767         >= 1.5.3 {
768                 upvar $arr_name arr
769                 array unset arr
770                 set buf {}
771                 catch {
772                         set fd_rc [eval \
773                                 [list git_read config] \
774                                 $args \
775                                 [list --null --list]]
776                         fconfigure $fd_rc -translation binary
777                         set buf [read $fd_rc]
778                         close $fd_rc
779                 }
780                 foreach line [split $buf "\0"] {
781                         if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
782                                 if {[is_many_config $name]} {
783                                         lappend arr($name) $value
784                                 } else {
785                                         set arr($name) $value
786                                 }
787                         }
788                 }
789         }
790         default {
791                 upvar $arr_name arr
792                 array unset arr
793                 catch {
794                         set fd_rc [eval [list git_read config --list] $args]
795                         while {[gets $fd_rc line] >= 0} {
796                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
797                                         if {[is_many_config $name]} {
798                                                 lappend arr($name) $value
799                                         } else {
800                                                 set arr($name) $value
801                                         }
802                                 }
803                         }
804                         close $fd_rc
805                 }
806         }
809 proc load_config {include_global} {
810         global repo_config global_config default_config
812         if {$include_global} {
813                 _parse_config global_config --global
814         }
815         _parse_config repo_config
817         foreach name [array names default_config] {
818                 if {[catch {set v $global_config($name)}]} {
819                         set global_config($name) $default_config($name)
820                 }
821                 if {[catch {set v $repo_config($name)}]} {
822                         set repo_config($name) $default_config($name)
823                 }
824         }
827 ######################################################################
828 ##
829 ## feature option selection
831 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
832         unset _junk
833 } else {
834         set subcommand gui
836 if {$subcommand eq {gui.sh}} {
837         set subcommand gui
839 if {$subcommand eq {gui} && [llength $argv] > 0} {
840         set subcommand [lindex $argv 0]
841         set argv [lrange $argv 1 end]
844 enable_option multicommit
845 enable_option branch
846 enable_option transport
847 disable_option bare
849 switch -- $subcommand {
850 browser -
851 blame {
852         enable_option bare
854         disable_option multicommit
855         disable_option branch
856         disable_option transport
858 citool {
859         enable_option singlecommit
861         disable_option multicommit
862         disable_option branch
863         disable_option transport
867 ######################################################################
868 ##
869 ## repository setup
871 if {[catch {
872                 set _gitdir $env(GIT_DIR)
873                 set _prefix {}
874                 }]
875         && [catch {
876                 set _gitdir [git rev-parse --git-dir]
877                 set _prefix [git rev-parse --show-prefix]
878         } err]} {
879         load_config 1
880         apply_config
881         choose_repository::pick
883 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
884         catch {set _gitdir [exec cygpath --windows $_gitdir]}
886 if {![file isdirectory $_gitdir]} {
887         catch {wm withdraw .}
888         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
889         exit 1
891 if {$_prefix ne {}} {
892         regsub -all {[^/]+/} $_prefix ../ cdup
893         if {[catch {cd $cdup} err]} {
894                 catch {wm withdraw .}
895                 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
896                 exit 1
897         }
898         unset cdup
899 } elseif {![is_enabled bare]} {
900         if {[lindex [file split $_gitdir] end] ne {.git}} {
901                 catch {wm withdraw .}
902                 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
903                 exit 1
904         }
905         if {[catch {cd [file dirname $_gitdir]} err]} {
906                 catch {wm withdraw .}
907                 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
908                 exit 1
909         }
911 set _reponame [file split [file normalize $_gitdir]]
912 if {[lindex $_reponame end] eq {.git}} {
913         set _reponame [lindex $_reponame end-1]
914 } else {
915         set _reponame [lindex $_reponame end]
918 ######################################################################
919 ##
920 ## global init
922 set current_diff_path {}
923 set current_diff_side {}
924 set diff_actions [list]
926 set HEAD {}
927 set PARENT {}
928 set MERGE_HEAD [list]
929 set commit_type {}
930 set empty_tree {}
931 set current_branch {}
932 set is_detached 0
933 set current_diff_path {}
934 set is_3way_diff 0
935 set selected_commit_type new
937 ######################################################################
938 ##
939 ## task management
941 set rescan_active 0
942 set diff_active 0
943 set last_clicked {}
945 set disable_on_lock [list]
946 set index_lock_type none
948 proc lock_index {type} {
949         global index_lock_type disable_on_lock
951         if {$index_lock_type eq {none}} {
952                 set index_lock_type $type
953                 foreach w $disable_on_lock {
954                         uplevel #0 $w disabled
955                 }
956                 return 1
957         } elseif {$index_lock_type eq "begin-$type"} {
958                 set index_lock_type $type
959                 return 1
960         }
961         return 0
964 proc unlock_index {} {
965         global index_lock_type disable_on_lock
967         set index_lock_type none
968         foreach w $disable_on_lock {
969                 uplevel #0 $w normal
970         }
973 ######################################################################
974 ##
975 ## status
977 proc repository_state {ctvar hdvar mhvar} {
978         global current_branch
979         upvar $ctvar ct $hdvar hd $mhvar mh
981         set mh [list]
983         load_current_branch
984         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
985                 set hd {}
986                 set ct initial
987                 return
988         }
990         set merge_head [gitdir MERGE_HEAD]
991         if {[file exists $merge_head]} {
992                 set ct merge
993                 set fd_mh [open $merge_head r]
994                 while {[gets $fd_mh line] >= 0} {
995                         lappend mh $line
996                 }
997                 close $fd_mh
998                 return
999         }
1001         set ct normal
1004 proc PARENT {} {
1005         global PARENT empty_tree
1007         set p [lindex $PARENT 0]
1008         if {$p ne {}} {
1009                 return $p
1010         }
1011         if {$empty_tree eq {}} {
1012                 set empty_tree [git mktree << {}]
1013         }
1014         return $empty_tree
1017 proc rescan {after {honor_trustmtime 1}} {
1018         global HEAD PARENT MERGE_HEAD commit_type
1019         global ui_index ui_workdir ui_comm
1020         global rescan_active file_states
1021         global repo_config
1023         if {$rescan_active > 0 || ![lock_index read]} return
1025         repository_state newType newHEAD newMERGE_HEAD
1026         if {[string match amend* $commit_type]
1027                 && $newType eq {normal}
1028                 && $newHEAD eq $HEAD} {
1029         } else {
1030                 set HEAD $newHEAD
1031                 set PARENT $newHEAD
1032                 set MERGE_HEAD $newMERGE_HEAD
1033                 set commit_type $newType
1034         }
1036         array unset file_states
1038         if {!$::GITGUI_BCK_exists &&
1039                 (![$ui_comm edit modified]
1040                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1041                 if {[string match amend* $commit_type]} {
1042                 } elseif {[load_message GITGUI_MSG]} {
1043                 } elseif {[load_message MERGE_MSG]} {
1044                 } elseif {[load_message SQUASH_MSG]} {
1045                 }
1046                 $ui_comm edit reset
1047                 $ui_comm edit modified false
1048         }
1050         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1051                 rescan_stage2 {} $after
1052         } else {
1053                 set rescan_active 1
1054                 ui_status [mc "Refreshing file status..."]
1055                 set fd_rf [git_read update-index \
1056                         -q \
1057                         --unmerged \
1058                         --ignore-missing \
1059                         --refresh \
1060                         ]
1061                 fconfigure $fd_rf -blocking 0 -translation binary
1062                 fileevent $fd_rf readable \
1063                         [list rescan_stage2 $fd_rf $after]
1064         }
1067 if {[is_Cygwin]} {
1068         set is_git_info_link {}
1069         set is_git_info_exclude {}
1070         proc have_info_exclude {} {
1071                 global is_git_info_link is_git_info_exclude
1073                 if {$is_git_info_link eq {}} {
1074                         set is_git_info_link [file isfile [gitdir info.lnk]]
1075                 }
1077                 if {$is_git_info_link} {
1078                         if {$is_git_info_exclude eq {}} {
1079                                 if {[catch {exec test -f [gitdir info exclude]}]} {
1080                                         set is_git_info_exclude 0
1081                                 } else {
1082                                         set is_git_info_exclude 1
1083                                 }
1084                         }
1085                         return $is_git_info_exclude
1086                 } else {
1087                         return [file readable [gitdir info exclude]]
1088                 }
1089         }
1090 } else {
1091         proc have_info_exclude {} {
1092                 return [file readable [gitdir info exclude]]
1093         }
1096 proc rescan_stage2 {fd after} {
1097         global rescan_active buf_rdi buf_rdf buf_rlo
1099         if {$fd ne {}} {
1100                 read $fd
1101                 if {![eof $fd]} return
1102                 close $fd
1103         }
1105         set ls_others [list --exclude-per-directory=.gitignore]
1106         if {[have_info_exclude]} {
1107                 lappend ls_others "--exclude-from=[gitdir info exclude]"
1108         }
1109         set user_exclude [get_config core.excludesfile]
1110         if {$user_exclude ne {} && [file readable $user_exclude]} {
1111                 lappend ls_others "--exclude-from=$user_exclude"
1112         }
1114         set buf_rdi {}
1115         set buf_rdf {}
1116         set buf_rlo {}
1118         set rescan_active 3
1119         ui_status [mc "Scanning for modified files ..."]
1120         set fd_di [git_read diff-index --cached -z [PARENT]]
1121         set fd_df [git_read diff-files -z]
1122         set fd_lo [eval git_read ls-files --others -z $ls_others]
1124         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1125         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1126         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1127         fileevent $fd_di readable [list read_diff_index $fd_di $after]
1128         fileevent $fd_df readable [list read_diff_files $fd_df $after]
1129         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1132 proc load_message {file} {
1133         global ui_comm
1135         set f [gitdir $file]
1136         if {[file isfile $f]} {
1137                 if {[catch {set fd [open $f r]}]} {
1138                         return 0
1139                 }
1140                 fconfigure $fd -eofchar {}
1141                 set content [string trim [read $fd]]
1142                 close $fd
1143                 regsub -all -line {[ \r\t]+$} $content {} content
1144                 $ui_comm delete 0.0 end
1145                 $ui_comm insert end $content
1146                 return 1
1147         }
1148         return 0
1151 proc read_diff_index {fd after} {
1152         global buf_rdi
1154         append buf_rdi [read $fd]
1155         set c 0
1156         set n [string length $buf_rdi]
1157         while {$c < $n} {
1158                 set z1 [string first "\0" $buf_rdi $c]
1159                 if {$z1 == -1} break
1160                 incr z1
1161                 set z2 [string first "\0" $buf_rdi $z1]
1162                 if {$z2 == -1} break
1164                 incr c
1165                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1166                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1167                 merge_state \
1168                         [encoding convertfrom $p] \
1169                         [lindex $i 4]? \
1170                         [list [lindex $i 0] [lindex $i 2]] \
1171                         [list]
1172                 set c $z2
1173                 incr c
1174         }
1175         if {$c < $n} {
1176                 set buf_rdi [string range $buf_rdi $c end]
1177         } else {
1178                 set buf_rdi {}
1179         }
1181         rescan_done $fd buf_rdi $after
1184 proc read_diff_files {fd after} {
1185         global buf_rdf
1187         append buf_rdf [read $fd]
1188         set c 0
1189         set n [string length $buf_rdf]
1190         while {$c < $n} {
1191                 set z1 [string first "\0" $buf_rdf $c]
1192                 if {$z1 == -1} break
1193                 incr z1
1194                 set z2 [string first "\0" $buf_rdf $z1]
1195                 if {$z2 == -1} break
1197                 incr c
1198                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1199                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1200                 merge_state \
1201                         [encoding convertfrom $p] \
1202                         ?[lindex $i 4] \
1203                         [list] \
1204                         [list [lindex $i 0] [lindex $i 2]]
1205                 set c $z2
1206                 incr c
1207         }
1208         if {$c < $n} {
1209                 set buf_rdf [string range $buf_rdf $c end]
1210         } else {
1211                 set buf_rdf {}
1212         }
1214         rescan_done $fd buf_rdf $after
1217 proc read_ls_others {fd after} {
1218         global buf_rlo
1220         append buf_rlo [read $fd]
1221         set pck [split $buf_rlo "\0"]
1222         set buf_rlo [lindex $pck end]
1223         foreach p [lrange $pck 0 end-1] {
1224                 set p [encoding convertfrom $p]
1225                 if {[string index $p end] eq {/}} {
1226                         set p [string range $p 0 end-1]
1227                 }
1228                 merge_state $p ?O
1229         }
1230         rescan_done $fd buf_rlo $after
1233 proc rescan_done {fd buf after} {
1234         global rescan_active current_diff_path
1235         global file_states repo_config
1236         upvar $buf to_clear
1238         if {![eof $fd]} return
1239         set to_clear {}
1240         close $fd
1241         if {[incr rescan_active -1] > 0} return
1243         prune_selection
1244         unlock_index
1245         display_all_files
1246         if {$current_diff_path ne {}} reshow_diff
1247         uplevel #0 $after
1250 proc prune_selection {} {
1251         global file_states selected_paths
1253         foreach path [array names selected_paths] {
1254                 if {[catch {set still_here $file_states($path)}]} {
1255                         unset selected_paths($path)
1256                 }
1257         }
1260 ######################################################################
1261 ##
1262 ## ui helpers
1264 proc mapicon {w state path} {
1265         global all_icons
1267         if {[catch {set r $all_icons($state$w)}]} {
1268                 puts "error: no icon for $w state={$state} $path"
1269                 return file_plain
1270         }
1271         return $r
1274 proc mapdesc {state path} {
1275         global all_descs
1277         if {[catch {set r $all_descs($state)}]} {
1278                 puts "error: no desc for state={$state} $path"
1279                 return $state
1280         }
1281         return $r
1284 proc ui_status {msg} {
1285         global main_status
1286         if {[info exists main_status]} {
1287                 $main_status show $msg
1288         }
1291 proc ui_ready {{test {}}} {
1292         global main_status
1293         if {[info exists main_status]} {
1294                 $main_status show [mc "Ready."] $test
1295         }
1298 proc escape_path {path} {
1299         regsub -all {\\} $path "\\\\" path
1300         regsub -all "\n" $path "\\n" path
1301         return $path
1304 proc short_path {path} {
1305         return [escape_path [lindex [file split $path] end]]
1308 set next_icon_id 0
1309 set null_sha1 [string repeat 0 40]
1311 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1312         global file_states next_icon_id null_sha1
1314         set s0 [string index $new_state 0]
1315         set s1 [string index $new_state 1]
1317         if {[catch {set info $file_states($path)}]} {
1318                 set state __
1319                 set icon n[incr next_icon_id]
1320         } else {
1321                 set state [lindex $info 0]
1322                 set icon [lindex $info 1]
1323                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1324                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1325         }
1327         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1328         elseif {$s0 eq {_}} {set s0 _}
1330         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1331         elseif {$s1 eq {_}} {set s1 _}
1333         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1334                 set head_info [list 0 $null_sha1]
1335         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1336                 && $head_info eq {}} {
1337                 set head_info $index_info
1338         }
1340         set file_states($path) [list $s0$s1 $icon \
1341                 $head_info $index_info \
1342                 ]
1343         return $state
1346 proc display_file_helper {w path icon_name old_m new_m} {
1347         global file_lists
1349         if {$new_m eq {_}} {
1350                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1351                 if {$lno >= 0} {
1352                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1353                         incr lno
1354                         $w conf -state normal
1355                         $w delete $lno.0 [expr {$lno + 1}].0
1356                         $w conf -state disabled
1357                 }
1358         } elseif {$old_m eq {_} && $new_m ne {_}} {
1359                 lappend file_lists($w) $path
1360                 set file_lists($w) [lsort -unique $file_lists($w)]
1361                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1362                 incr lno
1363                 $w conf -state normal
1364                 $w image create $lno.0 \
1365                         -align center -padx 5 -pady 1 \
1366                         -name $icon_name \
1367                         -image [mapicon $w $new_m $path]
1368                 $w insert $lno.1 "[escape_path $path]\n"
1369                 $w conf -state disabled
1370         } elseif {$old_m ne $new_m} {
1371                 $w conf -state normal
1372                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1373                 $w conf -state disabled
1374         }
1377 proc display_file {path state} {
1378         global file_states selected_paths
1379         global ui_index ui_workdir
1381         set old_m [merge_state $path $state]
1382         set s $file_states($path)
1383         set new_m [lindex $s 0]
1384         set icon_name [lindex $s 1]
1386         set o [string index $old_m 0]
1387         set n [string index $new_m 0]
1388         if {$o eq {U}} {
1389                 set o _
1390         }
1391         if {$n eq {U}} {
1392                 set n _
1393         }
1394         display_file_helper     $ui_index $path $icon_name $o $n
1396         if {[string index $old_m 0] eq {U}} {
1397                 set o U
1398         } else {
1399                 set o [string index $old_m 1]
1400         }
1401         if {[string index $new_m 0] eq {U}} {
1402                 set n U
1403         } else {
1404                 set n [string index $new_m 1]
1405         }
1406         display_file_helper     $ui_workdir $path $icon_name $o $n
1408         if {$new_m eq {__}} {
1409                 unset file_states($path)
1410                 catch {unset selected_paths($path)}
1411         }
1414 proc display_all_files_helper {w path icon_name m} {
1415         global file_lists
1417         lappend file_lists($w) $path
1418         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1419         $w image create end \
1420                 -align center -padx 5 -pady 1 \
1421                 -name $icon_name \
1422                 -image [mapicon $w $m $path]
1423         $w insert end "[escape_path $path]\n"
1426 proc display_all_files {} {
1427         global ui_index ui_workdir
1428         global file_states file_lists
1429         global last_clicked
1431         $ui_index conf -state normal
1432         $ui_workdir conf -state normal
1434         $ui_index delete 0.0 end
1435         $ui_workdir delete 0.0 end
1436         set last_clicked {}
1438         set file_lists($ui_index) [list]
1439         set file_lists($ui_workdir) [list]
1441         foreach path [lsort [array names file_states]] {
1442                 set s $file_states($path)
1443                 set m [lindex $s 0]
1444                 set icon_name [lindex $s 1]
1446                 set s [string index $m 0]
1447                 if {$s ne {U} && $s ne {_}} {
1448                         display_all_files_helper $ui_index $path \
1449                                 $icon_name $s
1450                 }
1452                 if {[string index $m 0] eq {U}} {
1453                         set s U
1454                 } else {
1455                         set s [string index $m 1]
1456                 }
1457                 if {$s ne {_}} {
1458                         display_all_files_helper $ui_workdir $path \
1459                                 $icon_name $s
1460                 }
1461         }
1463         $ui_index conf -state disabled
1464         $ui_workdir conf -state disabled
1467 ######################################################################
1468 ##
1469 ## icons
1471 set filemask {
1472 #define mask_width 14
1473 #define mask_height 15
1474 static unsigned char mask_bits[] = {
1475    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1476    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1477    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1480 image create bitmap file_plain -background white -foreground black -data {
1481 #define plain_width 14
1482 #define plain_height 15
1483 static unsigned char plain_bits[] = {
1484    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1485    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1486    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1487 } -maskdata $filemask
1489 image create bitmap file_mod -background white -foreground blue -data {
1490 #define mod_width 14
1491 #define mod_height 15
1492 static unsigned char mod_bits[] = {
1493    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1494    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1495    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1496 } -maskdata $filemask
1498 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1499 #define file_fulltick_width 14
1500 #define file_fulltick_height 15
1501 static unsigned char file_fulltick_bits[] = {
1502    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1503    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1504    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1505 } -maskdata $filemask
1507 image create bitmap file_parttick -background white -foreground "#005050" -data {
1508 #define parttick_width 14
1509 #define parttick_height 15
1510 static unsigned char parttick_bits[] = {
1511    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1512    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1513    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1514 } -maskdata $filemask
1516 image create bitmap file_question -background white -foreground black -data {
1517 #define file_question_width 14
1518 #define file_question_height 15
1519 static unsigned char file_question_bits[] = {
1520    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1521    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1522    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1523 } -maskdata $filemask
1525 image create bitmap file_removed -background white -foreground red -data {
1526 #define file_removed_width 14
1527 #define file_removed_height 15
1528 static unsigned char file_removed_bits[] = {
1529    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1530    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1531    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1532 } -maskdata $filemask
1534 image create bitmap file_merge -background white -foreground blue -data {
1535 #define file_merge_width 14
1536 #define file_merge_height 15
1537 static unsigned char file_merge_bits[] = {
1538    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1539    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1540    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1541 } -maskdata $filemask
1543 set ui_index .vpane.files.index.list
1544 set ui_workdir .vpane.files.workdir.list
1546 set all_icons(_$ui_index)   file_plain
1547 set all_icons(A$ui_index)   file_fulltick
1548 set all_icons(M$ui_index)   file_fulltick
1549 set all_icons(D$ui_index)   file_removed
1550 set all_icons(U$ui_index)   file_merge
1552 set all_icons(_$ui_workdir) file_plain
1553 set all_icons(M$ui_workdir) file_mod
1554 set all_icons(D$ui_workdir) file_question
1555 set all_icons(U$ui_workdir) file_merge
1556 set all_icons(O$ui_workdir) file_plain
1558 set max_status_desc 0
1559 foreach i {
1560                 {__ {mc "Unmodified"}}
1562                 {_M {mc "Modified, not staged"}}
1563                 {M_ {mc "Staged for commit"}}
1564                 {MM {mc "Portions staged for commit"}}
1565                 {MD {mc "Staged for commit, missing"}}
1567                 {_O {mc "Untracked, not staged"}}
1568                 {A_ {mc "Staged for commit"}}
1569                 {AM {mc "Portions staged for commit"}}
1570                 {AD {mc "Staged for commit, missing"}}
1572                 {_D {mc "Missing"}}
1573                 {D_ {mc "Staged for removal"}}
1574                 {DO {mc "Staged for removal, still present"}}
1576                 {U_ {mc "Requires merge resolution"}}
1577                 {UU {mc "Requires merge resolution"}}
1578                 {UM {mc "Requires merge resolution"}}
1579                 {UD {mc "Requires merge resolution"}}
1580         } {
1581         set text [eval [lindex $i 1]]
1582         if {$max_status_desc < [string length $text]} {
1583                 set max_status_desc [string length $text]
1584         }
1585         set all_descs([lindex $i 0]) $text
1587 unset i
1589 ######################################################################
1590 ##
1591 ## util
1593 proc scrollbar2many {list mode args} {
1594         foreach w $list {eval $w $mode $args}
1597 proc many2scrollbar {list mode sb top bottom} {
1598         $sb set $top $bottom
1599         foreach w $list {$w $mode moveto $top}
1602 proc incr_font_size {font {amt 1}} {
1603         set sz [font configure $font -size]
1604         incr sz $amt
1605         font configure $font -size $sz
1606         font configure ${font}bold -size $sz
1607         font configure ${font}italic -size $sz
1610 ######################################################################
1611 ##
1612 ## ui commands
1614 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1616 proc do_gitk {revs} {
1617         # -- Always start gitk through whatever we were loaded with.  This
1618         #    lets us bypass using shell process on Windows systems.
1619         #
1620         set exe [file join [file dirname $::_git] gitk]
1621         set cmd [list [info nameofexecutable] $exe]
1622         if {! [file exists $exe]} {
1623                 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1624         } else {
1625                 global env
1627                 if {[info exists env(GIT_DIR)]} {
1628                         set old_GIT_DIR $env(GIT_DIR)
1629                 } else {
1630                         set old_GIT_DIR {}
1631                 }
1633                 set pwd [pwd]
1634                 cd [file dirname [gitdir]]
1635                 set env(GIT_DIR) [file tail [gitdir]]
1637                 eval exec $cmd $revs &
1639                 if {$old_GIT_DIR eq {}} {
1640                         unset env(GIT_DIR)
1641                 } else {
1642                         set env(GIT_DIR) $old_GIT_DIR
1643                 }
1644                 cd $pwd
1646                 ui_status $::starting_gitk_msg
1647                 after 10000 {
1648                         ui_ready $starting_gitk_msg
1649                 }
1650         }
1653 set is_quitting 0
1655 proc do_quit {} {
1656         global ui_comm is_quitting repo_config commit_type
1657         global GITGUI_BCK_exists GITGUI_BCK_i
1659         if {$is_quitting} return
1660         set is_quitting 1
1662         if {[winfo exists $ui_comm]} {
1663                 # -- Stash our current commit buffer.
1664                 #
1665                 set save [gitdir GITGUI_MSG]
1666                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1667                         file rename -force [gitdir GITGUI_BCK] $save
1668                         set GITGUI_BCK_exists 0
1669                 } else {
1670                         set msg [string trim [$ui_comm get 0.0 end]]
1671                         regsub -all -line {[ \r\t]+$} $msg {} msg
1672                         if {(![string match amend* $commit_type]
1673                                 || [$ui_comm edit modified])
1674                                 && $msg ne {}} {
1675                                 catch {
1676                                         set fd [open $save w]
1677                                         puts -nonewline $fd $msg
1678                                         close $fd
1679                                 }
1680                         } else {
1681                                 catch {file delete $save}
1682                         }
1683                 }
1685                 # -- Remove our editor backup, its not needed.
1686                 #
1687                 after cancel $GITGUI_BCK_i
1688                 if {$GITGUI_BCK_exists} {
1689                         catch {file delete [gitdir GITGUI_BCK]}
1690                 }
1692                 # -- Stash our current window geometry into this repository.
1693                 #
1694                 set cfg_geometry [list]
1695                 lappend cfg_geometry [wm geometry .]
1696                 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1697                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1698                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1699                         set rc_geometry {}
1700                 }
1701                 if {$cfg_geometry ne $rc_geometry} {
1702                         catch {git config gui.geometry $cfg_geometry}
1703                 }
1704         }
1706         destroy .
1709 proc do_rescan {} {
1710         rescan ui_ready
1713 proc do_commit {} {
1714         commit_tree
1717 proc toggle_or_diff {w x y} {
1718         global file_states file_lists current_diff_path ui_index ui_workdir
1719         global last_clicked selected_paths
1721         set pos [split [$w index @$x,$y] .]
1722         set lno [lindex $pos 0]
1723         set col [lindex $pos 1]
1724         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1725         if {$path eq {}} {
1726                 set last_clicked {}
1727                 return
1728         }
1730         set last_clicked [list $w $lno]
1731         array unset selected_paths
1732         $ui_index tag remove in_sel 0.0 end
1733         $ui_workdir tag remove in_sel 0.0 end
1735         if {$col == 0} {
1736                 if {$current_diff_path eq $path} {
1737                         set after {reshow_diff;}
1738                 } else {
1739                         set after {}
1740                 }
1741                 if {$w eq $ui_index} {
1742                         update_indexinfo \
1743                                 "Unstaging [short_path $path] from commit" \
1744                                 [list $path] \
1745                                 [concat $after [list ui_ready]]
1746                 } elseif {$w eq $ui_workdir} {
1747                         update_index \
1748                                 "Adding [short_path $path]" \
1749                                 [list $path] \
1750                                 [concat $after [list ui_ready]]
1751                 }
1752         } else {
1753                 show_diff $path $w $lno
1754         }
1757 proc add_one_to_selection {w x y} {
1758         global file_lists last_clicked selected_paths
1760         set lno [lindex [split [$w index @$x,$y] .] 0]
1761         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1762         if {$path eq {}} {
1763                 set last_clicked {}
1764                 return
1765         }
1767         if {$last_clicked ne {}
1768                 && [lindex $last_clicked 0] ne $w} {
1769                 array unset selected_paths
1770                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1771         }
1773         set last_clicked [list $w $lno]
1774         if {[catch {set in_sel $selected_paths($path)}]} {
1775                 set in_sel 0
1776         }
1777         if {$in_sel} {
1778                 unset selected_paths($path)
1779                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1780         } else {
1781                 set selected_paths($path) 1
1782                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1783         }
1786 proc add_range_to_selection {w x y} {
1787         global file_lists last_clicked selected_paths
1789         if {[lindex $last_clicked 0] ne $w} {
1790                 toggle_or_diff $w $x $y
1791                 return
1792         }
1794         set lno [lindex [split [$w index @$x,$y] .] 0]
1795         set lc [lindex $last_clicked 1]
1796         if {$lc < $lno} {
1797                 set begin $lc
1798                 set end $lno
1799         } else {
1800                 set begin $lno
1801                 set end $lc
1802         }
1804         foreach path [lrange $file_lists($w) \
1805                 [expr {$begin - 1}] \
1806                 [expr {$end - 1}]] {
1807                 set selected_paths($path) 1
1808         }
1809         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1812 ######################################################################
1813 ##
1814 ## ui construction
1816 load_config 0
1817 apply_config
1818 set ui_comm {}
1820 # -- Menu Bar
1822 menu .mbar -tearoff 0
1823 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1824 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1825 if {[is_enabled branch]} {
1826         .mbar add cascade -label [mc Branch] -menu .mbar.branch
1828 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1829         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1831 if {[is_enabled transport]} {
1832         .mbar add cascade -label [mc Merge] -menu .mbar.merge
1833         .mbar add cascade -label [mc Remote] -menu .mbar.remote
1835 . configure -menu .mbar
1837 # -- Repository Menu
1839 menu .mbar.repository
1841 .mbar.repository add command \
1842         -label [mc "Browse Current Branch's Files"] \
1843         -command {browser::new $current_branch}
1844 set ui_browse_current [.mbar.repository index last]
1845 .mbar.repository add command \
1846         -label [mc "Browse Branch Files..."] \
1847         -command browser_open::dialog
1848 .mbar.repository add separator
1850 .mbar.repository add command \
1851         -label [mc "Visualize Current Branch's History"] \
1852         -command {do_gitk $current_branch}
1853 set ui_visualize_current [.mbar.repository index last]
1854 .mbar.repository add command \
1855         -label [mc "Visualize All Branch History"] \
1856         -command {do_gitk --all}
1857 .mbar.repository add separator
1859 proc current_branch_write {args} {
1860         global current_branch
1861         .mbar.repository entryconf $::ui_browse_current \
1862                 -label [mc "Browse %s's Files" $current_branch]
1863         .mbar.repository entryconf $::ui_visualize_current \
1864                 -label [mc "Visualize %s's History" $current_branch]
1866 trace add variable current_branch write current_branch_write
1868 if {[is_enabled multicommit]} {
1869         .mbar.repository add command -label [mc "Database Statistics"] \
1870                 -command do_stats
1872         .mbar.repository add command -label [mc "Compress Database"] \
1873                 -command do_gc
1875         .mbar.repository add command -label [mc "Verify Database"] \
1876                 -command do_fsck_objects
1878         .mbar.repository add separator
1880         if {[is_Cygwin]} {
1881                 .mbar.repository add command \
1882                         -label [mc "Create Desktop Icon"] \
1883                         -command do_cygwin_shortcut
1884         } elseif {[is_Windows]} {
1885                 .mbar.repository add command \
1886                         -label [mc "Create Desktop Icon"] \
1887                         -command do_windows_shortcut
1888         } elseif {[is_MacOSX]} {
1889                 .mbar.repository add command \
1890                         -label [mc "Create Desktop Icon"] \
1891                         -command do_macosx_app
1892         }
1895 .mbar.repository add command -label [mc Quit] \
1896         -command do_quit \
1897         -accelerator $M1T-Q
1899 # -- Edit Menu
1901 menu .mbar.edit
1902 .mbar.edit add command -label [mc Undo] \
1903         -command {catch {[focus] edit undo}} \
1904         -accelerator $M1T-Z
1905 .mbar.edit add command -label [mc Redo] \
1906         -command {catch {[focus] edit redo}} \
1907         -accelerator $M1T-Y
1908 .mbar.edit add separator
1909 .mbar.edit add command -label [mc Cut] \
1910         -command {catch {tk_textCut [focus]}} \
1911         -accelerator $M1T-X
1912 .mbar.edit add command -label [mc Copy] \
1913         -command {catch {tk_textCopy [focus]}} \
1914         -accelerator $M1T-C
1915 .mbar.edit add command -label [mc Paste] \
1916         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1917         -accelerator $M1T-V
1918 .mbar.edit add command -label [mc Delete] \
1919         -command {catch {[focus] delete sel.first sel.last}} \
1920         -accelerator Del
1921 .mbar.edit add separator
1922 .mbar.edit add command -label [mc "Select All"] \
1923         -command {catch {[focus] tag add sel 0.0 end}} \
1924         -accelerator $M1T-A
1926 # -- Branch Menu
1928 if {[is_enabled branch]} {
1929         menu .mbar.branch
1931         .mbar.branch add command -label [mc "Create..."] \
1932                 -command branch_create::dialog \
1933                 -accelerator $M1T-N
1934         lappend disable_on_lock [list .mbar.branch entryconf \
1935                 [.mbar.branch index last] -state]
1937         .mbar.branch add command -label [mc "Checkout..."] \
1938                 -command branch_checkout::dialog \
1939                 -accelerator $M1T-O
1940         lappend disable_on_lock [list .mbar.branch entryconf \
1941                 [.mbar.branch index last] -state]
1943         .mbar.branch add command -label [mc "Rename..."] \
1944                 -command branch_rename::dialog
1945         lappend disable_on_lock [list .mbar.branch entryconf \
1946                 [.mbar.branch index last] -state]
1948         .mbar.branch add command -label [mc "Delete..."] \
1949                 -command branch_delete::dialog
1950         lappend disable_on_lock [list .mbar.branch entryconf \
1951                 [.mbar.branch index last] -state]
1953         .mbar.branch add command -label [mc "Reset..."] \
1954                 -command merge::reset_hard
1955         lappend disable_on_lock [list .mbar.branch entryconf \
1956                 [.mbar.branch index last] -state]
1959 # -- Commit Menu
1961 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1962         menu .mbar.commit
1964         .mbar.commit add radiobutton \
1965                 -label [mc "New Commit"] \
1966                 -command do_select_commit_type \
1967                 -variable selected_commit_type \
1968                 -value new
1969         lappend disable_on_lock \
1970                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1972         .mbar.commit add radiobutton \
1973                 -label [mc "Amend Last Commit"] \
1974                 -command do_select_commit_type \
1975                 -variable selected_commit_type \
1976                 -value amend
1977         lappend disable_on_lock \
1978                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1980         .mbar.commit add separator
1982         .mbar.commit add command -label [mc Rescan] \
1983                 -command do_rescan \
1984                 -accelerator F5
1985         lappend disable_on_lock \
1986                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1988         .mbar.commit add command -label [mc "Stage To Commit"] \
1989                 -command do_add_selection \
1990                 -accelerator $M1T-T
1991         lappend disable_on_lock \
1992                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1994         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1995                 -command do_add_all \
1996                 -accelerator $M1T-I
1997         lappend disable_on_lock \
1998                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2000         .mbar.commit add command -label [mc "Unstage From Commit"] \
2001                 -command do_unstage_selection
2002         lappend disable_on_lock \
2003                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2005         .mbar.commit add command -label [mc "Revert Changes"] \
2006                 -command do_revert_selection
2007         lappend disable_on_lock \
2008                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2010         .mbar.commit add separator
2012         .mbar.commit add command -label [mc "Sign Off"] \
2013                 -command do_signoff \
2014                 -accelerator $M1T-S
2016         .mbar.commit add command -label [mc Commit@@verb] \
2017                 -command do_commit \
2018                 -accelerator $M1T-Return
2019         lappend disable_on_lock \
2020                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2023 # -- Merge Menu
2025 if {[is_enabled branch]} {
2026         menu .mbar.merge
2027         .mbar.merge add command -label [mc "Local Merge..."] \
2028                 -command merge::dialog \
2029                 -accelerator $M1T-M
2030         lappend disable_on_lock \
2031                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2032         .mbar.merge add command -label [mc "Abort Merge..."] \
2033                 -command merge::reset_hard
2034         lappend disable_on_lock \
2035                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2038 # -- Transport Menu
2040 if {[is_enabled transport]} {
2041         menu .mbar.remote
2043         .mbar.remote add command \
2044                 -label [mc "Push..."] \
2045                 -command do_push_anywhere \
2046                 -accelerator $M1T-P
2047         .mbar.remote add command \
2048                 -label [mc "Delete..."] \
2049                 -command remote_branch_delete::dialog
2052 if {[is_MacOSX]} {
2053         # -- Apple Menu (Mac OS X only)
2054         #
2055         .mbar add cascade -label [mc Apple] -menu .mbar.apple
2056         menu .mbar.apple
2058         .mbar.apple add command -label [mc "About %s" [appname]] \
2059                 -command do_about
2060         .mbar.apple add separator
2061         .mbar.apple add command \
2062                 -label [mc "Preferences..."] \
2063                 -command do_options \
2064                 -accelerator $M1T-,
2065         bind . <$M1B-,> do_options
2066 } else {
2067         # -- Edit Menu
2068         #
2069         .mbar.edit add separator
2070         .mbar.edit add command -label [mc "Options..."] \
2071                 -command do_options
2074 # -- Help Menu
2076 .mbar add cascade -label [mc Help] -menu .mbar.help
2077 menu .mbar.help
2079 if {![is_MacOSX]} {
2080         .mbar.help add command -label [mc "About %s" [appname]] \
2081                 -command do_about
2084 set browser {}
2085 catch {set browser $repo_config(instaweb.browser)}
2086 set doc_path [file dirname [gitexec]]
2087 set doc_path [file join $doc_path Documentation index.html]
2089 if {[is_Cygwin]} {
2090         set doc_path [exec cygpath --mixed $doc_path]
2093 if {$browser eq {}} {
2094         if {[is_MacOSX]} {
2095                 set browser open
2096         } elseif {[is_Cygwin]} {
2097                 set program_files [file dirname [exec cygpath --windir]]
2098                 set program_files [file join $program_files {Program Files}]
2099                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2100                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2101                 if {[file exists $firefox]} {
2102                         set browser $firefox
2103                 } elseif {[file exists $ie]} {
2104                         set browser $ie
2105                 }
2106                 unset program_files firefox ie
2107         }
2110 if {[file isfile $doc_path]} {
2111         set doc_url "file:$doc_path"
2112 } else {
2113         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2116 if {$browser ne {}} {
2117         .mbar.help add command -label [mc "Online Documentation"] \
2118                 -command [list exec $browser $doc_url &]
2120 unset browser doc_path doc_url
2122 # -- Standard bindings
2124 wm protocol . WM_DELETE_WINDOW do_quit
2125 bind all <$M1B-Key-q> do_quit
2126 bind all <$M1B-Key-Q> do_quit
2127 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2128 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2130 set subcommand_args {}
2131 proc usage {} {
2132         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2133         exit 1
2136 # -- Not a normal commit type invocation?  Do that instead!
2138 switch -- $subcommand {
2139 browser -
2140 blame {
2141         set subcommand_args {rev? path}
2142         if {$argv eq {}} usage
2143         set head {}
2144         set path {}
2145         set is_path 0
2146         foreach a $argv {
2147                 if {$is_path || [file exists $_prefix$a]} {
2148                         if {$path ne {}} usage
2149                         set path $_prefix$a
2150                         break
2151                 } elseif {$a eq {--}} {
2152                         if {$path ne {}} {
2153                                 if {$head ne {}} usage
2154                                 set head $path
2155                                 set path {}
2156                         }
2157                         set is_path 1
2158                 } elseif {$head eq {}} {
2159                         if {$head ne {}} usage
2160                         set head $a
2161                         set is_path 1
2162                 } else {
2163                         usage
2164                 }
2165         }
2166         unset is_path
2168         if {$head ne {} && $path eq {}} {
2169                 set path $_prefix$head
2170                 set head {}
2171         }
2173         if {$head eq {}} {
2174                 load_current_branch
2175         } else {
2176                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2177                         if {[catch {
2178                                         set head [git rev-parse --verify $head]
2179                                 } err]} {
2180                                 puts stderr $err
2181                                 exit 1
2182                         }
2183                 }
2184                 set current_branch $head
2185         }
2187         switch -- $subcommand {
2188         browser {
2189                 if {$head eq {}} {
2190                         if {$path ne {} && [file isdirectory $path]} {
2191                                 set head $current_branch
2192                         } else {
2193                                 set head $path
2194                                 set path {}
2195                         }
2196                 }
2197                 browser::new $head $path
2198         }
2199         blame   {
2200                 if {$head eq {} && ![file exists $path]} {
2201                         puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2202                         exit 1
2203                 }
2204                 blame::new $head $path
2205         }
2206         }
2207         return
2209 citool -
2210 gui {
2211         if {[llength $argv] != 0} {
2212                 puts -nonewline stderr "usage: $argv0"
2213                 if {$subcommand ne {gui}
2214                         && [file tail $argv0] ne "git-$subcommand"} {
2215                         puts -nonewline stderr " $subcommand"
2216                 }
2217                 puts stderr {}
2218                 exit 1
2219         }
2220         # fall through to setup UI for commits
2222 default {
2223         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2224         exit 1
2228 # -- Branch Control
2230 frame .branch \
2231         -borderwidth 1 \
2232         -relief sunken
2233 label .branch.l1 \
2234         -text [mc "Current Branch:"] \
2235         -anchor w \
2236         -justify left
2237 label .branch.cb \
2238         -textvariable current_branch \
2239         -anchor w \
2240         -justify left
2241 pack .branch.l1 -side left
2242 pack .branch.cb -side left -fill x
2243 pack .branch -side top -fill x
2245 # -- Main Window Layout
2247 panedwindow .vpane -orient horizontal
2248 panedwindow .vpane.files -orient vertical
2249 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2250 pack .vpane -anchor n -side top -fill both -expand 1
2252 # -- Index File List
2254 frame .vpane.files.index -height 100 -width 200
2255 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2256         -background lightgreen
2257 text $ui_index -background white -borderwidth 0 \
2258         -width 20 -height 10 \
2259         -wrap none \
2260         -cursor $cursor_ptr \
2261         -xscrollcommand {.vpane.files.index.sx set} \
2262         -yscrollcommand {.vpane.files.index.sy set} \
2263         -state disabled
2264 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2265 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2266 pack .vpane.files.index.title -side top -fill x
2267 pack .vpane.files.index.sx -side bottom -fill x
2268 pack .vpane.files.index.sy -side right -fill y
2269 pack $ui_index -side left -fill both -expand 1
2271 # -- Working Directory File List
2273 frame .vpane.files.workdir -height 100 -width 200
2274 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2275         -background lightsalmon
2276 text $ui_workdir -background white -borderwidth 0 \
2277         -width 20 -height 10 \
2278         -wrap none \
2279         -cursor $cursor_ptr \
2280         -xscrollcommand {.vpane.files.workdir.sx set} \
2281         -yscrollcommand {.vpane.files.workdir.sy set} \
2282         -state disabled
2283 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2284 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2285 pack .vpane.files.workdir.title -side top -fill x
2286 pack .vpane.files.workdir.sx -side bottom -fill x
2287 pack .vpane.files.workdir.sy -side right -fill y
2288 pack $ui_workdir -side left -fill both -expand 1
2290 .vpane.files add .vpane.files.workdir -sticky nsew
2291 .vpane.files add .vpane.files.index -sticky nsew
2293 foreach i [list $ui_index $ui_workdir] {
2294         rmsel_tag $i
2295         $i tag conf in_diff -background [$i tag cget in_sel -background]
2297 unset i
2299 # -- Diff and Commit Area
2301 frame .vpane.lower -height 300 -width 400
2302 frame .vpane.lower.commarea
2303 frame .vpane.lower.diff -relief sunken -borderwidth 1
2304 pack .vpane.lower.diff -fill both -expand 1
2305 pack .vpane.lower.commarea -side bottom -fill x
2306 .vpane add .vpane.lower -sticky nsew
2308 # -- Commit Area Buttons
2310 frame .vpane.lower.commarea.buttons
2311 label .vpane.lower.commarea.buttons.l -text {} \
2312         -anchor w \
2313         -justify left
2314 pack .vpane.lower.commarea.buttons.l -side top -fill x
2315 pack .vpane.lower.commarea.buttons -side left -fill y
2317 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2318         -command do_rescan
2319 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2320 lappend disable_on_lock \
2321         {.vpane.lower.commarea.buttons.rescan conf -state}
2323 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2324         -command do_add_all
2325 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2326 lappend disable_on_lock \
2327         {.vpane.lower.commarea.buttons.incall conf -state}
2329 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2330         -command do_signoff
2331 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2333 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2334         -command do_commit
2335 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2336 lappend disable_on_lock \
2337         {.vpane.lower.commarea.buttons.commit conf -state}
2339 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2340         -command do_push_anywhere
2341 pack .vpane.lower.commarea.buttons.push -side top -fill x
2343 # -- Commit Message Buffer
2345 frame .vpane.lower.commarea.buffer
2346 frame .vpane.lower.commarea.buffer.header
2347 set ui_comm .vpane.lower.commarea.buffer.t
2348 set ui_coml .vpane.lower.commarea.buffer.header.l
2349 radiobutton .vpane.lower.commarea.buffer.header.new \
2350         -text [mc "New Commit"] \
2351         -command do_select_commit_type \
2352         -variable selected_commit_type \
2353         -value new
2354 lappend disable_on_lock \
2355         [list .vpane.lower.commarea.buffer.header.new conf -state]
2356 radiobutton .vpane.lower.commarea.buffer.header.amend \
2357         -text [mc "Amend Last Commit"] \
2358         -command do_select_commit_type \
2359         -variable selected_commit_type \
2360         -value amend
2361 lappend disable_on_lock \
2362         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2363 label $ui_coml \
2364         -anchor w \
2365         -justify left
2366 proc trace_commit_type {varname args} {
2367         global ui_coml commit_type
2368         switch -glob -- $commit_type {
2369         initial       {set txt [mc "Initial Commit Message:"]}
2370         amend         {set txt [mc "Amended Commit Message:"]}
2371         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2372         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2373         merge         {set txt [mc "Merge Commit Message:"]}
2374         *             {set txt [mc "Commit Message:"]}
2375         }
2376         $ui_coml conf -text $txt
2378 trace add variable commit_type write trace_commit_type
2379 pack $ui_coml -side left -fill x
2380 pack .vpane.lower.commarea.buffer.header.amend -side right
2381 pack .vpane.lower.commarea.buffer.header.new -side right
2383 text $ui_comm -background white -borderwidth 1 \
2384         -undo true \
2385         -maxundo 20 \
2386         -autoseparators true \
2387         -relief sunken \
2388         -width 75 -height 9 -wrap none \
2389         -font font_diff \
2390         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2391 scrollbar .vpane.lower.commarea.buffer.sby \
2392         -command [list $ui_comm yview]
2393 pack .vpane.lower.commarea.buffer.header -side top -fill x
2394 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2395 pack $ui_comm -side left -fill y
2396 pack .vpane.lower.commarea.buffer -side left -fill y
2398 # -- Commit Message Buffer Context Menu
2400 set ctxm .vpane.lower.commarea.buffer.ctxm
2401 menu $ctxm -tearoff 0
2402 $ctxm add command \
2403         -label [mc Cut] \
2404         -command {tk_textCut $ui_comm}
2405 $ctxm add command \
2406         -label [mc Copy] \
2407         -command {tk_textCopy $ui_comm}
2408 $ctxm add command \
2409         -label [mc Paste] \
2410         -command {tk_textPaste $ui_comm}
2411 $ctxm add command \
2412         -label [mc Delete] \
2413         -command {$ui_comm delete sel.first sel.last}
2414 $ctxm add separator
2415 $ctxm add command \
2416         -label [mc "Select All"] \
2417         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2418 $ctxm add command \
2419         -label [mc "Copy All"] \
2420         -command {
2421                 $ui_comm tag add sel 0.0 end
2422                 tk_textCopy $ui_comm
2423                 $ui_comm tag remove sel 0.0 end
2424         }
2425 $ctxm add separator
2426 $ctxm add command \
2427         -label [mc "Sign Off"] \
2428         -command do_signoff
2429 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2431 # -- Diff Header
2433 proc trace_current_diff_path {varname args} {
2434         global current_diff_path diff_actions file_states
2435         if {$current_diff_path eq {}} {
2436                 set s {}
2437                 set f {}
2438                 set p {}
2439                 set o disabled
2440         } else {
2441                 set p $current_diff_path
2442                 set s [mapdesc [lindex $file_states($p) 0] $p]
2443                 set f [mc "File:"]
2444                 set p [escape_path $p]
2445                 set o normal
2446         }
2448         .vpane.lower.diff.header.status configure -text $s
2449         .vpane.lower.diff.header.file configure -text $f
2450         .vpane.lower.diff.header.path configure -text $p
2451         foreach w $diff_actions {
2452                 uplevel #0 $w $o
2453         }
2455 trace add variable current_diff_path write trace_current_diff_path
2457 frame .vpane.lower.diff.header -background gold
2458 label .vpane.lower.diff.header.status \
2459         -background gold \
2460         -width $max_status_desc \
2461         -anchor w \
2462         -justify left
2463 label .vpane.lower.diff.header.file \
2464         -background gold \
2465         -anchor w \
2466         -justify left
2467 label .vpane.lower.diff.header.path \
2468         -background gold \
2469         -anchor w \
2470         -justify left
2471 pack .vpane.lower.diff.header.status -side left
2472 pack .vpane.lower.diff.header.file -side left
2473 pack .vpane.lower.diff.header.path -fill x
2474 set ctxm .vpane.lower.diff.header.ctxm
2475 menu $ctxm -tearoff 0
2476 $ctxm add command \
2477         -label [mc Copy] \
2478         -command {
2479                 clipboard clear
2480                 clipboard append \
2481                         -format STRING \
2482                         -type STRING \
2483                         -- $current_diff_path
2484         }
2485 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2486 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2488 # -- Diff Body
2490 frame .vpane.lower.diff.body
2491 set ui_diff .vpane.lower.diff.body.t
2492 text $ui_diff -background white -borderwidth 0 \
2493         -width 80 -height 15 -wrap none \
2494         -font font_diff \
2495         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2496         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2497         -state disabled
2498 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2499         -command [list $ui_diff xview]
2500 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2501         -command [list $ui_diff yview]
2502 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2503 pack .vpane.lower.diff.body.sby -side right -fill y
2504 pack $ui_diff -side left -fill both -expand 1
2505 pack .vpane.lower.diff.header -side top -fill x
2506 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2508 $ui_diff tag conf d_cr -elide true
2509 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2510 $ui_diff tag conf d_+ -foreground {#00a000}
2511 $ui_diff tag conf d_- -foreground red
2513 $ui_diff tag conf d_++ -foreground {#00a000}
2514 $ui_diff tag conf d_-- -foreground red
2515 $ui_diff tag conf d_+s \
2516         -foreground {#00a000} \
2517         -background {#e2effa}
2518 $ui_diff tag conf d_-s \
2519         -foreground red \
2520         -background {#e2effa}
2521 $ui_diff tag conf d_s+ \
2522         -foreground {#00a000} \
2523         -background ivory1
2524 $ui_diff tag conf d_s- \
2525         -foreground red \
2526         -background ivory1
2528 $ui_diff tag conf d<<<<<<< \
2529         -foreground orange \
2530         -font font_diffbold
2531 $ui_diff tag conf d======= \
2532         -foreground orange \
2533         -font font_diffbold
2534 $ui_diff tag conf d>>>>>>> \
2535         -foreground orange \
2536         -font font_diffbold
2538 $ui_diff tag raise sel
2540 # -- Diff Body Context Menu
2542 set ctxm .vpane.lower.diff.body.ctxm
2543 menu $ctxm -tearoff 0
2544 $ctxm add command \
2545         -label [mc Refresh] \
2546         -command reshow_diff
2547 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2548 $ctxm add command \
2549         -label [mc Copy] \
2550         -command {tk_textCopy $ui_diff}
2551 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2552 $ctxm add command \
2553         -label [mc "Select All"] \
2554         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2555 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2556 $ctxm add command \
2557         -label [mc "Copy All"] \
2558         -command {
2559                 $ui_diff tag add sel 0.0 end
2560                 tk_textCopy $ui_diff
2561                 $ui_diff tag remove sel 0.0 end
2562         }
2563 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2564 $ctxm add separator
2565 $ctxm add command \
2566         -label [mc "Apply/Reverse Hunk"] \
2567         -command {apply_hunk $cursorX $cursorY}
2568 set ui_diff_applyhunk [$ctxm index last]
2569 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2570 $ctxm add separator
2571 $ctxm add command \
2572         -label [mc "Decrease Font Size"] \
2573         -command {incr_font_size font_diff -1}
2574 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2575 $ctxm add command \
2576         -label [mc "Increase Font Size"] \
2577         -command {incr_font_size font_diff 1}
2578 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2579 $ctxm add separator
2580 $ctxm add command \
2581         -label [mc "Show Less Context"] \
2582         -command {if {$repo_config(gui.diffcontext) >= 1} {
2583                 incr repo_config(gui.diffcontext) -1
2584                 reshow_diff
2585         }}
2586 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2587 $ctxm add command \
2588         -label [mc "Show More Context"] \
2589         -command {if {$repo_config(gui.diffcontext) < 99} {
2590                 incr repo_config(gui.diffcontext)
2591                 reshow_diff
2592         }}
2593 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2594 $ctxm add separator
2595 $ctxm add command -label [mc "Options..."] \
2596         -command do_options
2597 proc popup_diff_menu {ctxm x y X Y} {
2598         global current_diff_path file_states
2599         set ::cursorX $x
2600         set ::cursorY $y
2601         if {$::ui_index eq $::current_diff_side} {
2602                 set l [mc "Unstage Hunk From Commit"]
2603         } else {
2604                 set l [mc "Stage Hunk For Commit"]
2605         }
2606         if {$::is_3way_diff
2607                 || $current_diff_path eq {}
2608                 || ![info exists file_states($current_diff_path)]
2609                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2610                 set s disabled
2611         } else {
2612                 set s normal
2613         }
2614         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2615         tk_popup $ctxm $X $Y
2617 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2619 # -- Status Bar
2621 set main_status [::status_bar::new .status]
2622 pack .status -anchor w -side bottom -fill x
2623 $main_status show [mc "Initializing..."]
2625 # -- Load geometry
2627 catch {
2628 set gm $repo_config(gui.geometry)
2629 wm geometry . [lindex $gm 0]
2630 .vpane sash place 0 \
2631         [lindex $gm 1] \
2632         [lindex [.vpane sash coord 0] 1]
2633 .vpane.files sash place 0 \
2634         [lindex [.vpane.files sash coord 0] 0] \
2635         [lindex $gm 2]
2636 unset gm
2639 # -- Key Bindings
2641 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2642 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2643 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2644 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2645 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2646 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2647 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2648 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2649 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2650 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2651 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2652 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2653 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2655 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2656 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2657 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2658 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2659 bind $ui_diff <$M1B-Key-v> {break}
2660 bind $ui_diff <$M1B-Key-V> {break}
2661 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2662 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2663 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2664 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2665 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2666 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2667 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2668 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2669 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2670 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2671 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2672 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2673 bind $ui_diff <Button-1>   {focus %W}
2675 if {[is_enabled branch]} {
2676         bind . <$M1B-Key-n> branch_create::dialog
2677         bind . <$M1B-Key-N> branch_create::dialog
2678         bind . <$M1B-Key-o> branch_checkout::dialog
2679         bind . <$M1B-Key-O> branch_checkout::dialog
2680         bind . <$M1B-Key-m> merge::dialog
2681         bind . <$M1B-Key-M> merge::dialog
2683 if {[is_enabled transport]} {
2684         bind . <$M1B-Key-p> do_push_anywhere
2685         bind . <$M1B-Key-P> do_push_anywhere
2688 bind .   <Key-F5>     do_rescan
2689 bind .   <$M1B-Key-r> do_rescan
2690 bind .   <$M1B-Key-R> do_rescan
2691 bind .   <$M1B-Key-s> do_signoff
2692 bind .   <$M1B-Key-S> do_signoff
2693 bind .   <$M1B-Key-t> do_add_selection
2694 bind .   <$M1B-Key-T> do_add_selection
2695 bind .   <$M1B-Key-i> do_add_all
2696 bind .   <$M1B-Key-I> do_add_all
2697 bind .   <$M1B-Key-Return> do_commit
2698 foreach i [list $ui_index $ui_workdir] {
2699         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2700         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2701         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2703 unset i
2705 set file_lists($ui_index) [list]
2706 set file_lists($ui_workdir) [list]
2708 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2709 focus -force $ui_comm
2711 # -- Warn the user about environmental problems.  Cygwin's Tcl
2712 #    does *not* pass its env array onto any processes it spawns.
2713 #    This means that git processes get none of our environment.
2715 if {[is_Cygwin]} {
2716         set ignored_env 0
2717         set suggest_user {}
2718         set msg [mc "Possible environment issues exist.
2720 The following environment variables are probably
2721 going to be ignored by any Git subprocess run
2722 by %s:
2724 " [appname]]
2725         foreach name [array names env] {
2726                 switch -regexp -- $name {
2727                 {^GIT_INDEX_FILE$} -
2728                 {^GIT_OBJECT_DIRECTORY$} -
2729                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2730                 {^GIT_DIFF_OPTS$} -
2731                 {^GIT_EXTERNAL_DIFF$} -
2732                 {^GIT_PAGER$} -
2733                 {^GIT_TRACE$} -
2734                 {^GIT_CONFIG$} -
2735                 {^GIT_CONFIG_LOCAL$} -
2736                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2737                         append msg " - $name\n"
2738                         incr ignored_env
2739                 }
2740                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2741                         append msg " - $name\n"
2742                         incr ignored_env
2743                         set suggest_user $name
2744                 }
2745                 }
2746         }
2747         if {$ignored_env > 0} {
2748                 append msg [mc "
2749 This is due to a known issue with the
2750 Tcl binary distributed by Cygwin."]
2752                 if {$suggest_user ne {}} {
2753                         append msg [mc "
2755 A good replacement for %s
2756 is placing values for the user.name and
2757 user.email settings into your personal
2758 ~/.gitconfig file.
2759 " $suggest_user]
2760                 }
2761                 warn_popup $msg
2762         }
2763         unset ignored_env msg suggest_user name
2766 # -- Only initialize complex UI if we are going to stay running.
2768 if {[is_enabled transport]} {
2769         load_all_remotes
2771         set n [.mbar.remote index end]
2772         populate_push_menu
2773         populate_fetch_menu
2774         set n [expr {[.mbar.remote index end] - $n}]
2775         if {$n > 0} {
2776                 .mbar.remote insert $n separator
2777         }
2778         unset n
2781 if {[winfo exists $ui_comm]} {
2782         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2784         # -- If both our backup and message files exist use the
2785         #    newer of the two files to initialize the buffer.
2786         #
2787         if {$GITGUI_BCK_exists} {
2788                 set m [gitdir GITGUI_MSG]
2789                 if {[file isfile $m]} {
2790                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2791                                 catch {file delete [gitdir GITGUI_MSG]}
2792                         } else {
2793                                 $ui_comm delete 0.0 end
2794                                 $ui_comm edit reset
2795                                 $ui_comm edit modified false
2796                                 catch {file delete [gitdir GITGUI_BCK]}
2797                                 set GITGUI_BCK_exists 0
2798                         }
2799                 }
2800                 unset m
2801         }
2803         proc backup_commit_buffer {} {
2804                 global ui_comm GITGUI_BCK_exists
2806                 set m [$ui_comm edit modified]
2807                 if {$m || $GITGUI_BCK_exists} {
2808                         set msg [string trim [$ui_comm get 0.0 end]]
2809                         regsub -all -line {[ \r\t]+$} $msg {} msg
2811                         if {$msg eq {}} {
2812                                 if {$GITGUI_BCK_exists} {
2813                                         catch {file delete [gitdir GITGUI_BCK]}
2814                                         set GITGUI_BCK_exists 0
2815                                 }
2816                         } elseif {$m} {
2817                                 catch {
2818                                         set fd [open [gitdir GITGUI_BCK] w]
2819                                         puts -nonewline $fd $msg
2820                                         close $fd
2821                                         set GITGUI_BCK_exists 1
2822                                 }
2823                         }
2825                         $ui_comm edit modified false
2826                 }
2828                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2829         }
2831         backup_commit_buffer
2834 lock_index begin-read
2835 if {![winfo ismapped .]} {
2836         wm deiconify .
2838 after 1 do_rescan
2839 if {[is_enabled multicommit]} {
2840         after 1000 hint_gc