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 {
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 {fmt args} {
92 set fmt [::msgcat::mc $fmt]
93 set cmk [string first @@ $fmt]
94 if {$cmk > 0} {
95 set fmt [string range $fmt 0 [expr {$cmk - 1}]]
96 }
97 return [eval [list format $fmt] $args]
98 }
100 proc strcat {args} {
101 return [join $args {}]
102 }
104 ::msgcat::mcload $oguimsg
105 unset oguimsg
107 ######################################################################
108 ##
109 ## read only globals
111 set _appname [lindex [file split $argv0] end]
112 set _gitdir {}
113 set _gitexec {}
114 set _reponame {}
115 set _iscygwin {}
116 set _search_path {}
118 proc appname {} {
119 global _appname
120 return $_appname
121 }
123 proc gitdir {args} {
124 global _gitdir
125 if {$args eq {}} {
126 return $_gitdir
127 }
128 return [eval [list file join $_gitdir] $args]
129 }
131 proc gitexec {args} {
132 global _gitexec
133 if {$_gitexec eq {}} {
134 if {[catch {set _gitexec [git --exec-path]} err]} {
135 error "Git not installed?\n\n$err"
136 }
137 if {[is_Cygwin]} {
138 set _gitexec [exec cygpath \
139 --windows \
140 --absolute \
141 $_gitexec]
142 } else {
143 set _gitexec [file normalize $_gitexec]
144 }
145 }
146 if {$args eq {}} {
147 return $_gitexec
148 }
149 return [eval [list file join $_gitexec] $args]
150 }
152 proc reponame {} {
153 return $::_reponame
154 }
156 proc is_MacOSX {} {
157 if {[tk windowingsystem] eq {aqua}} {
158 return 1
159 }
160 return 0
161 }
163 proc is_Windows {} {
164 if {$::tcl_platform(platform) eq {windows}} {
165 return 1
166 }
167 return 0
168 }
170 proc is_Cygwin {} {
171 global _iscygwin
172 if {$_iscygwin eq {}} {
173 if {$::tcl_platform(platform) eq {windows}} {
174 if {[catch {set p [exec cygpath --windir]} err]} {
175 set _iscygwin 0
176 } else {
177 set _iscygwin 1
178 }
179 } else {
180 set _iscygwin 0
181 }
182 }
183 return $_iscygwin
184 }
186 proc is_enabled {option} {
187 global enabled_options
188 if {[catch {set on $enabled_options($option)}]} {return 0}
189 return $on
190 }
192 proc enable_option {option} {
193 global enabled_options
194 set enabled_options($option) 1
195 }
197 proc disable_option {option} {
198 global enabled_options
199 set enabled_options($option) 0
200 }
202 ######################################################################
203 ##
204 ## config
206 proc is_many_config {name} {
207 switch -glob -- $name {
208 remote.*.fetch -
209 remote.*.push
210 {return 1}
211 *
212 {return 0}
213 }
214 }
216 proc is_config_true {name} {
217 global repo_config
218 if {[catch {set v $repo_config($name)}]} {
219 return 0
220 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
221 return 1
222 } else {
223 return 0
224 }
225 }
227 proc get_config {name} {
228 global repo_config
229 if {[catch {set v $repo_config($name)}]} {
230 return {}
231 } else {
232 return $v
233 }
234 }
236 proc load_config {include_global} {
237 global repo_config global_config default_config
239 array unset global_config
240 if {$include_global} {
241 catch {
242 set fd_rc [git_read config --global --list]
243 while {[gets $fd_rc line] >= 0} {
244 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
245 if {[is_many_config $name]} {
246 lappend global_config($name) $value
247 } else {
248 set global_config($name) $value
249 }
250 }
251 }
252 close $fd_rc
253 }
254 }
256 array unset repo_config
257 catch {
258 set fd_rc [git_read config --list]
259 while {[gets $fd_rc line] >= 0} {
260 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
261 if {[is_many_config $name]} {
262 lappend repo_config($name) $value
263 } else {
264 set repo_config($name) $value
265 }
266 }
267 }
268 close $fd_rc
269 }
271 foreach name [array names default_config] {
272 if {[catch {set v $global_config($name)}]} {
273 set global_config($name) $default_config($name)
274 }
275 if {[catch {set v $repo_config($name)}]} {
276 set repo_config($name) $default_config($name)
277 }
278 }
279 }
281 ######################################################################
282 ##
283 ## handy utils
285 proc _git_cmd {name} {
286 global _git_cmd_path
288 if {[catch {set v $_git_cmd_path($name)}]} {
289 switch -- $name {
290 version -
291 --version -
292 --exec-path { return [list $::_git $name] }
293 }
295 set p [gitexec git-$name$::_search_exe]
296 if {[file exists $p]} {
297 set v [list $p]
298 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
299 # Try to determine what sort of magic will make
300 # git-$name go and do its thing, because native
301 # Tcl on Windows doesn't know it.
302 #
303 set p [gitexec git-$name]
304 set f [open $p r]
305 set s [gets $f]
306 close $f
308 switch -glob -- [lindex $s 0] {
309 #!*sh { set i sh }
310 #!*perl { set i perl }
311 #!*python { set i python }
312 default { error "git-$name is not supported: $s" }
313 }
315 upvar #0 _$i interp
316 if {![info exists interp]} {
317 set interp [_which $i]
318 }
319 if {$interp eq {}} {
320 error "git-$name requires $i (not in PATH)"
321 }
322 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
323 } else {
324 # Assume it is builtin to git somehow and we
325 # aren't actually able to see a file for it.
326 #
327 set v [list $::_git $name]
328 }
329 set _git_cmd_path($name) $v
330 }
331 return $v
332 }
334 proc _which {what} {
335 global env _search_exe _search_path
337 if {$_search_path eq {}} {
338 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
339 set _search_path [split [exec cygpath \
340 --windows \
341 --path \
342 --absolute \
343 $env(PATH)] {;}]
344 set _search_exe .exe
345 } elseif {[is_Windows]} {
346 set _search_path [split $env(PATH) {;}]
347 set _search_exe .exe
348 } else {
349 set _search_path [split $env(PATH) :]
350 set _search_exe {}
351 }
352 }
354 foreach p $_search_path {
355 set p [file join $p $what$_search_exe]
356 if {[file exists $p]} {
357 return [file normalize $p]
358 }
359 }
360 return {}
361 }
363 proc _lappend_nice {cmd_var} {
364 global _nice
365 upvar $cmd_var cmd
367 if {![info exists _nice]} {
368 set _nice [_which nice]
369 }
370 if {$_nice ne {}} {
371 lappend cmd $_nice
372 }
373 }
375 proc git {args} {
376 set opt [list exec]
378 while {1} {
379 switch -- [lindex $args 0] {
380 --nice {
381 _lappend_nice opt
382 }
384 default {
385 break
386 }
388 }
390 set args [lrange $args 1 end]
391 }
393 set cmdp [_git_cmd [lindex $args 0]]
394 set args [lrange $args 1 end]
396 return [eval $opt $cmdp $args]
397 }
399 proc _open_stdout_stderr {cmd} {
400 if {[catch {
401 set fd [open $cmd r]
402 } err]} {
403 if { [lindex $cmd end] eq {2>@1}
404 && $err eq {can not find channel named "1"}
405 } {
406 # Older versions of Tcl 8.4 don't have this 2>@1 IO
407 # redirect operator. Fallback to |& cat for those.
408 # The command was not actually started, so its safe
409 # to try to start it a second time.
410 #
411 set fd [open [concat \
412 [lrange $cmd 0 end-1] \
413 [list |& cat] \
414 ] r]
415 } else {
416 error $err
417 }
418 }
419 fconfigure $fd -eofchar {}
420 return $fd
421 }
423 proc git_read {args} {
424 set opt [list |]
426 while {1} {
427 switch -- [lindex $args 0] {
428 --nice {
429 _lappend_nice opt
430 }
432 --stderr {
433 lappend args 2>@1
434 }
436 default {
437 break
438 }
440 }
442 set args [lrange $args 1 end]
443 }
445 set cmdp [_git_cmd [lindex $args 0]]
446 set args [lrange $args 1 end]
448 return [_open_stdout_stderr [concat $opt $cmdp $args]]
449 }
451 proc git_write {args} {
452 set opt [list |]
454 while {1} {
455 switch -- [lindex $args 0] {
456 --nice {
457 _lappend_nice opt
458 }
460 default {
461 break
462 }
464 }
466 set args [lrange $args 1 end]
467 }
469 set cmdp [_git_cmd [lindex $args 0]]
470 set args [lrange $args 1 end]
472 return [open [concat $opt $cmdp $args] w]
473 }
475 proc sq {value} {
476 regsub -all ' $value "'\\''" value
477 return "'$value'"
478 }
480 proc load_current_branch {} {
481 global current_branch is_detached
483 set fd [open [gitdir HEAD] r]
484 if {[gets $fd ref] < 1} {
485 set ref {}
486 }
487 close $fd
489 set pfx {ref: refs/heads/}
490 set len [string length $pfx]
491 if {[string equal -length $len $pfx $ref]} {
492 # We're on a branch. It might not exist. But
493 # HEAD looks good enough to be a branch.
494 #
495 set current_branch [string range $ref $len end]
496 set is_detached 0
497 } else {
498 # Assume this is a detached head.
499 #
500 set current_branch HEAD
501 set is_detached 1
502 }
503 }
505 auto_load tk_optionMenu
506 rename tk_optionMenu real__tkOptionMenu
507 proc tk_optionMenu {w varName args} {
508 set m [eval real__tkOptionMenu $w $varName $args]
509 $m configure -font font_ui
510 $w configure -font font_ui
511 return $m
512 }
514 proc rmsel_tag {text} {
515 $text tag conf sel \
516 -background [$text cget -background] \
517 -foreground [$text cget -foreground] \
518 -borderwidth 0
519 $text tag conf in_sel -background lightgray
520 bind $text <Motion> break
521 return $text
522 }
524 set root_exists 0
525 bind . <Visibility> {
526 bind . <Visibility> {}
527 set root_exists 1
528 }
530 ######################################################################
531 ##
532 ## config defaults
534 set cursor_ptr arrow
535 font create font_diff -family Courier -size 10
536 font create font_ui
537 catch {
538 label .dummy
539 eval font configure font_ui [font actual [.dummy cget -font]]
540 destroy .dummy
541 }
543 font create font_uiitalic
544 font create font_uibold
545 font create font_diffbold
546 font create font_diffitalic
548 foreach class {Button Checkbutton Entry Label
549 Labelframe Listbox Menu Message
550 Radiobutton Spinbox Text} {
551 option add *$class.font font_ui
552 }
553 unset class
555 if {[is_Windows] || [is_MacOSX]} {
556 option add *Menu.tearOff 0
557 }
559 if {[is_MacOSX]} {
560 set M1B M1
561 set M1T Cmd
562 } else {
563 set M1B Control
564 set M1T Ctrl
565 }
567 proc bind_button3 {w cmd} {
568 bind $w <Any-Button-3> $cmd
569 if {[is_MacOSX]} {
570 # Mac OS X sends Button-2 on right click through three-button mouse,
571 # or through trackpad right-clicking (two-finger touch + click).
572 bind $w <Any-Button-2> $cmd
573 bind $w <Control-Button-1> $cmd
574 }
575 }
577 proc apply_config {} {
578 global repo_config font_descs
580 foreach option $font_descs {
581 set name [lindex $option 0]
582 set font [lindex $option 1]
583 if {[catch {
584 foreach {cn cv} $repo_config(gui.$name) {
585 font configure $font $cn $cv -weight normal
586 }
587 } err]} {
588 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
589 }
590 foreach {cn cv} [font configure $font] {
591 font configure ${font}bold $cn $cv
592 font configure ${font}italic $cn $cv
593 }
594 font configure ${font}bold -weight bold
595 font configure ${font}italic -slant italic
596 }
597 }
599 set default_config(merge.diffstat) true
600 set default_config(merge.summary) false
601 set default_config(merge.verbosity) 2
602 set default_config(user.name) {}
603 set default_config(user.email) {}
605 set default_config(gui.matchtrackingbranch) false
606 set default_config(gui.pruneduringfetch) false
607 set default_config(gui.trustmtime) false
608 set default_config(gui.diffcontext) 5
609 set default_config(gui.newbranchtemplate) {}
610 set default_config(gui.fontui) [font configure font_ui]
611 set default_config(gui.fontdiff) [font configure font_diff]
612 set font_descs {
613 {fontui font_ui {mc "Main Font"}}
614 {fontdiff font_diff {mc "Diff/Console Font"}}
615 }
617 ######################################################################
618 ##
619 ## find git
621 set _git [_which git]
622 if {$_git eq {}} {
623 catch {wm withdraw .}
624 tk_messageBox \
625 -icon error \
626 -type ok \
627 -title [mc "git-gui: fatal error"] \
628 -message [mc "Cannot find git in PATH."]
629 exit 1
630 }
632 ######################################################################
633 ##
634 ## version check
636 if {[catch {set _git_version [git --version]} err]} {
637 catch {wm withdraw .}
638 tk_messageBox \
639 -icon error \
640 -type ok \
641 -title [mc "git-gui: fatal error"] \
642 -message "Cannot determine Git version:
644 $err
646 [appname] requires Git 1.5.0 or later."
647 exit 1
648 }
649 if {![regsub {^git version } $_git_version {} _git_version]} {
650 catch {wm withdraw .}
651 tk_messageBox \
652 -icon error \
653 -type ok \
654 -title [mc "git-gui: fatal error"] \
655 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
656 exit 1
657 }
659 set _real_git_version $_git_version
660 regsub -- {-dirty$} $_git_version {} _git_version
661 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
662 regsub {\.rc[0-9]+$} $_git_version {} _git_version
663 regsub {\.GIT$} $_git_version {} _git_version
665 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
666 catch {wm withdraw .}
667 if {[tk_messageBox \
668 -icon warning \
669 -type yesno \
670 -default no \
671 -title "[appname]: warning" \
672 -message [mc "Git version cannot be determined.
674 %s claims it is version '%s'.
676 %s requires at least Git 1.5.0 or later.
678 Assume '%s' is version 1.5.0?
679 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
680 set _git_version 1.5.0
681 } else {
682 exit 1
683 }
684 }
685 unset _real_git_version
687 proc git-version {args} {
688 global _git_version
690 switch [llength $args] {
691 0 {
692 return $_git_version
693 }
695 2 {
696 set op [lindex $args 0]
697 set vr [lindex $args 1]
698 set cm [package vcompare $_git_version $vr]
699 return [expr $cm $op 0]
700 }
702 4 {
703 set type [lindex $args 0]
704 set name [lindex $args 1]
705 set parm [lindex $args 2]
706 set body [lindex $args 3]
708 if {($type ne {proc} && $type ne {method})} {
709 error "Invalid arguments to git-version"
710 }
711 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
712 error "Last arm of $type $name must be default"
713 }
715 foreach {op vr cb} [lrange $body 0 end-2] {
716 if {[git-version $op $vr]} {
717 return [uplevel [list $type $name $parm $cb]]
718 }
719 }
721 return [uplevel [list $type $name $parm [lindex $body end]]]
722 }
724 default {
725 error "git-version >= x"
726 }
728 }
729 }
731 if {[git-version < 1.5]} {
732 catch {wm withdraw .}
733 tk_messageBox \
734 -icon error \
735 -type ok \
736 -title [mc "git-gui: fatal error"] \
737 -message "[appname] requires Git 1.5.0 or later.
739 You are using [git-version]:
741 [git --version]"
742 exit 1
743 }
745 ######################################################################
746 ##
747 ## configure our library
749 set idx [file join $oguilib tclIndex]
750 if {[catch {set fd [open $idx r]} err]} {
751 catch {wm withdraw .}
752 tk_messageBox \
753 -icon error \
754 -type ok \
755 -title [mc "git-gui: fatal error"] \
756 -message $err
757 exit 1
758 }
759 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
760 set idx [list]
761 while {[gets $fd n] >= 0} {
762 if {$n ne {} && ![string match #* $n]} {
763 lappend idx $n
764 }
765 }
766 } else {
767 set idx {}
768 }
769 close $fd
771 if {$idx ne {}} {
772 set loaded [list]
773 foreach p $idx {
774 if {[lsearch -exact $loaded $p] >= 0} continue
775 source [file join $oguilib $p]
776 lappend loaded $p
777 }
778 unset loaded p
779 } else {
780 set auto_path [concat [list $oguilib] $auto_path]
781 }
782 unset -nocomplain idx fd
784 ######################################################################
785 ##
786 ## feature option selection
788 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
789 unset _junk
790 } else {
791 set subcommand gui
792 }
793 if {$subcommand eq {gui.sh}} {
794 set subcommand gui
795 }
796 if {$subcommand eq {gui} && [llength $argv] > 0} {
797 set subcommand [lindex $argv 0]
798 set argv [lrange $argv 1 end]
799 }
801 enable_option multicommit
802 enable_option branch
803 enable_option transport
804 disable_option bare
806 switch -- $subcommand {
807 browser -
808 blame {
809 enable_option bare
811 disable_option multicommit
812 disable_option branch
813 disable_option transport
814 }
815 citool {
816 enable_option singlecommit
818 disable_option multicommit
819 disable_option branch
820 disable_option transport
821 }
822 }
824 ######################################################################
825 ##
826 ## repository setup
828 if {[catch {
829 set _gitdir $env(GIT_DIR)
830 set _prefix {}
831 }]
832 && [catch {
833 set _gitdir [git rev-parse --git-dir]
834 set _prefix [git rev-parse --show-prefix]
835 } err]} {
836 load_config 1
837 apply_config
838 choose_repository::pick
839 }
840 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
841 catch {set _gitdir [exec cygpath --windows $_gitdir]}
842 }
843 if {![file isdirectory $_gitdir]} {
844 catch {wm withdraw .}
845 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
846 exit 1
847 }
848 if {$_prefix ne {}} {
849 regsub -all {[^/]+/} $_prefix ../ cdup
850 if {[catch {cd $cdup} err]} {
851 catch {wm withdraw .}
852 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
853 exit 1
854 }
855 unset cdup
856 } elseif {![is_enabled bare]} {
857 if {[lindex [file split $_gitdir] end] ne {.git}} {
858 catch {wm withdraw .}
859 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
860 exit 1
861 }
862 if {[catch {cd [file dirname $_gitdir]} err]} {
863 catch {wm withdraw .}
864 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
865 exit 1
866 }
867 }
868 set _reponame [file split [file normalize $_gitdir]]
869 if {[lindex $_reponame end] eq {.git}} {
870 set _reponame [lindex $_reponame end-1]
871 } else {
872 set _reponame [lindex $_reponame end]
873 }
875 ######################################################################
876 ##
877 ## global init
879 set current_diff_path {}
880 set current_diff_side {}
881 set diff_actions [list]
883 set HEAD {}
884 set PARENT {}
885 set MERGE_HEAD [list]
886 set commit_type {}
887 set empty_tree {}
888 set current_branch {}
889 set is_detached 0
890 set current_diff_path {}
891 set is_3way_diff 0
892 set selected_commit_type new
894 ######################################################################
895 ##
896 ## task management
898 set rescan_active 0
899 set diff_active 0
900 set last_clicked {}
902 set disable_on_lock [list]
903 set index_lock_type none
905 proc lock_index {type} {
906 global index_lock_type disable_on_lock
908 if {$index_lock_type eq {none}} {
909 set index_lock_type $type
910 foreach w $disable_on_lock {
911 uplevel #0 $w disabled
912 }
913 return 1
914 } elseif {$index_lock_type eq "begin-$type"} {
915 set index_lock_type $type
916 return 1
917 }
918 return 0
919 }
921 proc unlock_index {} {
922 global index_lock_type disable_on_lock
924 set index_lock_type none
925 foreach w $disable_on_lock {
926 uplevel #0 $w normal
927 }
928 }
930 ######################################################################
931 ##
932 ## status
934 proc repository_state {ctvar hdvar mhvar} {
935 global current_branch
936 upvar $ctvar ct $hdvar hd $mhvar mh
938 set mh [list]
940 load_current_branch
941 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
942 set hd {}
943 set ct initial
944 return
945 }
947 set merge_head [gitdir MERGE_HEAD]
948 if {[file exists $merge_head]} {
949 set ct merge
950 set fd_mh [open $merge_head r]
951 while {[gets $fd_mh line] >= 0} {
952 lappend mh $line
953 }
954 close $fd_mh
955 return
956 }
958 set ct normal
959 }
961 proc PARENT {} {
962 global PARENT empty_tree
964 set p [lindex $PARENT 0]
965 if {$p ne {}} {
966 return $p
967 }
968 if {$empty_tree eq {}} {
969 set empty_tree [git mktree << {}]
970 }
971 return $empty_tree
972 }
974 proc rescan {after {honor_trustmtime 1}} {
975 global HEAD PARENT MERGE_HEAD commit_type
976 global ui_index ui_workdir ui_comm
977 global rescan_active file_states
978 global repo_config
980 if {$rescan_active > 0 || ![lock_index read]} return
982 repository_state newType newHEAD newMERGE_HEAD
983 if {[string match amend* $commit_type]
984 && $newType eq {normal}
985 && $newHEAD eq $HEAD} {
986 } else {
987 set HEAD $newHEAD
988 set PARENT $newHEAD
989 set MERGE_HEAD $newMERGE_HEAD
990 set commit_type $newType
991 }
993 array unset file_states
995 if {!$::GITGUI_BCK_exists &&
996 (![$ui_comm edit modified]
997 || [string trim [$ui_comm get 0.0 end]] eq {})} {
998 if {[string match amend* $commit_type]} {
999 } elseif {[load_message GITGUI_MSG]} {
1000 } elseif {[load_message MERGE_MSG]} {
1001 } elseif {[load_message SQUASH_MSG]} {
1002 }
1003 $ui_comm edit reset
1004 $ui_comm edit modified false
1005 }
1007 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1008 rescan_stage2 {} $after
1009 } else {
1010 set rescan_active 1
1011 ui_status [mc "Refreshing file status..."]
1012 set fd_rf [git_read update-index \
1013 -q \
1014 --unmerged \
1015 --ignore-missing \
1016 --refresh \
1017 ]
1018 fconfigure $fd_rf -blocking 0 -translation binary
1019 fileevent $fd_rf readable \
1020 [list rescan_stage2 $fd_rf $after]
1021 }
1022 }
1024 if {[is_Cygwin]} {
1025 set is_git_info_link {}
1026 set is_git_info_exclude {}
1027 proc have_info_exclude {} {
1028 global is_git_info_link is_git_info_exclude
1030 if {$is_git_info_link eq {}} {
1031 set is_git_info_link [file isfile [gitdir info.lnk]]
1032 }
1034 if {$is_git_info_link} {
1035 if {$is_git_info_exclude eq {}} {
1036 if {[catch {exec test -f [gitdir info exclude]}]} {
1037 set is_git_info_exclude 0
1038 } else {
1039 set is_git_info_exclude 1
1040 }
1041 }
1042 return $is_git_info_exclude
1043 } else {
1044 return [file readable [gitdir info exclude]]
1045 }
1046 }
1047 } else {
1048 proc have_info_exclude {} {
1049 return [file readable [gitdir info exclude]]
1050 }
1051 }
1053 proc rescan_stage2 {fd after} {
1054 global rescan_active buf_rdi buf_rdf buf_rlo
1056 if {$fd ne {}} {
1057 read $fd
1058 if {![eof $fd]} return
1059 close $fd
1060 }
1062 set ls_others [list --exclude-per-directory=.gitignore]
1063 if {[have_info_exclude]} {
1064 lappend ls_others "--exclude-from=[gitdir info exclude]"
1065 }
1066 set user_exclude [get_config core.excludesfile]
1067 if {$user_exclude ne {} && [file readable $user_exclude]} {
1068 lappend ls_others "--exclude-from=$user_exclude"
1069 }
1071 set buf_rdi {}
1072 set buf_rdf {}
1073 set buf_rlo {}
1075 set rescan_active 3
1076 ui_status [mc "Scanning for modified files ..."]
1077 set fd_di [git_read diff-index --cached -z [PARENT]]
1078 set fd_df [git_read diff-files -z]
1079 set fd_lo [eval git_read ls-files --others -z $ls_others]
1081 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1082 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1083 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1084 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1085 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1086 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1087 }
1089 proc load_message {file} {
1090 global ui_comm
1092 set f [gitdir $file]
1093 if {[file isfile $f]} {
1094 if {[catch {set fd [open $f r]}]} {
1095 return 0
1096 }
1097 fconfigure $fd -eofchar {}
1098 set content [string trim [read $fd]]
1099 close $fd
1100 regsub -all -line {[ \r\t]+$} $content {} content
1101 $ui_comm delete 0.0 end
1102 $ui_comm insert end $content
1103 return 1
1104 }
1105 return 0
1106 }
1108 proc read_diff_index {fd after} {
1109 global buf_rdi
1111 append buf_rdi [read $fd]
1112 set c 0
1113 set n [string length $buf_rdi]
1114 while {$c < $n} {
1115 set z1 [string first "\0" $buf_rdi $c]
1116 if {$z1 == -1} break
1117 incr z1
1118 set z2 [string first "\0" $buf_rdi $z1]
1119 if {$z2 == -1} break
1121 incr c
1122 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1123 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1124 merge_state \
1125 [encoding convertfrom $p] \
1126 [lindex $i 4]? \
1127 [list [lindex $i 0] [lindex $i 2]] \
1128 [list]
1129 set c $z2
1130 incr c
1131 }
1132 if {$c < $n} {
1133 set buf_rdi [string range $buf_rdi $c end]
1134 } else {
1135 set buf_rdi {}
1136 }
1138 rescan_done $fd buf_rdi $after
1139 }
1141 proc read_diff_files {fd after} {
1142 global buf_rdf
1144 append buf_rdf [read $fd]
1145 set c 0
1146 set n [string length $buf_rdf]
1147 while {$c < $n} {
1148 set z1 [string first "\0" $buf_rdf $c]
1149 if {$z1 == -1} break
1150 incr z1
1151 set z2 [string first "\0" $buf_rdf $z1]
1152 if {$z2 == -1} break
1154 incr c
1155 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1156 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1157 merge_state \
1158 [encoding convertfrom $p] \
1159 ?[lindex $i 4] \
1160 [list] \
1161 [list [lindex $i 0] [lindex $i 2]]
1162 set c $z2
1163 incr c
1164 }
1165 if {$c < $n} {
1166 set buf_rdf [string range $buf_rdf $c end]
1167 } else {
1168 set buf_rdf {}
1169 }
1171 rescan_done $fd buf_rdf $after
1172 }
1174 proc read_ls_others {fd after} {
1175 global buf_rlo
1177 append buf_rlo [read $fd]
1178 set pck [split $buf_rlo "\0"]
1179 set buf_rlo [lindex $pck end]
1180 foreach p [lrange $pck 0 end-1] {
1181 set p [encoding convertfrom $p]
1182 if {[string index $p end] eq {/}} {
1183 set p [string range $p 0 end-1]
1184 }
1185 merge_state $p ?O
1186 }
1187 rescan_done $fd buf_rlo $after
1188 }
1190 proc rescan_done {fd buf after} {
1191 global rescan_active current_diff_path
1192 global file_states repo_config
1193 upvar $buf to_clear
1195 if {![eof $fd]} return
1196 set to_clear {}
1197 close $fd
1198 if {[incr rescan_active -1] > 0} return
1200 prune_selection
1201 unlock_index
1202 display_all_files
1203 if {$current_diff_path ne {}} reshow_diff
1204 uplevel #0 $after
1205 }
1207 proc prune_selection {} {
1208 global file_states selected_paths
1210 foreach path [array names selected_paths] {
1211 if {[catch {set still_here $file_states($path)}]} {
1212 unset selected_paths($path)
1213 }
1214 }
1215 }
1217 ######################################################################
1218 ##
1219 ## ui helpers
1221 proc mapicon {w state path} {
1222 global all_icons
1224 if {[catch {set r $all_icons($state$w)}]} {
1225 puts "error: no icon for $w state={$state} $path"
1226 return file_plain
1227 }
1228 return $r
1229 }
1231 proc mapdesc {state path} {
1232 global all_descs
1234 if {[catch {set r $all_descs($state)}]} {
1235 puts "error: no desc for state={$state} $path"
1236 return $state
1237 }
1238 return $r
1239 }
1241 proc ui_status {msg} {
1242 $::main_status show $msg
1243 }
1245 proc ui_ready {{test {}}} {
1246 $::main_status show [mc "Ready."] $test
1247 }
1249 proc escape_path {path} {
1250 regsub -all {\\} $path "\\\\" path
1251 regsub -all "\n" $path "\\n" path
1252 return $path
1253 }
1255 proc short_path {path} {
1256 return [escape_path [lindex [file split $path] end]]
1257 }
1259 set next_icon_id 0
1260 set null_sha1 [string repeat 0 40]
1262 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1263 global file_states next_icon_id null_sha1
1265 set s0 [string index $new_state 0]
1266 set s1 [string index $new_state 1]
1268 if {[catch {set info $file_states($path)}]} {
1269 set state __
1270 set icon n[incr next_icon_id]
1271 } else {
1272 set state [lindex $info 0]
1273 set icon [lindex $info 1]
1274 if {$head_info eq {}} {set head_info [lindex $info 2]}
1275 if {$index_info eq {}} {set index_info [lindex $info 3]}
1276 }
1278 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1279 elseif {$s0 eq {_}} {set s0 _}
1281 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1282 elseif {$s1 eq {_}} {set s1 _}
1284 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1285 set head_info [list 0 $null_sha1]
1286 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1287 && $head_info eq {}} {
1288 set head_info $index_info
1289 }
1291 set file_states($path) [list $s0$s1 $icon \
1292 $head_info $index_info \
1293 ]
1294 return $state
1295 }
1297 proc display_file_helper {w path icon_name old_m new_m} {
1298 global file_lists
1300 if {$new_m eq {_}} {
1301 set lno [lsearch -sorted -exact $file_lists($w) $path]
1302 if {$lno >= 0} {
1303 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1304 incr lno
1305 $w conf -state normal
1306 $w delete $lno.0 [expr {$lno + 1}].0
1307 $w conf -state disabled
1308 }
1309 } elseif {$old_m eq {_} && $new_m ne {_}} {
1310 lappend file_lists($w) $path
1311 set file_lists($w) [lsort -unique $file_lists($w)]
1312 set lno [lsearch -sorted -exact $file_lists($w) $path]
1313 incr lno
1314 $w conf -state normal
1315 $w image create $lno.0 \
1316 -align center -padx 5 -pady 1 \
1317 -name $icon_name \
1318 -image [mapicon $w $new_m $path]
1319 $w insert $lno.1 "[escape_path $path]\n"
1320 $w conf -state disabled
1321 } elseif {$old_m ne $new_m} {
1322 $w conf -state normal
1323 $w image conf $icon_name -image [mapicon $w $new_m $path]
1324 $w conf -state disabled
1325 }
1326 }
1328 proc display_file {path state} {
1329 global file_states selected_paths
1330 global ui_index ui_workdir
1332 set old_m [merge_state $path $state]
1333 set s $file_states($path)
1334 set new_m [lindex $s 0]
1335 set icon_name [lindex $s 1]
1337 set o [string index $old_m 0]
1338 set n [string index $new_m 0]
1339 if {$o eq {U}} {
1340 set o _
1341 }
1342 if {$n eq {U}} {
1343 set n _
1344 }
1345 display_file_helper $ui_index $path $icon_name $o $n
1347 if {[string index $old_m 0] eq {U}} {
1348 set o U
1349 } else {
1350 set o [string index $old_m 1]
1351 }
1352 if {[string index $new_m 0] eq {U}} {
1353 set n U
1354 } else {
1355 set n [string index $new_m 1]
1356 }
1357 display_file_helper $ui_workdir $path $icon_name $o $n
1359 if {$new_m eq {__}} {
1360 unset file_states($path)
1361 catch {unset selected_paths($path)}
1362 }
1363 }
1365 proc display_all_files_helper {w path icon_name m} {
1366 global file_lists
1368 lappend file_lists($w) $path
1369 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1370 $w image create end \
1371 -align center -padx 5 -pady 1 \
1372 -name $icon_name \
1373 -image [mapicon $w $m $path]
1374 $w insert end "[escape_path $path]\n"
1375 }
1377 proc display_all_files {} {
1378 global ui_index ui_workdir
1379 global file_states file_lists
1380 global last_clicked
1382 $ui_index conf -state normal
1383 $ui_workdir conf -state normal
1385 $ui_index delete 0.0 end
1386 $ui_workdir delete 0.0 end
1387 set last_clicked {}
1389 set file_lists($ui_index) [list]
1390 set file_lists($ui_workdir) [list]
1392 foreach path [lsort [array names file_states]] {
1393 set s $file_states($path)
1394 set m [lindex $s 0]
1395 set icon_name [lindex $s 1]
1397 set s [string index $m 0]
1398 if {$s ne {U} && $s ne {_}} {
1399 display_all_files_helper $ui_index $path \
1400 $icon_name $s
1401 }
1403 if {[string index $m 0] eq {U}} {
1404 set s U
1405 } else {
1406 set s [string index $m 1]
1407 }
1408 if {$s ne {_}} {
1409 display_all_files_helper $ui_workdir $path \
1410 $icon_name $s
1411 }
1412 }
1414 $ui_index conf -state disabled
1415 $ui_workdir conf -state disabled
1416 }
1418 ######################################################################
1419 ##
1420 ## icons
1422 set filemask {
1423 #define mask_width 14
1424 #define mask_height 15
1425 static unsigned char mask_bits[] = {
1426 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1427 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1428 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1429 }
1431 image create bitmap file_plain -background white -foreground black -data {
1432 #define plain_width 14
1433 #define plain_height 15
1434 static unsigned char plain_bits[] = {
1435 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1436 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1437 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1438 } -maskdata $filemask
1440 image create bitmap file_mod -background white -foreground blue -data {
1441 #define mod_width 14
1442 #define mod_height 15
1443 static unsigned char mod_bits[] = {
1444 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1445 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1446 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1447 } -maskdata $filemask
1449 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1450 #define file_fulltick_width 14
1451 #define file_fulltick_height 15
1452 static unsigned char file_fulltick_bits[] = {
1453 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1454 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1455 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1456 } -maskdata $filemask
1458 image create bitmap file_parttick -background white -foreground "#005050" -data {
1459 #define parttick_width 14
1460 #define parttick_height 15
1461 static unsigned char parttick_bits[] = {
1462 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1463 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1464 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1465 } -maskdata $filemask
1467 image create bitmap file_question -background white -foreground black -data {
1468 #define file_question_width 14
1469 #define file_question_height 15
1470 static unsigned char file_question_bits[] = {
1471 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1472 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1473 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1474 } -maskdata $filemask
1476 image create bitmap file_removed -background white -foreground red -data {
1477 #define file_removed_width 14
1478 #define file_removed_height 15
1479 static unsigned char file_removed_bits[] = {
1480 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1481 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1482 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1483 } -maskdata $filemask
1485 image create bitmap file_merge -background white -foreground blue -data {
1486 #define file_merge_width 14
1487 #define file_merge_height 15
1488 static unsigned char file_merge_bits[] = {
1489 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1490 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1491 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1492 } -maskdata $filemask
1494 set ui_index .vpane.files.index.list
1495 set ui_workdir .vpane.files.workdir.list
1497 set all_icons(_$ui_index) file_plain
1498 set all_icons(A$ui_index) file_fulltick
1499 set all_icons(M$ui_index) file_fulltick
1500 set all_icons(D$ui_index) file_removed
1501 set all_icons(U$ui_index) file_merge
1503 set all_icons(_$ui_workdir) file_plain
1504 set all_icons(M$ui_workdir) file_mod
1505 set all_icons(D$ui_workdir) file_question
1506 set all_icons(U$ui_workdir) file_merge
1507 set all_icons(O$ui_workdir) file_plain
1509 set max_status_desc 0
1510 foreach i {
1511 {__ {mc "Unmodified"}}
1513 {_M {mc "Modified, not staged"}}
1514 {M_ {mc "Staged for commit"}}
1515 {MM {mc "Portions staged for commit"}}
1516 {MD {mc "Staged for commit, missing"}}
1518 {_O {mc "Untracked, not staged"}}
1519 {A_ {mc "Staged for commit"}}
1520 {AM {mc "Portions staged for commit"}}
1521 {AD {mc "Staged for commit, missing"}}
1523 {_D {mc "Missing"}}
1524 {D_ {mc "Staged for removal"}}
1525 {DO {mc "Staged for removal, still present"}}
1527 {U_ {mc "Requires merge resolution"}}
1528 {UU {mc "Requires merge resolution"}}
1529 {UM {mc "Requires merge resolution"}}
1530 {UD {mc "Requires merge resolution"}}
1531 } {
1532 set text [eval [lindex $i 1]]
1533 if {$max_status_desc < [string length $text]} {
1534 set max_status_desc [string length $text]
1535 }
1536 set all_descs([lindex $i 0]) $text
1537 }
1538 unset i
1540 ######################################################################
1541 ##
1542 ## util
1544 proc scrollbar2many {list mode args} {
1545 foreach w $list {eval $w $mode $args}
1546 }
1548 proc many2scrollbar {list mode sb top bottom} {
1549 $sb set $top $bottom
1550 foreach w $list {$w $mode moveto $top}
1551 }
1553 proc incr_font_size {font {amt 1}} {
1554 set sz [font configure $font -size]
1555 incr sz $amt
1556 font configure $font -size $sz
1557 font configure ${font}bold -size $sz
1558 font configure ${font}italic -size $sz
1559 }
1561 ######################################################################
1562 ##
1563 ## ui commands
1565 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1567 proc do_gitk {revs} {
1568 # -- Always start gitk through whatever we were loaded with. This
1569 # lets us bypass using shell process on Windows systems.
1570 #
1571 set exe [file join [file dirname $::_git] gitk]
1572 set cmd [list [info nameofexecutable] $exe]
1573 if {! [file exists $exe]} {
1574 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1575 } else {
1576 eval exec $cmd $revs &
1577 ui_status $::starting_gitk_msg
1578 after 10000 {
1579 ui_ready $starting_gitk_msg
1580 }
1581 }
1582 }
1584 set is_quitting 0
1586 proc do_quit {} {
1587 global ui_comm is_quitting repo_config commit_type
1588 global GITGUI_BCK_exists GITGUI_BCK_i
1590 if {$is_quitting} return
1591 set is_quitting 1
1593 if {[winfo exists $ui_comm]} {
1594 # -- Stash our current commit buffer.
1595 #
1596 set save [gitdir GITGUI_MSG]
1597 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1598 file rename -force [gitdir GITGUI_BCK] $save
1599 set GITGUI_BCK_exists 0
1600 } else {
1601 set msg [string trim [$ui_comm get 0.0 end]]
1602 regsub -all -line {[ \r\t]+$} $msg {} msg
1603 if {(![string match amend* $commit_type]
1604 || [$ui_comm edit modified])
1605 && $msg ne {}} {
1606 catch {
1607 set fd [open $save w]
1608 puts -nonewline $fd $msg
1609 close $fd
1610 }
1611 } else {
1612 catch {file delete $save}
1613 }
1614 }
1616 # -- Remove our editor backup, its not needed.
1617 #
1618 after cancel $GITGUI_BCK_i
1619 if {$GITGUI_BCK_exists} {
1620 catch {file delete [gitdir GITGUI_BCK]}
1621 }
1623 # -- Stash our current window geometry into this repository.
1624 #
1625 set cfg_geometry [list]
1626 lappend cfg_geometry [wm geometry .]
1627 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1628 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1629 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1630 set rc_geometry {}
1631 }
1632 if {$cfg_geometry ne $rc_geometry} {
1633 catch {git config gui.geometry $cfg_geometry}
1634 }
1635 }
1637 destroy .
1638 }
1640 proc do_rescan {} {
1641 rescan ui_ready
1642 }
1644 proc do_commit {} {
1645 commit_tree
1646 }
1648 proc toggle_or_diff {w x y} {
1649 global file_states file_lists current_diff_path ui_index ui_workdir
1650 global last_clicked selected_paths
1652 set pos [split [$w index @$x,$y] .]
1653 set lno [lindex $pos 0]
1654 set col [lindex $pos 1]
1655 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1656 if {$path eq {}} {
1657 set last_clicked {}
1658 return
1659 }
1661 set last_clicked [list $w $lno]
1662 array unset selected_paths
1663 $ui_index tag remove in_sel 0.0 end
1664 $ui_workdir tag remove in_sel 0.0 end
1666 if {$col == 0} {
1667 if {$current_diff_path eq $path} {
1668 set after {reshow_diff;}
1669 } else {
1670 set after {}
1671 }
1672 if {$w eq $ui_index} {
1673 update_indexinfo \
1674 "Unstaging [short_path $path] from commit" \
1675 [list $path] \
1676 [concat $after [list ui_ready]]
1677 } elseif {$w eq $ui_workdir} {
1678 update_index \
1679 "Adding [short_path $path]" \
1680 [list $path] \
1681 [concat $after [list ui_ready]]
1682 }
1683 } else {
1684 show_diff $path $w $lno
1685 }
1686 }
1688 proc add_one_to_selection {w x y} {
1689 global file_lists last_clicked selected_paths
1691 set lno [lindex [split [$w index @$x,$y] .] 0]
1692 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1693 if {$path eq {}} {
1694 set last_clicked {}
1695 return
1696 }
1698 if {$last_clicked ne {}
1699 && [lindex $last_clicked 0] ne $w} {
1700 array unset selected_paths
1701 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1702 }
1704 set last_clicked [list $w $lno]
1705 if {[catch {set in_sel $selected_paths($path)}]} {
1706 set in_sel 0
1707 }
1708 if {$in_sel} {
1709 unset selected_paths($path)
1710 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1711 } else {
1712 set selected_paths($path) 1
1713 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1714 }
1715 }
1717 proc add_range_to_selection {w x y} {
1718 global file_lists last_clicked selected_paths
1720 if {[lindex $last_clicked 0] ne $w} {
1721 toggle_or_diff $w $x $y
1722 return
1723 }
1725 set lno [lindex [split [$w index @$x,$y] .] 0]
1726 set lc [lindex $last_clicked 1]
1727 if {$lc < $lno} {
1728 set begin $lc
1729 set end $lno
1730 } else {
1731 set begin $lno
1732 set end $lc
1733 }
1735 foreach path [lrange $file_lists($w) \
1736 [expr {$begin - 1}] \
1737 [expr {$end - 1}]] {
1738 set selected_paths($path) 1
1739 }
1740 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1741 }
1743 ######################################################################
1744 ##
1745 ## ui construction
1747 load_config 0
1748 apply_config
1749 set ui_comm {}
1751 # -- Menu Bar
1752 #
1753 menu .mbar -tearoff 0
1754 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1755 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1756 if {[is_enabled branch]} {
1757 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1758 }
1759 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1760 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1761 }
1762 if {[is_enabled transport]} {
1763 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1764 .mbar add cascade -label [mc Fetch] -menu .mbar.fetch
1765 .mbar add cascade -label [mc Push] -menu .mbar.push
1766 }
1767 . configure -menu .mbar
1769 # -- Repository Menu
1770 #
1771 menu .mbar.repository
1773 .mbar.repository add command \
1774 -label [mc "Browse Current Branch's Files"] \
1775 -command {browser::new $current_branch}
1776 set ui_browse_current [.mbar.repository index last]
1777 .mbar.repository add command \
1778 -label [mc "Browse Branch Files..."] \
1779 -command browser_open::dialog
1780 .mbar.repository add separator
1782 .mbar.repository add command \
1783 -label [mc "Visualize Current Branch's History"] \
1784 -command {do_gitk $current_branch}
1785 set ui_visualize_current [.mbar.repository index last]
1786 .mbar.repository add command \
1787 -label [mc "Visualize All Branch History"] \
1788 -command {do_gitk --all}
1789 .mbar.repository add separator
1791 proc current_branch_write {args} {
1792 global current_branch
1793 .mbar.repository entryconf $::ui_browse_current \
1794 -label [mc "Browse %s's Files" $current_branch]
1795 .mbar.repository entryconf $::ui_visualize_current \
1796 -label [mc "Visualize %s's History" $current_branch]
1797 }
1798 trace add variable current_branch write current_branch_write
1800 if {[is_enabled multicommit]} {
1801 .mbar.repository add command -label [mc "Database Statistics"] \
1802 -command do_stats
1804 .mbar.repository add command -label [mc "Compress Database"] \
1805 -command do_gc
1807 .mbar.repository add command -label [mc "Verify Database"] \
1808 -command do_fsck_objects
1810 .mbar.repository add separator
1812 if {[is_Cygwin]} {
1813 .mbar.repository add command \
1814 -label [mc "Create Desktop Icon"] \
1815 -command do_cygwin_shortcut
1816 } elseif {[is_Windows]} {
1817 .mbar.repository add command \
1818 -label [mc "Create Desktop Icon"] \
1819 -command do_windows_shortcut
1820 } elseif {[is_MacOSX]} {
1821 .mbar.repository add command \
1822 -label [mc "Create Desktop Icon"] \
1823 -command do_macosx_app
1824 }
1825 }
1827 .mbar.repository add command -label [mc Quit] \
1828 -command do_quit \
1829 -accelerator $M1T-Q
1831 # -- Edit Menu
1832 #
1833 menu .mbar.edit
1834 .mbar.edit add command -label [mc Undo] \
1835 -command {catch {[focus] edit undo}} \
1836 -accelerator $M1T-Z
1837 .mbar.edit add command -label [mc Redo] \
1838 -command {catch {[focus] edit redo}} \
1839 -accelerator $M1T-Y
1840 .mbar.edit add separator
1841 .mbar.edit add command -label [mc Cut] \
1842 -command {catch {tk_textCut [focus]}} \
1843 -accelerator $M1T-X
1844 .mbar.edit add command -label [mc Copy] \
1845 -command {catch {tk_textCopy [focus]}} \
1846 -accelerator $M1T-C
1847 .mbar.edit add command -label [mc Paste] \
1848 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1849 -accelerator $M1T-V
1850 .mbar.edit add command -label [mc Delete] \
1851 -command {catch {[focus] delete sel.first sel.last}} \
1852 -accelerator Del
1853 .mbar.edit add separator
1854 .mbar.edit add command -label [mc "Select All"] \
1855 -command {catch {[focus] tag add sel 0.0 end}} \
1856 -accelerator $M1T-A
1858 # -- Branch Menu
1859 #
1860 if {[is_enabled branch]} {
1861 menu .mbar.branch
1863 .mbar.branch add command -label [mc "Create..."] \
1864 -command branch_create::dialog \
1865 -accelerator $M1T-N
1866 lappend disable_on_lock [list .mbar.branch entryconf \
1867 [.mbar.branch index last] -state]
1869 .mbar.branch add command -label [mc "Checkout..."] \
1870 -command branch_checkout::dialog \
1871 -accelerator $M1T-O
1872 lappend disable_on_lock [list .mbar.branch entryconf \
1873 [.mbar.branch index last] -state]
1875 .mbar.branch add command -label [mc "Rename..."] \
1876 -command branch_rename::dialog
1877 lappend disable_on_lock [list .mbar.branch entryconf \
1878 [.mbar.branch index last] -state]
1880 .mbar.branch add command -label [mc "Delete..."] \
1881 -command branch_delete::dialog
1882 lappend disable_on_lock [list .mbar.branch entryconf \
1883 [.mbar.branch index last] -state]
1885 .mbar.branch add command -label [mc "Reset..."] \
1886 -command merge::reset_hard
1887 lappend disable_on_lock [list .mbar.branch entryconf \
1888 [.mbar.branch index last] -state]
1889 }
1891 # -- Commit Menu
1892 #
1893 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1894 menu .mbar.commit
1896 .mbar.commit add radiobutton \
1897 -label [mc "New Commit"] \
1898 -command do_select_commit_type \
1899 -variable selected_commit_type \
1900 -value new
1901 lappend disable_on_lock \
1902 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1904 .mbar.commit add radiobutton \
1905 -label [mc "Amend Last Commit"] \
1906 -command do_select_commit_type \
1907 -variable selected_commit_type \
1908 -value amend
1909 lappend disable_on_lock \
1910 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1912 .mbar.commit add separator
1914 .mbar.commit add command -label [mc Rescan] \
1915 -command do_rescan \
1916 -accelerator F5
1917 lappend disable_on_lock \
1918 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1920 .mbar.commit add command -label [mc "Stage To Commit"] \
1921 -command do_add_selection
1922 lappend disable_on_lock \
1923 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1925 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1926 -command do_add_all \
1927 -accelerator $M1T-I
1928 lappend disable_on_lock \
1929 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1931 .mbar.commit add command -label [mc "Unstage From Commit"] \
1932 -command do_unstage_selection
1933 lappend disable_on_lock \
1934 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1936 .mbar.commit add command -label [mc "Revert Changes"] \
1937 -command do_revert_selection
1938 lappend disable_on_lock \
1939 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1941 .mbar.commit add separator
1943 .mbar.commit add command -label [mc "Sign Off"] \
1944 -command do_signoff \
1945 -accelerator $M1T-S
1947 .mbar.commit add command -label [mc Commit@@verb] \
1948 -command do_commit \
1949 -accelerator $M1T-Return
1950 lappend disable_on_lock \
1951 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1952 }
1954 # -- Merge Menu
1955 #
1956 if {[is_enabled branch]} {
1957 menu .mbar.merge
1958 .mbar.merge add command -label [mc "Local Merge..."] \
1959 -command merge::dialog \
1960 -accelerator $M1T-M
1961 lappend disable_on_lock \
1962 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1963 .mbar.merge add command -label [mc "Abort Merge..."] \
1964 -command merge::reset_hard
1965 lappend disable_on_lock \
1966 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1967 }
1969 # -- Transport Menu
1970 #
1971 if {[is_enabled transport]} {
1972 menu .mbar.fetch
1974 menu .mbar.push
1975 .mbar.push add command -label [mc "Push..."] \
1976 -command do_push_anywhere \
1977 -accelerator $M1T-P
1978 .mbar.push add command -label [mc "Delete..."] \
1979 -command remote_branch_delete::dialog
1980 }
1982 if {[is_MacOSX]} {
1983 # -- Apple Menu (Mac OS X only)
1984 #
1985 .mbar add cascade -label [mc Apple] -menu .mbar.apple
1986 menu .mbar.apple
1988 .mbar.apple add command -label [mc "About %s" [appname]] \
1989 -command do_about
1990 .mbar.apple add command -label [mc "Options..."] \
1991 -command do_options
1992 } else {
1993 # -- Edit Menu
1994 #
1995 .mbar.edit add separator
1996 .mbar.edit add command -label [mc "Options..."] \
1997 -command do_options
1998 }
2000 # -- Help Menu
2001 #
2002 .mbar add cascade -label [mc Help] -menu .mbar.help
2003 menu .mbar.help
2005 if {![is_MacOSX]} {
2006 .mbar.help add command -label [mc "About %s" [appname]] \
2007 -command do_about
2008 }
2010 set browser {}
2011 catch {set browser $repo_config(instaweb.browser)}
2012 set doc_path [file dirname [gitexec]]
2013 set doc_path [file join $doc_path Documentation index.html]
2015 if {[is_Cygwin]} {
2016 set doc_path [exec cygpath --mixed $doc_path]
2017 }
2019 if {$browser eq {}} {
2020 if {[is_MacOSX]} {
2021 set browser open
2022 } elseif {[is_Cygwin]} {
2023 set program_files [file dirname [exec cygpath --windir]]
2024 set program_files [file join $program_files {Program Files}]
2025 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2026 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2027 if {[file exists $firefox]} {
2028 set browser $firefox
2029 } elseif {[file exists $ie]} {
2030 set browser $ie
2031 }
2032 unset program_files firefox ie
2033 }
2034 }
2036 if {[file isfile $doc_path]} {
2037 set doc_url "file:$doc_path"
2038 } else {
2039 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2040 }
2042 if {$browser ne {}} {
2043 .mbar.help add command -label [mc "Online Documentation"] \
2044 -command [list exec $browser $doc_url &]
2045 }
2046 unset browser doc_path doc_url
2048 # -- Standard bindings
2049 #
2050 wm protocol . WM_DELETE_WINDOW do_quit
2051 bind all <$M1B-Key-q> do_quit
2052 bind all <$M1B-Key-Q> do_quit
2053 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2054 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2056 set subcommand_args {}
2057 proc usage {} {
2058 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2059 exit 1
2060 }
2062 # -- Not a normal commit type invocation? Do that instead!
2063 #
2064 switch -- $subcommand {
2065 browser -
2066 blame {
2067 set subcommand_args {rev? path}
2068 if {$argv eq {}} usage
2069 set head {}
2070 set path {}
2071 set is_path 0
2072 foreach a $argv {
2073 if {$is_path || [file exists $_prefix$a]} {
2074 if {$path ne {}} usage
2075 set path $_prefix$a
2076 break
2077 } elseif {$a eq {--}} {
2078 if {$path ne {}} {
2079 if {$head ne {}} usage
2080 set head $path
2081 set path {}
2082 }
2083 set is_path 1
2084 } elseif {$head eq {}} {
2085 if {$head ne {}} usage
2086 set head $a
2087 set is_path 1
2088 } else {
2089 usage
2090 }
2091 }
2092 unset is_path
2094 if {$head ne {} && $path eq {}} {
2095 set path $_prefix$head
2096 set head {}
2097 }
2099 if {$head eq {}} {
2100 load_current_branch
2101 } else {
2102 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2103 if {[catch {
2104 set head [git rev-parse --verify $head]
2105 } err]} {
2106 puts stderr $err
2107 exit 1
2108 }
2109 }
2110 set current_branch $head
2111 }
2113 switch -- $subcommand {
2114 browser {
2115 if {$head eq {}} {
2116 if {$path ne {} && [file isdirectory $path]} {
2117 set head $current_branch
2118 } else {
2119 set head $path
2120 set path {}
2121 }
2122 }
2123 browser::new $head $path
2124 }
2125 blame {
2126 if {$head eq {} && ![file exists $path]} {
2127 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2128 exit 1
2129 }
2130 blame::new $head $path
2131 }
2132 }
2133 return
2134 }
2135 citool -
2136 gui {
2137 if {[llength $argv] != 0} {
2138 puts -nonewline stderr "usage: $argv0"
2139 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2140 puts -nonewline stderr " $subcommand"
2141 }
2142 puts stderr {}
2143 exit 1
2144 }
2145 # fall through to setup UI for commits
2146 }
2147 default {
2148 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2149 exit 1
2150 }
2151 }
2153 # -- Branch Control
2154 #
2155 frame .branch \
2156 -borderwidth 1 \
2157 -relief sunken
2158 label .branch.l1 \
2159 -text [mc "Current Branch:"] \
2160 -anchor w \
2161 -justify left
2162 label .branch.cb \
2163 -textvariable current_branch \
2164 -anchor w \
2165 -justify left
2166 pack .branch.l1 -side left
2167 pack .branch.cb -side left -fill x
2168 pack .branch -side top -fill x
2170 # -- Main Window Layout
2171 #
2172 panedwindow .vpane -orient vertical
2173 panedwindow .vpane.files -orient horizontal
2174 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2175 pack .vpane -anchor n -side top -fill both -expand 1
2177 # -- Index File List
2178 #
2179 frame .vpane.files.index -height 100 -width 200
2180 label .vpane.files.index.title -text [mc "Staged Changes (Will Be Committed)"] \
2181 -background lightgreen
2182 text $ui_index -background white -borderwidth 0 \
2183 -width 20 -height 10 \
2184 -wrap none \
2185 -cursor $cursor_ptr \
2186 -xscrollcommand {.vpane.files.index.sx set} \
2187 -yscrollcommand {.vpane.files.index.sy set} \
2188 -state disabled
2189 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2190 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2191 pack .vpane.files.index.title -side top -fill x
2192 pack .vpane.files.index.sx -side bottom -fill x
2193 pack .vpane.files.index.sy -side right -fill y
2194 pack $ui_index -side left -fill both -expand 1
2195 .vpane.files add .vpane.files.index -sticky nsew
2197 # -- Working Directory File List
2198 #
2199 frame .vpane.files.workdir -height 100 -width 200
2200 label .vpane.files.workdir.title -text [mc "Unstaged Changes (Will Not Be Committed)"] \
2201 -background lightsalmon
2202 text $ui_workdir -background white -borderwidth 0 \
2203 -width 20 -height 10 \
2204 -wrap none \
2205 -cursor $cursor_ptr \
2206 -xscrollcommand {.vpane.files.workdir.sx set} \
2207 -yscrollcommand {.vpane.files.workdir.sy set} \
2208 -state disabled
2209 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2210 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2211 pack .vpane.files.workdir.title -side top -fill x
2212 pack .vpane.files.workdir.sx -side bottom -fill x
2213 pack .vpane.files.workdir.sy -side right -fill y
2214 pack $ui_workdir -side left -fill both -expand 1
2215 .vpane.files add .vpane.files.workdir -sticky nsew
2217 foreach i [list $ui_index $ui_workdir] {
2218 rmsel_tag $i
2219 $i tag conf in_diff -background [$i tag cget in_sel -background]
2220 }
2221 unset i
2223 # -- Diff and Commit Area
2224 #
2225 frame .vpane.lower -height 300 -width 400
2226 frame .vpane.lower.commarea
2227 frame .vpane.lower.diff -relief sunken -borderwidth 1
2228 pack .vpane.lower.commarea -side top -fill x
2229 pack .vpane.lower.diff -side bottom -fill both -expand 1
2230 .vpane add .vpane.lower -sticky nsew
2232 # -- Commit Area Buttons
2233 #
2234 frame .vpane.lower.commarea.buttons
2235 label .vpane.lower.commarea.buttons.l -text {} \
2236 -anchor w \
2237 -justify left
2238 pack .vpane.lower.commarea.buttons.l -side top -fill x
2239 pack .vpane.lower.commarea.buttons -side left -fill y
2241 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2242 -command do_rescan
2243 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2244 lappend disable_on_lock \
2245 {.vpane.lower.commarea.buttons.rescan conf -state}
2247 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2248 -command do_add_all
2249 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2250 lappend disable_on_lock \
2251 {.vpane.lower.commarea.buttons.incall conf -state}
2253 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2254 -command do_signoff
2255 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2257 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2258 -command do_commit
2259 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2260 lappend disable_on_lock \
2261 {.vpane.lower.commarea.buttons.commit conf -state}
2263 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2264 -command do_push_anywhere
2265 pack .vpane.lower.commarea.buttons.push -side top -fill x
2267 # -- Commit Message Buffer
2268 #
2269 frame .vpane.lower.commarea.buffer
2270 frame .vpane.lower.commarea.buffer.header
2271 set ui_comm .vpane.lower.commarea.buffer.t
2272 set ui_coml .vpane.lower.commarea.buffer.header.l
2273 radiobutton .vpane.lower.commarea.buffer.header.new \
2274 -text [mc "New Commit"] \
2275 -command do_select_commit_type \
2276 -variable selected_commit_type \
2277 -value new
2278 lappend disable_on_lock \
2279 [list .vpane.lower.commarea.buffer.header.new conf -state]
2280 radiobutton .vpane.lower.commarea.buffer.header.amend \
2281 -text [mc "Amend Last Commit"] \
2282 -command do_select_commit_type \
2283 -variable selected_commit_type \
2284 -value amend
2285 lappend disable_on_lock \
2286 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2287 label $ui_coml \
2288 -anchor w \
2289 -justify left
2290 proc trace_commit_type {varname args} {
2291 global ui_coml commit_type
2292 switch -glob -- $commit_type {
2293 initial {set txt [mc "Initial Commit Message:"]}
2294 amend {set txt [mc "Amended Commit Message:"]}
2295 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2296 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2297 merge {set txt [mc "Merge Commit Message:"]}
2298 * {set txt [mc "Commit Message:"]}
2299 }
2300 $ui_coml conf -text $txt
2301 }
2302 trace add variable commit_type write trace_commit_type
2303 pack $ui_coml -side left -fill x
2304 pack .vpane.lower.commarea.buffer.header.amend -side right
2305 pack .vpane.lower.commarea.buffer.header.new -side right
2307 text $ui_comm -background white -borderwidth 1 \
2308 -undo true \
2309 -maxundo 20 \
2310 -autoseparators true \
2311 -relief sunken \
2312 -width 75 -height 9 -wrap none \
2313 -font font_diff \
2314 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2315 scrollbar .vpane.lower.commarea.buffer.sby \
2316 -command [list $ui_comm yview]
2317 pack .vpane.lower.commarea.buffer.header -side top -fill x
2318 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2319 pack $ui_comm -side left -fill y
2320 pack .vpane.lower.commarea.buffer -side left -fill y
2322 # -- Commit Message Buffer Context Menu
2323 #
2324 set ctxm .vpane.lower.commarea.buffer.ctxm
2325 menu $ctxm -tearoff 0
2326 $ctxm add command \
2327 -label [mc Cut] \
2328 -command {tk_textCut $ui_comm}
2329 $ctxm add command \
2330 -label [mc Copy] \
2331 -command {tk_textCopy $ui_comm}
2332 $ctxm add command \
2333 -label [mc Paste] \
2334 -command {tk_textPaste $ui_comm}
2335 $ctxm add command \
2336 -label [mc Delete] \
2337 -command {$ui_comm delete sel.first sel.last}
2338 $ctxm add separator
2339 $ctxm add command \
2340 -label [mc "Select All"] \
2341 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2342 $ctxm add command \
2343 -label [mc "Copy All"] \
2344 -command {
2345 $ui_comm tag add sel 0.0 end
2346 tk_textCopy $ui_comm
2347 $ui_comm tag remove sel 0.0 end
2348 }
2349 $ctxm add separator
2350 $ctxm add command \
2351 -label [mc "Sign Off"] \
2352 -command do_signoff
2353 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2355 # -- Diff Header
2356 #
2357 proc trace_current_diff_path {varname args} {
2358 global current_diff_path diff_actions file_states
2359 if {$current_diff_path eq {}} {
2360 set s {}
2361 set f {}
2362 set p {}
2363 set o disabled
2364 } else {
2365 set p $current_diff_path
2366 set s [mapdesc [lindex $file_states($p) 0] $p]
2367 set f [mc "File:"]
2368 set p [escape_path $p]
2369 set o normal
2370 }
2372 .vpane.lower.diff.header.status configure -text $s
2373 .vpane.lower.diff.header.file configure -text $f
2374 .vpane.lower.diff.header.path configure -text $p
2375 foreach w $diff_actions {
2376 uplevel #0 $w $o
2377 }
2378 }
2379 trace add variable current_diff_path write trace_current_diff_path
2381 frame .vpane.lower.diff.header -background gold
2382 label .vpane.lower.diff.header.status \
2383 -background gold \
2384 -width $max_status_desc \
2385 -anchor w \
2386 -justify left
2387 label .vpane.lower.diff.header.file \
2388 -background gold \
2389 -anchor w \
2390 -justify left
2391 label .vpane.lower.diff.header.path \
2392 -background gold \
2393 -anchor w \
2394 -justify left
2395 pack .vpane.lower.diff.header.status -side left
2396 pack .vpane.lower.diff.header.file -side left
2397 pack .vpane.lower.diff.header.path -fill x
2398 set ctxm .vpane.lower.diff.header.ctxm
2399 menu $ctxm -tearoff 0
2400 $ctxm add command \
2401 -label [mc Copy] \
2402 -command {
2403 clipboard clear
2404 clipboard append \
2405 -format STRING \
2406 -type STRING \
2407 -- $current_diff_path
2408 }
2409 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2410 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2412 # -- Diff Body
2413 #
2414 frame .vpane.lower.diff.body
2415 set ui_diff .vpane.lower.diff.body.t
2416 text $ui_diff -background white -borderwidth 0 \
2417 -width 80 -height 15 -wrap none \
2418 -font font_diff \
2419 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2420 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2421 -state disabled
2422 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2423 -command [list $ui_diff xview]
2424 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2425 -command [list $ui_diff yview]
2426 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2427 pack .vpane.lower.diff.body.sby -side right -fill y
2428 pack $ui_diff -side left -fill both -expand 1
2429 pack .vpane.lower.diff.header -side top -fill x
2430 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2432 $ui_diff tag conf d_cr -elide true
2433 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2434 $ui_diff tag conf d_+ -foreground {#00a000}
2435 $ui_diff tag conf d_- -foreground red
2437 $ui_diff tag conf d_++ -foreground {#00a000}
2438 $ui_diff tag conf d_-- -foreground red
2439 $ui_diff tag conf d_+s \
2440 -foreground {#00a000} \
2441 -background {#e2effa}
2442 $ui_diff tag conf d_-s \
2443 -foreground red \
2444 -background {#e2effa}
2445 $ui_diff tag conf d_s+ \
2446 -foreground {#00a000} \
2447 -background ivory1
2448 $ui_diff tag conf d_s- \
2449 -foreground red \
2450 -background ivory1
2452 $ui_diff tag conf d<<<<<<< \
2453 -foreground orange \
2454 -font font_diffbold
2455 $ui_diff tag conf d======= \
2456 -foreground orange \
2457 -font font_diffbold
2458 $ui_diff tag conf d>>>>>>> \
2459 -foreground orange \
2460 -font font_diffbold
2462 $ui_diff tag raise sel
2464 # -- Diff Body Context Menu
2465 #
2466 set ctxm .vpane.lower.diff.body.ctxm
2467 menu $ctxm -tearoff 0
2468 $ctxm add command \
2469 -label [mc Refresh] \
2470 -command reshow_diff
2471 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2472 $ctxm add command \
2473 -label [mc Copy] \
2474 -command {tk_textCopy $ui_diff}
2475 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2476 $ctxm add command \
2477 -label [mc "Select All"] \
2478 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2479 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2480 $ctxm add command \
2481 -label [mc "Copy All"] \
2482 -command {
2483 $ui_diff tag add sel 0.0 end
2484 tk_textCopy $ui_diff
2485 $ui_diff tag remove sel 0.0 end
2486 }
2487 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2488 $ctxm add separator
2489 $ctxm add command \
2490 -label [mc "Apply/Reverse Hunk"] \
2491 -command {apply_hunk $cursorX $cursorY}
2492 set ui_diff_applyhunk [$ctxm index last]
2493 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2494 $ctxm add separator
2495 $ctxm add command \
2496 -label [mc "Decrease Font Size"] \
2497 -command {incr_font_size font_diff -1}
2498 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2499 $ctxm add command \
2500 -label [mc "Increase Font Size"] \
2501 -command {incr_font_size font_diff 1}
2502 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2503 $ctxm add separator
2504 $ctxm add command \
2505 -label [mc "Show Less Context"] \
2506 -command {if {$repo_config(gui.diffcontext) >= 1} {
2507 incr repo_config(gui.diffcontext) -1
2508 reshow_diff
2509 }}
2510 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2511 $ctxm add command \
2512 -label [mc "Show More Context"] \
2513 -command {if {$repo_config(gui.diffcontext) < 99} {
2514 incr repo_config(gui.diffcontext)
2515 reshow_diff
2516 }}
2517 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2518 $ctxm add separator
2519 $ctxm add command -label [mc "Options..."] \
2520 -command do_options
2521 proc popup_diff_menu {ctxm x y X Y} {
2522 global current_diff_path file_states
2523 set ::cursorX $x
2524 set ::cursorY $y
2525 if {$::ui_index eq $::current_diff_side} {
2526 set l [mc "Unstage Hunk From Commit"]
2527 } else {
2528 set l [mc "Stage Hunk For Commit"]
2529 }
2530 if {$::is_3way_diff
2531 || $current_diff_path eq {}
2532 || ![info exists file_states($current_diff_path)]
2533 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2534 set s disabled
2535 } else {
2536 set s normal
2537 }
2538 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2539 tk_popup $ctxm $X $Y
2540 }
2541 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2543 # -- Status Bar
2544 #
2545 set main_status [::status_bar::new .status]
2546 pack .status -anchor w -side bottom -fill x
2547 $main_status show [mc "Initializing..."]
2549 # -- Load geometry
2550 #
2551 catch {
2552 set gm $repo_config(gui.geometry)
2553 wm geometry . [lindex $gm 0]
2554 .vpane sash place 0 \
2555 [lindex [.vpane sash coord 0] 0] \
2556 [lindex $gm 1]
2557 .vpane.files sash place 0 \
2558 [lindex $gm 2] \
2559 [lindex [.vpane.files sash coord 0] 1]
2560 unset gm
2561 }
2563 # -- Key Bindings
2564 #
2565 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2566 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2567 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2568 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2569 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2570 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2571 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2572 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2573 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2574 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2575 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2577 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2578 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2579 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2580 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2581 bind $ui_diff <$M1B-Key-v> {break}
2582 bind $ui_diff <$M1B-Key-V> {break}
2583 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2584 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2585 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2586 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2587 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2588 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2589 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2590 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2591 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2592 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2593 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2594 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2595 bind $ui_diff <Button-1> {focus %W}
2597 if {[is_enabled branch]} {
2598 bind . <$M1B-Key-n> branch_create::dialog
2599 bind . <$M1B-Key-N> branch_create::dialog
2600 bind . <$M1B-Key-o> branch_checkout::dialog
2601 bind . <$M1B-Key-O> branch_checkout::dialog
2602 bind . <$M1B-Key-m> merge::dialog
2603 bind . <$M1B-Key-M> merge::dialog
2604 }
2605 if {[is_enabled transport]} {
2606 bind . <$M1B-Key-p> do_push_anywhere
2607 bind . <$M1B-Key-P> do_push_anywhere
2608 }
2610 bind . <Key-F5> do_rescan
2611 bind . <$M1B-Key-r> do_rescan
2612 bind . <$M1B-Key-R> do_rescan
2613 bind . <$M1B-Key-s> do_signoff
2614 bind . <$M1B-Key-S> do_signoff
2615 bind . <$M1B-Key-i> do_add_all
2616 bind . <$M1B-Key-I> do_add_all
2617 bind . <$M1B-Key-Return> do_commit
2618 foreach i [list $ui_index $ui_workdir] {
2619 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2620 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2621 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2622 }
2623 unset i
2625 set file_lists($ui_index) [list]
2626 set file_lists($ui_workdir) [list]
2628 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2629 focus -force $ui_comm
2631 # -- Warn the user about environmental problems. Cygwin's Tcl
2632 # does *not* pass its env array onto any processes it spawns.
2633 # This means that git processes get none of our environment.
2634 #
2635 if {[is_Cygwin]} {
2636 set ignored_env 0
2637 set suggest_user {}
2638 set msg [mc "Possible environment issues exist.
2640 The following environment variables are probably
2641 going to be ignored by any Git subprocess run
2642 by %s:
2644 " [appname]]
2645 foreach name [array names env] {
2646 switch -regexp -- $name {
2647 {^GIT_INDEX_FILE$} -
2648 {^GIT_OBJECT_DIRECTORY$} -
2649 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2650 {^GIT_DIFF_OPTS$} -
2651 {^GIT_EXTERNAL_DIFF$} -
2652 {^GIT_PAGER$} -
2653 {^GIT_TRACE$} -
2654 {^GIT_CONFIG$} -
2655 {^GIT_CONFIG_LOCAL$} -
2656 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2657 append msg " - $name\n"
2658 incr ignored_env
2659 }
2660 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2661 append msg " - $name\n"
2662 incr ignored_env
2663 set suggest_user $name
2664 }
2665 }
2666 }
2667 if {$ignored_env > 0} {
2668 append msg [mc "
2669 This is due to a known issue with the
2670 Tcl binary distributed by Cygwin."]
2672 if {$suggest_user ne {}} {
2673 append msg [mc "
2675 A good replacement for %s
2676 is placing values for the user.name and
2677 user.email settings into your personal
2678 ~/.gitconfig file.
2679 " $suggest_user]
2680 }
2681 warn_popup $msg
2682 }
2683 unset ignored_env msg suggest_user name
2684 }
2686 # -- Only initialize complex UI if we are going to stay running.
2687 #
2688 if {[is_enabled transport]} {
2689 load_all_remotes
2691 populate_fetch_menu
2692 populate_push_menu
2693 }
2695 if {[winfo exists $ui_comm]} {
2696 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2698 # -- If both our backup and message files exist use the
2699 # newer of the two files to initialize the buffer.
2700 #
2701 if {$GITGUI_BCK_exists} {
2702 set m [gitdir GITGUI_MSG]
2703 if {[file isfile $m]} {
2704 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2705 catch {file delete [gitdir GITGUI_MSG]}
2706 } else {
2707 $ui_comm delete 0.0 end
2708 $ui_comm edit reset
2709 $ui_comm edit modified false
2710 catch {file delete [gitdir GITGUI_BCK]}
2711 set GITGUI_BCK_exists 0
2712 }
2713 }
2714 unset m
2715 }
2717 proc backup_commit_buffer {} {
2718 global ui_comm GITGUI_BCK_exists
2720 set m [$ui_comm edit modified]
2721 if {$m || $GITGUI_BCK_exists} {
2722 set msg [string trim [$ui_comm get 0.0 end]]
2723 regsub -all -line {[ \r\t]+$} $msg {} msg
2725 if {$msg eq {}} {
2726 if {$GITGUI_BCK_exists} {
2727 catch {file delete [gitdir GITGUI_BCK]}
2728 set GITGUI_BCK_exists 0
2729 }
2730 } elseif {$m} {
2731 catch {
2732 set fd [open [gitdir GITGUI_BCK] w]
2733 puts -nonewline $fd $msg
2734 close $fd
2735 set GITGUI_BCK_exists 1
2736 }
2737 }
2739 $ui_comm edit modified false
2740 }
2742 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2743 }
2745 backup_commit_buffer
2746 }
2748 lock_index begin-read
2749 if {![winfo ismapped .]} {
2750 wm deiconify .
2751 }
2752 after 1 do_rescan
2753 if {[is_enabled multicommit]} {
2754 after 1000 hint_gc
2755 }