Raw
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" -- "$@"
11
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [string map [list (c) \u00a9] {
14 Copyright (c) 2006-2010 Shawn Pearce, et. al.
15
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.
20
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.
25
26 You should have received a copy of the GNU General Public License
27 along with this program; if not, see <https://www.gnu.org/licenses/>.}]
28
29 ######################################################################
30 ##
31 ## Tcl/Tk sanity check
32
33 if {[catch {package require Tcl 8.6-} err]} {
34 catch {wm withdraw .}
35 tk_messageBox \
36 -icon error \
37 -type ok \
38 -title "git-gui: fatal error" \
39 -message $err
40 exit 1
41 }
42
43 catch {rename send {}} ; # What an evil concept...
44
45 ######################################################################
46 ##
47 ## Enabling platform-specific code paths
48
49 proc is_MacOSX {} {
50 if {[tk windowingsystem] eq {aqua}} {
51 return 1
52 }
53 return 0
54 }
55
56 proc is_Windows {} {
57 if {$::tcl_platform(platform) eq {windows}} {
58 return 1
59 }
60 return 0
61 }
62
63 set _iscygwin {}
64 proc is_Cygwin {} {
65 global _iscygwin
66 if {$_iscygwin eq {}} {
67 if {[string match "CYGWIN_*" $::tcl_platform(os)]} {
68 set _iscygwin 1
69 } else {
70 set _iscygwin 0
71 }
72 }
73 return $_iscygwin
74 }
75
76 ######################################################################
77 ## Enable Tcl8 profile in Tcl9, allowing consumption of data that has
78 ## bytes not conforming to the assumed encoding profile.
79
80 if {[package vcompare $::tcl_version 9.0] >= 0} {
81 rename open _strict_open
82 proc open args {
83 set f [_strict_open {*}$args]
84 chan configure $f -profile tcl8
85 return $f
86 }
87 proc convertfrom args {
88 return [encoding convertfrom -profile tcl8 {*}$args]
89 }
90 } else {
91 proc convertfrom args {
92 return [encoding convertfrom {*}$args]
93 }
94 }
95
96 ######################################################################
97 ##
98 ## PATH lookup. Sanitize $PATH, assure exec/open use only that
99
100 if {[is_Windows]} {
101 set _path_sep {;}
102 } else {
103 set _path_sep {:}
104 }
105
106 set _path_seen [dict create]
107 foreach p [split $env(PATH) $_path_sep] {
108 # Keep only absolute paths, getting rid of ., empty, etc.
109 if {[file pathtype $p] ne {absolute}} {
110 continue
111 }
112 # Keep only the first occurence of any duplicates.
113 set norm_p [file normalize $p]
114 dict set _path_seen $norm_p 1
115 }
116 set _search_path [dict keys $_path_seen]
117 unset _path_seen
118
119 set env(PATH) [join $_search_path $_path_sep]
120
121 if {[is_Windows]} {
122 proc _which {what args} {
123 global _search_path
124
125 if {[lsearch -exact $args -script] >= 0} {
126 set suffix {}
127 } elseif {[string match *.exe [string tolower $what]]} {
128 # The search string already has the file extension
129 set suffix {}
130 } else {
131 set suffix .exe
132 }
133
134 foreach p $_search_path {
135 set p [file join $p $what$suffix]
136 if {[file exists $p]} {
137 return [file normalize $p]
138 }
139 }
140 return {}
141 }
142
143 proc sanitize_command_line {command_line from_index} {
144 set i $from_index
145 while {$i < [llength $command_line]} {
146 set cmd [lindex $command_line $i]
147 if {[llength [file split $cmd]] < 2} {
148 set fullpath [_which $cmd]
149 if {$fullpath eq ""} {
150 throw {NOT-FOUND} "$cmd not found in PATH"
151 }
152 lset command_line $i $fullpath
153 }
154
155 # handle piped commands, e.g. `exec A | B`
156 for {incr i} {$i < [llength $command_line]} {incr i} {
157 if {[lindex $command_line $i] eq "|"} {
158 incr i
159 break
160 }
161 }
162 }
163 return $command_line
164 }
165
166 # Override `exec` to avoid unsafe PATH lookup
167
168 rename exec real_exec
169
170 proc exec {args} {
171 # skip options
172 for {set i 0} {$i < [llength $args]} {incr i} {
173 set arg [lindex $args $i]
174 if {$arg eq "--"} {
175 incr i
176 break
177 }
178 if {[string range $arg 0 0] ne "-"} {
179 break
180 }
181 }
182 set args [sanitize_command_line $args $i]
183 uplevel 1 real_exec $args
184 }
185
186 # Override `open` to avoid unsafe PATH lookup
187
188 rename open real_open
189
190 proc open {args} {
191 set arg0 [lindex $args 0]
192 if {[string range $arg0 0 0] eq "|"} {
193 set command_line [string trim [string range $arg0 1 end]]
194 lset args 0 "| [sanitize_command_line $command_line 0]"
195 }
196 set fd [real_open {*}$args]
197 fconfigure $fd -eofchar {}
198 return $fd
199 }
200
201 } else {
202 # On non-Windows platforms, auto_execok, exec, and open are safe, and will
203 # use the sanitized search path. But, we need _which for these.
204
205 proc _which {what args} {
206 return [lindex [auto_execok $what] 0]
207 }
208 }
209
210 # Wrap exec/open to sanitize arguments
211
212 # unsafe arguments begin with redirections or the pipe or background operators
213 proc is_arg_unsafe {arg} {
214 regexp {^([<|>&]|2>)} $arg
215 }
216
217 proc make_arg_safe {arg} {
218 if {[is_arg_unsafe $arg]} {
219 set arg [file join . $arg]
220 }
221 return $arg
222 }
223
224 proc make_arglist_safe {arglist} {
225 set res {}
226 foreach arg $arglist {
227 lappend res [make_arg_safe $arg]
228 }
229 return $res
230 }
231
232 # executes one command
233 # no redirections or pipelines are possible
234 # cmd is a list that specifies the command and its arguments
235 # calls `exec` and returns its value
236 proc safe_exec {cmd} {
237 eval exec [make_arglist_safe $cmd]
238 }
239
240 # executes one command in the background
241 # no redirections or pipelines are possible
242 # cmd is a list that specifies the command and its arguments
243 # calls `exec` and returns its value
244 proc safe_exec_bg {cmd} {
245 eval exec [make_arglist_safe $cmd] &
246 }
247
248 proc safe_open_file {filename flags} {
249 # a file name starting with "|" would attempt to run a process
250 # but such a file name must be treated as a relative path
251 # hide the "|" behind "./"
252 if {[string index $filename 0] eq "|"} {
253 set filename [file join . $filename]
254 }
255 open $filename $flags
256 }
257
258 # End exec/open wrappers
259
260 ######################################################################
261 ##
262 ## locate our library
263
264 if { [info exists ::env(GIT_GUI_LIB_DIR) ] } {
265 set oguilib $::env(GIT_GUI_LIB_DIR)
266 } else {
267 set oguilib {@@GITGUI_LIBDIR@@}
268 }
269 set oguirel {@@GITGUI_RELATIVE@@}
270 if {$oguirel eq {1}} {
271 set oguilib [file dirname [file normalize $argv0]]
272 if {[file tail $oguilib] eq {git-core}} {
273 set oguilib [file dirname $oguilib]
274 }
275 set oguilib [file dirname $oguilib]
276 set oguilib [file join $oguilib share git-gui lib]
277 set oguimsg [file join $oguilib msgs]
278 } elseif {[string match @@* $oguirel]} {
279 set oguilib [file join [file dirname [file normalize $argv0]] lib]
280 set oguimsg [file join [file dirname [file normalize $argv0]] po]
281 } else {
282 set oguimsg [file join $oguilib msgs]
283 }
284 unset oguirel
285
286 ######################################################################
287 ##
288 ## enable verbose loading?
289
290 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
291 unset _verbose
292 rename auto_load real__auto_load
293 proc auto_load {name args} {
294 puts stderr "auto_load $name"
295 return [uplevel 1 real__auto_load $name $args]
296 }
297 rename source real__source
298 proc source {args} {
299 puts stderr "source $args"
300 uplevel 1 [linsert $args 0 real__source]
301 }
302 if {[tk windowingsystem] eq "win32"} { console show }
303 }
304
305 ######################################################################
306 ##
307 ## Internationalization (i18n) through msgcat and gettext. See
308 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
309
310 package require msgcat
311
312 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
313 if {[tk windowingsystem] eq "win32"
314 && [package vcompare [package provide msgcat] 1.4.4] < 0
315 } then {
316 proc _mc_update_locale {} {
317 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
318 if {![catch {
319 package require registry
320 set uilocale [registry get $key "PreferredUILanguages"]
321 msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
322 } uilocale]} {
323 if {[string length $uilocale] > 0} {
324 msgcat::mclocale $uilocale
325 }
326 }
327 }
328 _mc_update_locale
329 }
330
331 proc _mc_trim {fmt} {
332 set cmk [string first @@ $fmt]
333 if {$cmk > 0} {
334 return [string range $fmt 0 [expr {$cmk - 1}]]
335 }
336 return $fmt
337 }
338
339 proc mc {en_fmt args} {
340 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
341 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
342 set msg [eval [list format [_mc_trim $en_fmt]] $args]
343 }
344 return $msg
345 }
346
347 proc strcat {args} {
348 return [join $args {}]
349 }
350
351 ::msgcat::mcload $oguimsg
352 unset oguimsg
353
354 ######################################################################
355 ##
356 ## On Mac, bring the current Wish process window to front
357
358 if {[tk windowingsystem] eq "aqua"} {
359 catch {
360 safe_exec [list osascript -e [format {
361 tell application "System Events"
362 set frontmost of processes whose unix id is %d to true
363 end tell
364 } [pid]]]
365 }
366 }
367
368 ######################################################################
369 ##
370 ## read only globals
371
372 set _appname {Git Gui}
373 set _gitdir {}
374 set _gitworktree {}
375 set _githtmldir {}
376 set _prefix {}
377 set _reponame {}
378 set _shellpath {@@SHELL_PATH@@}
379
380 set _trace [lsearch -exact $argv --trace]
381 if {$_trace >= 0} {
382 set argv [lreplace $argv $_trace $_trace]
383 set _trace 1
384 if {[tk windowingsystem] eq "win32"} { console show }
385 } else {
386 set _trace 0
387 }
388
389 # variable for the last merged branch (useful for a default when deleting
390 # branches).
391 set _last_merged_branch {}
392
393 # for testing, allow unconfigured _shellpath
394 if {[string match @@* $_shellpath]} {
395 if {[info exists env(SHELL)]} {
396 set _shellpath $env(SHELL)
397 } else {
398 set _shellpath /bin/sh
399 }
400 }
401
402 if {[is_Windows]} {
403 set _shellpath [safe_exec [list cygpath -m $_shellpath]]
404 }
405
406 if {![file executable $_shellpath] || \
407 !([file pathtype $_shellpath] eq {absolute})} {
408 set errmsg "The defined shell ('$_shellpath') is not usable, \
409 it must be an absolute path to an executable."
410 puts stderr $errmsg
411
412 catch {wm withdraw .}
413 tk_messageBox \
414 -icon error \
415 -type ok \
416 -title "git-gui: configuration error" \
417 -message $errmsg
418 exit 1
419 }
420
421
422 proc shellpath {} {
423 global _shellpath
424 return $_shellpath
425 }
426
427 proc appname {} {
428 global _appname
429 return $_appname
430 }
431
432 proc gitdir {args} {
433 global _gitdir
434 if {$args eq {}} {
435 return $_gitdir
436 }
437 return [eval [list file join $_gitdir] $args]
438 }
439
440 proc githtmldir {args} {
441 global _githtmldir
442 if {$_githtmldir eq {}} {
443 if {[catch {set _githtmldir [git --html-path]}]} {
444 # Git not installed or option not yet supported
445 return {}
446 }
447 set _githtmldir [file normalize $_githtmldir]
448 }
449 if {$args eq {}} {
450 return $_githtmldir
451 }
452 return [eval [list file join $_githtmldir] $args]
453 }
454
455 proc reponame {} {
456 return $::_reponame
457 }
458
459 proc is_enabled {option} {
460 global enabled_options
461 if {[catch {set on $enabled_options($option)}]} {return 0}
462 return $on
463 }
464
465 proc enable_option {option} {
466 global enabled_options
467 set enabled_options($option) 1
468 }
469
470 proc disable_option {option} {
471 global enabled_options
472 set enabled_options($option) 0
473 }
474
475 ######################################################################
476 ##
477 ## config
478
479 proc is_many_config {name} {
480 switch -glob -- $name {
481 gui.recentrepo -
482 remote.*.fetch -
483 remote.*.push
484 {return 1}
485 *
486 {return 0}
487 }
488 }
489
490 proc is_config_true {name} {
491 global repo_config
492 if {[catch {set v $repo_config($name)}]} {
493 return 0
494 }
495 set v [string tolower $v]
496 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
497 return 1
498 } else {
499 return 0
500 }
501 }
502
503 proc is_config_false {name} {
504 global repo_config
505 if {[catch {set v $repo_config($name)}]} {
506 return 0
507 }
508 set v [string tolower $v]
509 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
510 return 1
511 } else {
512 return 0
513 }
514 }
515
516 proc get_config {name} {
517 global repo_config
518 if {[catch {set v $repo_config($name)}]} {
519 return {}
520 } else {
521 return $v
522 }
523 }
524
525 proc is_bare {} {
526 return [expr {$::_gitworktree eq {}}]
527 }
528
529 ######################################################################
530 ##
531 ## handy utils
532
533 proc _trace_exec {cmd} {
534 if {!$::_trace} return
535 set d {}
536 foreach v $cmd {
537 if {$d ne {}} {
538 append d { }
539 }
540 if {[regexp {[ \t\r\n'"$?*]} $v]} {
541 set v [sq $v]
542 }
543 append d $v
544 }
545 puts stderr $d
546 }
547
548 #'" fix poor old emacs font-lock mode
549
550 # This is for use with textconv filters and uses sh -c "..." to allow it to
551 # contain a command with arguments. We presume this
552 # to be a shellscript that the configured shell (/bin/sh by default) knows
553 # how to run.
554 proc open_cmd_pipe {cmd path} {
555 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
556 set run [make_arglist_safe $run]
557 return [open |$run r]
558 }
559
560 proc git {args} {
561 git_redir $args {}
562 }
563
564 proc git_redir {cmd redir} {
565 set fd [git_read $cmd $redir]
566 fconfigure $fd -encoding utf-8
567 set result [string trimright [read $fd] "\n"]
568 close $fd
569 if {$::_trace} {
570 puts stderr "< $result"
571 }
572 return $result
573 }
574
575 proc safe_open_command {cmd {redir {}}} {
576 set cmd [make_arglist_safe $cmd]
577 _trace_exec [concat $cmd $redir]
578 if {[catch {
579 set fd [open [concat [list | ] $cmd $redir] r]
580 } err]} {
581 error $err
582 }
583 return $fd
584 }
585
586 proc git_read {cmd {redir {}}} {
587 global _git
588 set cmdp [concat [list $_git] $cmd]
589
590 return [safe_open_command $cmdp $redir]
591 }
592
593 set _nice [list [_which nice]]
594 if {[catch {safe_exec [list {*}$_nice git version]}]} {
595 set _nice {}
596 }
597
598 proc git_read_nice {cmd} {
599 set cmdp [list {*}$::_nice $::_git {*}$cmd]
600 return [safe_open_command $cmdp]
601 }
602
603 proc git_write {cmd} {
604 global _git
605 set cmd [make_arglist_safe $cmd]
606 set cmdp [concat [list $_git] $cmd]
607
608 _trace_exec $cmdp
609 return [open [concat [list | ] $cmdp] w]
610 }
611
612 proc githook_read {hook_name args} {
613 git_read [concat [list hook run --ignore-missing $hook_name --] $args] [list 2>@1]
614 }
615
616 proc kill_file_process {fd} {
617 set process [pid $fd]
618
619 catch {
620 if {[is_Windows]} {
621 safe_exec [list taskkill /pid $process]
622 } else {
623 safe_exec [list kill $process]
624 }
625 }
626 }
627
628 proc gitattr {path attr default} {
629 if {[catch {set r [git check-attr $attr -- $path]}]} {
630 set r unspecified
631 } else {
632 set r [join [lrange [split $r :] 2 end] :]
633 regsub {^ } $r {} r
634 }
635 if {$r eq {unspecified}} {
636 return $default
637 }
638 return $r
639 }
640
641 proc sq {value} {
642 regsub -all ' $value "'\\''" value
643 return "'$value'"
644 }
645
646 proc load_current_branch {} {
647 global current_branch is_detached
648
649 set current_branch [git branch --show-current]
650 set is_detached [expr [string length $current_branch] == 0]
651 if {$is_detached} {
652 set current_branch {HEAD}
653 }
654 }
655
656 auto_load tk_optionMenu
657 rename tk_optionMenu real__tkOptionMenu
658 proc tk_optionMenu {w varName args} {
659 set m [eval real__tkOptionMenu $w $varName $args]
660 $m configure -font font_ui
661 $w configure -font font_ui
662 return $m
663 }
664
665 proc rmsel_tag {text} {
666 $text tag conf sel \
667 -background [$text cget -background] \
668 -foreground [$text cget -foreground] \
669 -borderwidth 0
670 bind $text <Motion> break
671 return $text
672 }
673
674 wm withdraw .
675 set root_exists 0
676 bind . <Visibility> {
677 bind . <Visibility> {}
678 set root_exists 1
679 }
680
681 if {[is_Windows]} {
682 wm iconbitmap . -default $oguilib/git-gui.ico
683 set ::tk::AlwaysShowSelection 1
684 bind . <Control-F2> {console show}
685
686 # Spoof an X11 display for SSH
687 if {![info exists env(DISPLAY)]} {
688 set env(DISPLAY) :9999
689 }
690 } else {
691 catch {
692 image create photo gitlogo -width 16 -height 16
693
694 gitlogo put #33CC33 -to 7 0 9 2
695 gitlogo put #33CC33 -to 4 2 12 4
696 gitlogo put #33CC33 -to 7 4 9 6
697 gitlogo put #CC3333 -to 4 6 12 8
698 gitlogo put gray26 -to 4 9 6 10
699 gitlogo put gray26 -to 3 10 6 12
700 gitlogo put gray26 -to 8 9 13 11
701 gitlogo put gray26 -to 8 11 10 12
702 gitlogo put gray26 -to 11 11 13 14
703 gitlogo put gray26 -to 3 12 5 14
704 gitlogo put gray26 -to 5 13
705 gitlogo put gray26 -to 10 13
706 gitlogo put gray26 -to 4 14 12 15
707 gitlogo put gray26 -to 5 15 11 16
708 gitlogo redither
709
710 image create photo gitlogo32 -width 32 -height 32
711 gitlogo32 copy gitlogo -zoom 2 2
712
713 wm iconphoto . -default gitlogo gitlogo32
714 }
715 }
716
717 ######################################################################
718 ##
719 ## config defaults
720
721 set cursor_ptr arrow
722 font create font_ui
723 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
724 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
725 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
726 } else {
727 font create font_diff -family Courier -size 10
728 catch {
729 label .dummy
730 eval font configure font_ui [font actual [.dummy cget -font]]
731 destroy .dummy
732 }
733 }
734
735 font create font_uiitalic
736 font create font_uibold
737 font create font_diffbold
738 font create font_diffitalic
739
740 foreach class {Button Checkbutton Entry Label
741 Labelframe Listbox Message
742 Radiobutton Spinbox Text} {
743 option add *$class.font font_ui
744 }
745 if {![is_MacOSX]} {
746 option add *Menu.font font_ui
747 option add *Entry.borderWidth 1 startupFile
748 option add *Entry.relief sunken startupFile
749 option add *RadioButton.anchor w startupFile
750 }
751 unset class
752
753 if {[is_Windows] || [is_MacOSX]} {
754 option add *Menu.tearOff 0
755 }
756
757 if {[is_MacOSX]} {
758 set M1B M1
759 set M1T Cmd
760 } else {
761 set M1B Control
762 set M1T Ctrl
763 }
764
765 proc bind_button3 {w cmd} {
766 bind $w <Any-Button-3> $cmd
767 if {[is_MacOSX]} {
768 # Mac OS X sends Button-2 on right click through three-button mouse,
769 # or through trackpad right-clicking (two-finger touch + click).
770 bind $w <Any-Button-2> $cmd
771 bind $w <Control-Button-1> $cmd
772 }
773 }
774
775 proc apply_config {} {
776 global repo_config font_descs
777
778 foreach option $font_descs {
779 set name [lindex $option 0]
780 set font [lindex $option 1]
781 if {[catch {
782 set need_weight 1
783 foreach {cn cv} $repo_config(gui.$name) {
784 if {$cn eq {-weight}} {
785 set need_weight 0
786 }
787 font configure $font $cn $cv
788 }
789 if {$need_weight} {
790 font configure $font -weight normal
791 }
792 } err]} {
793 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
794 }
795 foreach {cn cv} [font configure $font] {
796 font configure ${font}bold $cn $cv
797 font configure ${font}italic $cn $cv
798 }
799 font configure ${font}bold -weight bold
800 font configure ${font}italic -slant italic
801 }
802
803 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
804 pave_toplevel .
805 color::sync_with_theme
806
807 global comment_string
808 set comment_string [get_config core.commentstring]
809 if {$comment_string eq {}} {
810 set comment_string [get_config core.commentchar]
811 }
812 }
813
814 set default_config(branch.autosetupmerge) true
815 set default_config(merge.tool) {}
816 set default_config(mergetool.keepbackup) true
817 set default_config(merge.diffstat) true
818 set default_config(merge.summary) false
819 set default_config(merge.verbosity) 2
820 set default_config(user.name) {}
821 set default_config(user.email) {}
822 set default_config(core.commentchar) "#"
823 set default_config(core.commentstring) {}
824
825 set default_config(gui.encoding) [encoding system]
826 set default_config(gui.matchtrackingbranch) false
827 set default_config(gui.textconv) true
828 set default_config(gui.pruneduringfetch) false
829 set default_config(gui.trustmtime) false
830 set default_config(gui.fastcopyblame) false
831 set default_config(gui.maxrecentrepo) 10
832 set default_config(gui.copyblamethreshold) 40
833 set default_config(gui.blamehistoryctx) 7
834 set default_config(gui.diffcontext) 5
835 set default_config(gui.diffopts) {}
836 set default_config(gui.commitmsgwidth) 75
837 set default_config(gui.newbranchtemplate) {}
838 set default_config(gui.spellingdictionary) {}
839 set default_config(gui.fontui) [font configure font_ui]
840 set default_config(gui.fontdiff) [font configure font_diff]
841 # TODO: this option should be added to the git-config documentation
842 set default_config(gui.maxfilesdisplayed) 5000
843 set default_config(gui.usettk) 1
844 set default_config(gui.warndetachedcommit) 1
845 set default_config(gui.tabsize) 8
846 set font_descs {
847 {fontui font_ui {mc "Main Font"}}
848 {fontdiff font_diff {mc "Diff/Console Font"}}
849 }
850 set default_config(gui.stageuntracked) ask
851 set default_config(gui.displayuntracked) true
852
853 ######################################################################
854 ##
855 ## find git
856
857 set _git [_which git]
858 if {$_git eq {}} {
859 catch {wm withdraw .}
860 tk_messageBox \
861 -icon error \
862 -type ok \
863 -title [mc "git-gui: fatal error"] \
864 -message [mc "Cannot find git in PATH."]
865 exit 1
866 }
867
868 ######################################################################
869 ##
870 ## version check
871
872 set MIN_GIT_VERSION 2.36
873
874 if {[catch {set _git_version [git --version]} err]} {
875 catch {wm withdraw .}
876 tk_messageBox \
877 -icon error \
878 -type ok \
879 -title [mc "git-gui: fatal error"] \
880 -message "Cannot determine Git version:
881
882 $err
883
884 [appname] requires Git $MIN_GIT_VERSION or later."
885 exit 1
886 }
887
888 if {![regsub {^git version } $_git_version {} _git_version]} {
889 catch {wm withdraw .}
890 tk_messageBox \
891 -icon error \
892 -type ok \
893 -title [mc "git-gui: fatal error"] \
894 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
895 exit 1
896 }
897
898 proc get_trimmed_version {s} {
899 set r {}
900 foreach x [split $s -._] {
901 if {[string is integer -strict $x]} {
902 lappend r $x
903 } else {
904 break
905 }
906 }
907 return [join $r .]
908 }
909 set _real_git_version $_git_version
910 set _git_version [get_trimmed_version $_git_version]
911
912 if {[catch {set vcheck [package vcompare $_git_version $MIN_GIT_VERSION]}] ||
913 [expr $vcheck < 0] } {
914
915 set msg1 [mc "Insufficient git version, require: "]
916 set msg2 [mc "git returned:"]
917 set message "$msg1 $MIN_GIT_VERSION\n$msg2 $_real_git_version"
918 catch {wm withdraw .}
919 tk_messageBox \
920 -icon error \
921 -type ok \
922 -title [mc "git-gui: fatal error"] \
923 -message $message
924 exit 1
925 }
926 unset _real_git_version
927
928 ######################################################################
929 ##
930 ## configure our library
931
932 set idx [file join $oguilib tclIndex]
933 if {[catch {set fd [safe_open_file $idx r]} err]} {
934 catch {wm withdraw .}
935 tk_messageBox \
936 -icon error \
937 -type ok \
938 -title [mc "git-gui: fatal error"] \
939 -message $err
940 exit 1
941 }
942 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
943 set idx [list]
944 while {[gets $fd n] >= 0} {
945 if {$n ne {} && ![string match #* $n]} {
946 lappend idx $n
947 }
948 }
949 } else {
950 set idx {}
951 }
952 close $fd
953
954 if {$idx ne {}} {
955 set loaded [list]
956 foreach p $idx {
957 if {[lsearch -exact $loaded $p] >= 0} continue
958 source [file join $oguilib $p]
959 lappend loaded $p
960 }
961 unset loaded p
962 } else {
963 set auto_path [concat [list $oguilib] $auto_path]
964 }
965 unset -nocomplain idx fd
966
967 ######################################################################
968 ##
969 ## config file parsing
970
971 proc _parse_config {arr_name args} {
972 upvar $arr_name arr
973 array unset arr
974 set buf {}
975 catch {
976 set fd_rc [git_read \
977 [concat config \
978 $args \
979 --null --list]]
980 fconfigure $fd_rc -encoding utf-8
981 set buf [read $fd_rc]
982 close $fd_rc
983 }
984 foreach line [split $buf "\0"] {
985 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
986 if {[is_many_config $name]} {
987 lappend arr($name) $value
988 } else {
989 set arr($name) $value
990 }
991 } elseif {[regexp {^([^\n]+)$} $line line name]} {
992 # no value given, but interpreting them as
993 # boolean will be handled as true
994 set arr($name) {}
995 }
996 }
997 }
998
999 proc load_config {include_global} {
1000 global repo_config global_config system_config default_config
1001
1002 if {$include_global} {
1003 _parse_config system_config --system
1004 _parse_config global_config --global
1005 }
1006 _parse_config repo_config
1007
1008 foreach name [array names default_config] {
1009 if {[catch {set v $system_config($name)}]} {
1010 set system_config($name) $default_config($name)
1011 }
1012 }
1013 foreach name [array names system_config] {
1014 if {[catch {set v $global_config($name)}]} {
1015 set global_config($name) $system_config($name)
1016 }
1017 if {[catch {set v $repo_config($name)}]} {
1018 set repo_config($name) $system_config($name)
1019 }
1020 }
1021 }
1022
1023 ######################################################################
1024 ##
1025 ## feature option selection
1026
1027 enable_option picker
1028 enable_option gitdir_discovery
1029 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1030 unset _junk
1031 } else {
1032 set subcommand gui
1033 }
1034 if {$subcommand eq {gui.sh}} {
1035 set subcommand gui
1036 }
1037 if {$subcommand eq {gui} && [llength $argv] > 0} {
1038 set subcommand [lindex $argv 0]
1039 set argv [lrange $argv 1 end]
1040 if {$subcommand eq {gui}} {
1041 disable_option picker
1042 }
1043 }
1044
1045 enable_option multicommit
1046 enable_option branch
1047 enable_option transport
1048 disable_option bare
1049
1050 switch -- $subcommand {
1051 browser -
1052 blame {
1053 enable_option bare
1054
1055 disable_option multicommit
1056 disable_option branch
1057 disable_option transport
1058 disable_option picker
1059 }
1060 citool {
1061 enable_option singlecommit
1062 enable_option retcode
1063
1064 disable_option multicommit
1065 disable_option branch
1066 disable_option transport
1067 disable_option picker
1068
1069 while {[llength $argv] > 0} {
1070 set a [lindex $argv 0]
1071 switch -- $a {
1072 --amend {
1073 enable_option initialamend
1074 }
1075 --nocommit {
1076 enable_option nocommit
1077 enable_option nocommitmsg
1078 }
1079 --commitmsg {
1080 disable_option nocommitmsg
1081 }
1082 default {
1083 break
1084 }
1085 }
1086
1087 set argv [lrange $argv 1 end]
1088 }
1089 }
1090 pick {
1091 disable_option gitdir_discovery
1092 }
1093 }
1094
1095 ######################################################################
1096 ##
1097 ## execution environment
1098
1099 # Suggest our implementation of askpass, if none is set
1100 set argv0dir [file dirname [file normalize $::argv0]]
1101 if {![info exists env(SSH_ASKPASS)]} {
1102 set env(SSH_ASKPASS) [file join $argv0dir git-gui--askpass]
1103 }
1104 if {![info exists env(GIT_ASKPASS)]} {
1105 set env(GIT_ASKPASS) [file join $argv0dir git-gui--askpass]
1106 }
1107 if {![info exists env(GIT_ASK_YESNO)]} {
1108 set env(GIT_ASK_YESNO) [file join $argv0dir git-gui--askyesno]
1109 }
1110 unset argv0dir
1111
1112 ######################################################################
1113 ##
1114 ## repository setup
1115
1116 proc find_worktree_from_gitdir {} {
1117 # this is invoked only if the current directory is inside the repository
1118 set worktree {}
1119 if {[file tail $::_gitdir] eq {.git}} {
1120 # the dir containing .git is a worktree if repo allows it
1121 # Check that git reports parent as a worktree (gitdir might not allow a worktree)
1122 if {[catch {
1123 set parent [file dirname $::_gitdir]
1124 set worktree [git -C $parent rev-parse --show-toplevel]
1125 }]} {
1126 set worktree {}
1127 }
1128 } elseif [file exists {gitdir}] {
1129 # a worktree gitdir has .gitdir naming worktree/.git
1130 # assure git run there reports this dir as the gitdir (links might be broken)
1131 if {[catch {
1132 set fd_gitdir [open {gitdir} {r}]
1133 set worktree [file dirname [read $fd_gitdir]]
1134 catch {close $fd_gitdir}
1135 set worktree_gitdir [git -C $worktree rev-parse --absolute-git-dir]
1136 if {$::_gitdir ne $worktree_gitdir} {
1137 set worktree {}
1138 }
1139 }]} {
1140 catch {close $fd_gitdir}
1141 set worktree {}
1142 }
1143 }
1144 return $worktree
1145 }
1146
1147 proc is_gitvars_error {err} {
1148 set havevars 0
1149 set GIT_DIR {}
1150 set GIT_WORK_TREE {}
1151 catch {set GIT_DIR $::env(GIT_DIR); set havevars 1}
1152 catch {set GIT_WORK_TREE $::env(GIT_WORK_TREE); set havevars 1}
1153
1154 if {$havevars} {
1155 catch {wm withdraw .}
1156 error_popup [strcat [mc "Invalid configuration:"] \
1157 "\n" "GIT_DIR: " $GIT_DIR \
1158 "\n" "GIT_WORK_TREE: " $GIT_WORK_TREE \
1159 "\n\n$err"]
1160 return 1
1161 }
1162 return 0
1163 }
1164
1165 proc set_gitdir_vars {} {
1166 global _gitdir _gitworktree env
1167 set env(GIT_DIR) $_gitdir
1168 if {$_gitworktree ne {}} {
1169 set env(GIT_WORK_TREE) $_gitworktree
1170 }
1171 }
1172
1173 proc unset_gitdir_vars {} {
1174 global env
1175 catch {unset env(GIT_DIR)}
1176 catch {unset env(GIT_WORK_TREE)}
1177 }
1178
1179 # find repository
1180 set _gitdir {}
1181 if {[is_enabled gitdir_discovery]} {
1182 if {[catch {
1183 set _gitdir [git rev-parse --absolute-git-dir]
1184 } err]} {
1185 if {[is_gitvars_error $err]} {
1186 exit 1
1187 }
1188 set _gitdir {}
1189 }
1190 }
1191
1192 set picked 0
1193 if {$_gitdir eq {} && [is_enabled picker]} {
1194 unset_gitdir_vars
1195 load_config 1
1196 apply_config
1197 choose_repository::pick
1198 if {[catch {
1199 set _gitdir [git rev-parse --absolute-git-dir]
1200 } err]} {
1201 catch {wm withdraw .}
1202 error_popup [strcat [mc "Unusable repo/worktree:"] " [pwd] \n\n$err"]
1203 exit 1
1204 }
1205 set picked 1
1206 }
1207
1208 if {$_gitdir eq {}} {
1209 catch {wm withdraw .}
1210 error_popup [strcat [mc "Git directory not found:"] "\n\n$err"]
1211 exit 1
1212 }
1213
1214 # find worktree, continue without if not required
1215 if {[catch {
1216 set _gitworktree [git rev-parse --show-toplevel]
1217 set _prefix [git rev-parse --show-prefix]
1218 } err]} {
1219 if {[is_gitvars_error $err]} {
1220 exit 1
1221 }
1222 set _gitworktree {}
1223 set _prefix {}
1224 }
1225
1226 if {[is_bare]} {
1227 # Maybe we are in an embedded or worktree specific gitdir
1228 if {[set _gitworktree [find_worktree_from_gitdir]] ne {}} {
1229 set _prefix {}
1230 }
1231 }
1232
1233 if {![is_bare]} {
1234 if {[catch {cd $_gitworktree} err]} {
1235 catch {wm withdraw .}
1236 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1237 exit 1
1238 }
1239 } elseif {![is_enabled bare]} {
1240 catch {wm withdraw .}
1241 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1242 exit 1
1243 }
1244
1245 # repository and worktree config are complete, export them
1246 set_gitdir_vars
1247
1248 # Use object format as hash algorithm (either "sha1" or "sha256")
1249 set hashalgorithm [git rev-parse --show-object-format]
1250 if {$hashalgorithm eq "sha1"} {
1251 set hashlength 40
1252 } elseif {$hashalgorithm eq "sha256"} {
1253 set hashlength 64
1254 } else {
1255 puts stderr "Unknown hash algorithm: $hashalgorithm"
1256 exit 1
1257 }
1258
1259 # _gitdir exists, so try loading the config
1260 load_config 0
1261 apply_config
1262
1263 set _reponame [file split [file normalize $_gitdir]]
1264 if {[lindex $_reponame end] eq {.git}} {
1265 set _reponame [lindex $_reponame end-1]
1266 } else {
1267 set _reponame [lindex $_reponame end]
1268 }
1269
1270 ######################################################################
1271 ##
1272 ## global init
1273
1274 set current_diff_path {}
1275 set current_diff_side {}
1276 set diff_actions [list]
1277
1278 set HEAD {}
1279 set PARENT {}
1280 set MERGE_HEAD [list]
1281 set commit_type {}
1282 set commit_type_is_amend 0
1283 set empty_tree {}
1284 set current_branch {}
1285 set is_detached 0
1286 set current_diff_path {}
1287 set is_3way_diff 0
1288 set is_submodule_diff 0
1289 set is_conflict_diff 0
1290 set last_revert {}
1291 set last_revert_enc {}
1292
1293 set nullid [string repeat 0 $hashlength]
1294 set nullid2 "[string repeat 0 [expr $hashlength - 1]]1"
1295
1296 ######################################################################
1297 ##
1298 ## task management
1299
1300 set rescan_active 0
1301 set diff_active 0
1302 set last_clicked {}
1303
1304 set disable_on_lock [list]
1305 set index_lock_type none
1306
1307 proc lock_index {type} {
1308 global index_lock_type disable_on_lock
1309
1310 if {$index_lock_type eq {none}} {
1311 set index_lock_type $type
1312 foreach w $disable_on_lock {
1313 uplevel #0 $w disabled
1314 }
1315 return 1
1316 } elseif {$index_lock_type eq "begin-$type"} {
1317 set index_lock_type $type
1318 return 1
1319 }
1320 return 0
1321 }
1322
1323 proc unlock_index {} {
1324 global index_lock_type disable_on_lock
1325
1326 set index_lock_type none
1327 foreach w $disable_on_lock {
1328 uplevel #0 $w normal
1329 }
1330 }
1331
1332 ######################################################################
1333 ##
1334 ## status
1335
1336 proc repository_state {ctvar hdvar mhvar} {
1337 global current_branch
1338 upvar $ctvar ct $hdvar hd $mhvar mh
1339
1340 set mh [list]
1341
1342 load_current_branch
1343 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1344 set hd {}
1345 set ct initial
1346 return
1347 }
1348
1349 set merge_head [gitdir MERGE_HEAD]
1350 if {[file exists $merge_head]} {
1351 set ct merge
1352 set fd_mh [safe_open_file $merge_head r]
1353 while {[gets $fd_mh line] >= 0} {
1354 lappend mh $line
1355 }
1356 close $fd_mh
1357 return
1358 }
1359
1360 set ct normal
1361 }
1362
1363 proc PARENT {} {
1364 global PARENT empty_tree
1365
1366 set p [lindex $PARENT 0]
1367 if {$p ne {}} {
1368 return $p
1369 }
1370 if {$empty_tree eq {}} {
1371 set empty_tree [git_redir [list mktree] [list << {}]]
1372 }
1373 return $empty_tree
1374 }
1375
1376 proc force_amend {} {
1377 global commit_type_is_amend
1378 global HEAD PARENT MERGE_HEAD commit_type
1379
1380 repository_state newType newHEAD newMERGE_HEAD
1381 set HEAD $newHEAD
1382 set PARENT $newHEAD
1383 set MERGE_HEAD $newMERGE_HEAD
1384 set commit_type $newType
1385
1386 set commit_type_is_amend 1
1387 do_select_commit_type
1388 }
1389
1390 proc rescan {after {honor_trustmtime 1}} {
1391 global HEAD PARENT MERGE_HEAD commit_type
1392 global ui_index ui_workdir ui_comm
1393 global rescan_active file_states
1394 global repo_config
1395
1396 if {$rescan_active > 0 || ![lock_index read]} return
1397
1398 repository_state newType newHEAD newMERGE_HEAD
1399 if {[string match amend* $commit_type]
1400 && $newType eq {normal}
1401 && $newHEAD eq $HEAD} {
1402 } else {
1403 set HEAD $newHEAD
1404 set PARENT $newHEAD
1405 set MERGE_HEAD $newMERGE_HEAD
1406 set commit_type $newType
1407 }
1408
1409 array unset file_states
1410
1411 if {!$::GITGUI_BCK_exists &&
1412 (![$ui_comm edit modified]
1413 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1414 if {[string match amend* $commit_type]} {
1415 } elseif {[load_message GITGUI_MSG utf-8]} {
1416 } elseif {[run_prepare_commit_msg_hook]} {
1417 } elseif {[load_message MERGE_MSG]} {
1418 } elseif {[load_message SQUASH_MSG]} {
1419 } elseif {[load_message [get_config commit.template]]} {
1420 }
1421 $ui_comm edit reset
1422 $ui_comm edit modified false
1423 }
1424
1425 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1426 rescan_stage2 {} $after
1427 } else {
1428 set rescan_active 1
1429 ui_status [mc "Refreshing file status..."]
1430 set fd_rf [git_read [list update-index \
1431 -q \
1432 --unmerged \
1433 --ignore-missing \
1434 --refresh \
1435 ]]
1436 fconfigure $fd_rf -blocking 0 -translation binary
1437 fileevent $fd_rf readable \
1438 [list rescan_stage2 $fd_rf $after]
1439 }
1440 }
1441
1442 proc have_info_exclude {} {
1443 return [file readable [gitdir info exclude]]
1444 }
1445
1446 proc rescan_stage2 {fd after} {
1447 global rescan_active buf_rdi buf_rdf buf_rlo
1448
1449 if {$fd ne {}} {
1450 read $fd
1451 if {![eof $fd]} return
1452 close $fd
1453 }
1454
1455 set ls_others [list --exclude-standard]
1456
1457 set buf_rdi {}
1458 set buf_rdf {}
1459 set buf_rlo {}
1460
1461 set rescan_active 2
1462 ui_status [mc "Scanning for modified files ..."]
1463 set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]]
1464 set fd_df [git_read [list diff-files -z]]
1465
1466 fconfigure $fd_di -blocking 0 -translation binary
1467 fconfigure $fd_df -blocking 0 -translation binary
1468
1469 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1470 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1471
1472 if {[is_config_true gui.displayuntracked]} {
1473 set fd_lo [git_read [concat ls-files --others -z $ls_others]]
1474 fconfigure $fd_lo -blocking 0 -translation binary
1475 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1476 incr rescan_active
1477 }
1478 }
1479
1480 proc load_message {file {encoding {}}} {
1481 global ui_comm
1482
1483 set f [gitdir $file]
1484 if {[file isfile $f]} {
1485 if {[catch {set fd [safe_open_file $f r]}]} {
1486 return 0
1487 }
1488 if {$encoding ne {}} {
1489 fconfigure $fd -encoding $encoding
1490 }
1491 set content [string trim [read $fd]]
1492 close $fd
1493 regsub -all -line {[ \r\t]+$} $content {} content
1494 $ui_comm delete 0.0 end
1495 $ui_comm insert end $content
1496 return 1
1497 }
1498 return 0
1499 }
1500
1501 proc run_prepare_commit_msg_hook {} {
1502 global pch_error
1503
1504 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1505 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1506 # empty file but existent file.
1507
1508 set fd_pcm [safe_open_file [gitdir PREPARE_COMMIT_MSG] a]
1509
1510 if {[file isfile [gitdir MERGE_MSG]]} {
1511 set pcm_source "merge"
1512 set fd_mm [safe_open_file [gitdir MERGE_MSG] r]
1513 fconfigure $fd_mm -encoding utf-8
1514 puts -nonewline $fd_pcm [read $fd_mm]
1515 close $fd_mm
1516 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1517 set pcm_source "squash"
1518 set fd_sm [safe_open_file [gitdir SQUASH_MSG] r]
1519 fconfigure $fd_sm -encoding utf-8
1520 puts -nonewline $fd_pcm [read $fd_sm]
1521 close $fd_sm
1522 } elseif {[file isfile [get_config commit.template]]} {
1523 set pcm_source "template"
1524 set fd_sm [safe_open_file [get_config commit.template] r]
1525 fconfigure $fd_sm -encoding utf-8
1526 puts -nonewline $fd_pcm [read $fd_sm]
1527 close $fd_sm
1528 } else {
1529 set pcm_source ""
1530 }
1531
1532 close $fd_pcm
1533
1534 set fd_ph [githook_read prepare-commit-msg \
1535 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1536 if {$fd_ph eq {}} {
1537 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1538 return 0;
1539 }
1540
1541 ui_status [mc "Calling prepare-commit-msg hook..."]
1542 set pch_error {}
1543
1544 fconfigure $fd_ph -blocking 0 -translation binary
1545 fileevent $fd_ph readable \
1546 [list prepare_commit_msg_hook_wait $fd_ph]
1547
1548 return 1;
1549 }
1550
1551 proc prepare_commit_msg_hook_wait {fd_ph} {
1552 global pch_error
1553
1554 append pch_error [read $fd_ph]
1555 fconfigure $fd_ph -blocking 1
1556 if {[eof $fd_ph]} {
1557 if {[catch {close $fd_ph}]} {
1558 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1559 hook_failed_popup prepare-commit-msg $pch_error
1560 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1561 exit 1
1562 } else {
1563 load_message PREPARE_COMMIT_MSG
1564 }
1565 set pch_error {}
1566 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1567 return
1568 }
1569 fconfigure $fd_ph -blocking 0
1570 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1571 }
1572
1573 proc read_diff_index {fd after} {
1574 global buf_rdi
1575
1576 append buf_rdi [read $fd]
1577 set c 0
1578 set n [string length $buf_rdi]
1579 while {$c < $n} {
1580 set z1 [string first "\0" $buf_rdi $c]
1581 if {$z1 == -1} break
1582 incr z1
1583 set z2 [string first "\0" $buf_rdi $z1]
1584 if {$z2 == -1} break
1585
1586 incr c
1587 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1588 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1589 merge_state \
1590 [convertfrom utf-8 $p] \
1591 [lindex $i 4]? \
1592 [list [lindex $i 0] [lindex $i 2]] \
1593 [list]
1594 set c $z2
1595 incr c
1596 }
1597 if {$c < $n} {
1598 set buf_rdi [string range $buf_rdi $c end]
1599 } else {
1600 set buf_rdi {}
1601 }
1602
1603 rescan_done $fd buf_rdi $after
1604 }
1605
1606 proc read_diff_files {fd after} {
1607 global buf_rdf
1608
1609 append buf_rdf [read $fd]
1610 set c 0
1611 set n [string length $buf_rdf]
1612 while {$c < $n} {
1613 set z1 [string first "\0" $buf_rdf $c]
1614 if {$z1 == -1} break
1615 incr z1
1616 set z2 [string first "\0" $buf_rdf $z1]
1617 if {$z2 == -1} break
1618
1619 incr c
1620 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1621 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1622 merge_state \
1623 [convertfrom utf-8 $p] \
1624 ?[lindex $i 4] \
1625 [list] \
1626 [list [lindex $i 0] [lindex $i 2]]
1627 set c $z2
1628 incr c
1629 }
1630 if {$c < $n} {
1631 set buf_rdf [string range $buf_rdf $c end]
1632 } else {
1633 set buf_rdf {}
1634 }
1635
1636 rescan_done $fd buf_rdf $after
1637 }
1638
1639 proc read_ls_others {fd after} {
1640 global buf_rlo
1641
1642 append buf_rlo [read $fd]
1643 set pck [split $buf_rlo "\0"]
1644 set buf_rlo [lindex $pck end]
1645 foreach p [lrange $pck 0 end-1] {
1646 set p [convertfrom utf-8 $p]
1647 if {[string index $p end] eq {/}} {
1648 set p [string range $p 0 end-1]
1649 }
1650 merge_state $p ?O
1651 }
1652 rescan_done $fd buf_rlo $after
1653 }
1654
1655 proc rescan_done {fd buf after} {
1656 global rescan_active current_diff_path
1657 global file_states repo_config
1658 upvar $buf to_clear
1659
1660 if {![eof $fd]} return
1661 set to_clear {}
1662 close $fd
1663 if {[incr rescan_active -1] > 0} return
1664
1665 prune_selection
1666 unlock_index
1667 display_all_files
1668 if {$current_diff_path ne {}} { reshow_diff $after }
1669 if {$current_diff_path eq {}} { select_first_diff $after }
1670 }
1671
1672 proc prune_selection {} {
1673 global file_states selected_paths
1674
1675 foreach path [array names selected_paths] {
1676 if {[catch {set still_here $file_states($path)}]} {
1677 unset selected_paths($path)
1678 }
1679 }
1680 }
1681
1682 ######################################################################
1683 ##
1684 ## ui helpers
1685
1686 proc mapicon {w state path} {
1687 global all_icons
1688
1689 if {[catch {set r $all_icons($state$w)}]} {
1690 puts "error: no icon for $w state={$state} $path"
1691 return file_plain
1692 }
1693 return $r
1694 }
1695
1696 proc mapdesc {state path} {
1697 global all_descs
1698
1699 if {[catch {set r $all_descs($state)}]} {
1700 puts "error: no desc for state={$state} $path"
1701 return $state
1702 }
1703 return $r
1704 }
1705
1706 proc ui_status {msg} {
1707 global main_status
1708 if {[info exists main_status]} {
1709 $main_status show $msg
1710 }
1711 }
1712
1713 proc ui_ready {} {
1714 global main_status
1715 if {[info exists main_status]} {
1716 $main_status show [mc "Ready."]
1717 }
1718 }
1719
1720 proc escape_path {path} {
1721 regsub -all {\\} $path "\\\\" path
1722 regsub -all "\n" $path "\\n" path
1723 return $path
1724 }
1725
1726 proc short_path {path} {
1727 return [escape_path [lindex [file split $path] end]]
1728 }
1729
1730 set next_icon_id 0
1731
1732 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1733 global file_states next_icon_id nullid
1734
1735 set s0 [string index $new_state 0]
1736 set s1 [string index $new_state 1]
1737
1738 if {[catch {set info $file_states($path)}]} {
1739 set state __
1740 set icon n[incr next_icon_id]
1741 } else {
1742 set state [lindex $info 0]
1743 set icon [lindex $info 1]
1744 if {$head_info eq {}} {set head_info [lindex $info 2]}
1745 if {$index_info eq {}} {set index_info [lindex $info 3]}
1746 }
1747
1748 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1749 elseif {$s0 eq {_}} {set s0 _}
1750
1751 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1752 elseif {$s1 eq {_}} {set s1 _}
1753
1754 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1755 set head_info [list 0 $nullid]
1756 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1757 && $head_info eq {}} {
1758 set head_info $index_info
1759 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1760 set index_info $head_info
1761 set head_info {}
1762 }
1763
1764 set file_states($path) [list $s0$s1 $icon \
1765 $head_info $index_info \
1766 ]
1767 return $state
1768 }
1769
1770 proc display_file_helper {w path icon_name old_m new_m} {
1771 global file_lists
1772
1773 if {$new_m eq {_}} {
1774 set lno [lsearch -sorted -exact $file_lists($w) $path]
1775 if {$lno >= 0} {
1776 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1777 incr lno
1778 $w conf -state normal
1779 $w delete $lno.0 [expr {$lno + 1}].0
1780 $w conf -state disabled
1781 }
1782 } elseif {$old_m eq {_} && $new_m ne {_}} {
1783 lappend file_lists($w) $path
1784 set file_lists($w) [lsort -unique $file_lists($w)]
1785 set lno [lsearch -sorted -exact $file_lists($w) $path]
1786 incr lno
1787 $w conf -state normal
1788 $w image create $lno.0 \
1789 -align center -padx 5 -pady 1 \
1790 -name $icon_name \
1791 -image [mapicon $w $new_m $path]
1792 $w insert $lno.1 "[escape_path $path]\n"
1793 $w conf -state disabled
1794 } elseif {$old_m ne $new_m} {
1795 $w conf -state normal
1796 $w image conf $icon_name -image [mapicon $w $new_m $path]
1797 $w conf -state disabled
1798 }
1799 }
1800
1801 proc display_file {path state} {
1802 global file_states selected_paths
1803 global ui_index ui_workdir
1804
1805 set old_m [merge_state $path $state]
1806 set s $file_states($path)
1807 set new_m [lindex $s 0]
1808 set icon_name [lindex $s 1]
1809
1810 set o [string index $old_m 0]
1811 set n [string index $new_m 0]
1812 if {$o eq {U}} {
1813 set o _
1814 }
1815 if {$n eq {U}} {
1816 set n _
1817 }
1818 display_file_helper $ui_index $path $icon_name $o $n
1819
1820 if {[string index $old_m 0] eq {U}} {
1821 set o U
1822 } else {
1823 set o [string index $old_m 1]
1824 }
1825 if {[string index $new_m 0] eq {U}} {
1826 set n U
1827 } else {
1828 set n [string index $new_m 1]
1829 }
1830 display_file_helper $ui_workdir $path $icon_name $o $n
1831
1832 if {$new_m eq {__}} {
1833 unset file_states($path)
1834 catch {unset selected_paths($path)}
1835 }
1836 }
1837
1838 proc display_all_files_helper {w path icon_name m} {
1839 global file_lists
1840
1841 lappend file_lists($w) $path
1842 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1843 $w image create end \
1844 -align center -padx 5 -pady 1 \
1845 -name $icon_name \
1846 -image [mapicon $w $m $path]
1847 $w insert end "[escape_path $path]\n"
1848 }
1849
1850 set files_warning 0
1851 proc display_all_files {} {
1852 global ui_index ui_workdir
1853 global file_states file_lists
1854 global last_clicked
1855 global files_warning
1856
1857 $ui_index conf -state normal
1858 $ui_workdir conf -state normal
1859
1860 $ui_index delete 0.0 end
1861 $ui_workdir delete 0.0 end
1862 set last_clicked {}
1863
1864 set file_lists($ui_index) [list]
1865 set file_lists($ui_workdir) [list]
1866
1867 set to_display [lsort [array names file_states]]
1868 set display_limit [get_config gui.maxfilesdisplayed]
1869 set displayed 0
1870 foreach path $to_display {
1871 set s $file_states($path)
1872 set m [lindex $s 0]
1873 set icon_name [lindex $s 1]
1874
1875 if {$displayed > $display_limit && [string index $m 1] eq {O} } {
1876 if {!$files_warning} {
1877 # do not repeatedly warn:
1878 set files_warning 1
1879 info_popup [mc "Display limit (gui.maxfilesdisplayed = %s) reached, not showing all %s files." \
1880 $display_limit [llength $to_display]]
1881 }
1882 continue
1883 }
1884
1885 set s [string index $m 0]
1886 if {$s ne {U} && $s ne {_}} {
1887 display_all_files_helper $ui_index $path \
1888 $icon_name $s
1889 }
1890
1891 if {[string index $m 0] eq {U}} {
1892 set s U
1893 } else {
1894 set s [string index $m 1]
1895 }
1896 if {$s ne {_}} {
1897 display_all_files_helper $ui_workdir $path \
1898 $icon_name $s
1899 incr displayed
1900 }
1901 }
1902
1903 $ui_index conf -state disabled
1904 $ui_workdir conf -state disabled
1905 }
1906
1907 ######################################################################
1908 ##
1909 ## icons
1910
1911 set filemask {
1912 #define mask_width 14
1913 #define mask_height 15
1914 static unsigned char mask_bits[] = {
1915 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1916 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1917 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1918 }
1919
1920 image create bitmap file_plain -background white -foreground black -data {
1921 #define plain_width 14
1922 #define plain_height 15
1923 static unsigned char plain_bits[] = {
1924 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1925 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1926 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1927 } -maskdata $filemask
1928
1929 image create bitmap file_mod -background white -foreground blue -data {
1930 #define mod_width 14
1931 #define mod_height 15
1932 static unsigned char mod_bits[] = {
1933 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1934 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1935 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1936 } -maskdata $filemask
1937
1938 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1939 #define file_fulltick_width 14
1940 #define file_fulltick_height 15
1941 static unsigned char file_fulltick_bits[] = {
1942 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1943 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1944 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1945 } -maskdata $filemask
1946
1947 image create bitmap file_question -background white -foreground black -data {
1948 #define file_question_width 14
1949 #define file_question_height 15
1950 static unsigned char file_question_bits[] = {
1951 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1952 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1953 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1954 } -maskdata $filemask
1955
1956 image create bitmap file_removed -background white -foreground red -data {
1957 #define file_removed_width 14
1958 #define file_removed_height 15
1959 static unsigned char file_removed_bits[] = {
1960 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1961 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1962 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1963 } -maskdata $filemask
1964
1965 image create bitmap file_merge -background white -foreground blue -data {
1966 #define file_merge_width 14
1967 #define file_merge_height 15
1968 static unsigned char file_merge_bits[] = {
1969 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1970 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1971 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1972 } -maskdata $filemask
1973
1974 image create bitmap file_statechange -background white -foreground green -data {
1975 #define file_statechange_width 14
1976 #define file_statechange_height 15
1977 static unsigned char file_statechange_bits[] = {
1978 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1979 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1980 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1981 } -maskdata $filemask
1982
1983 set ui_index .vpane.files.index.list
1984 set ui_workdir .vpane.files.workdir.list
1985
1986 set all_icons(_$ui_index) file_plain
1987 set all_icons(A$ui_index) file_plain
1988 set all_icons(M$ui_index) file_fulltick
1989 set all_icons(D$ui_index) file_removed
1990 set all_icons(U$ui_index) file_merge
1991 set all_icons(T$ui_index) file_statechange
1992
1993 set all_icons(_$ui_workdir) file_plain
1994 set all_icons(M$ui_workdir) file_mod
1995 set all_icons(D$ui_workdir) file_question
1996 set all_icons(U$ui_workdir) file_merge
1997 set all_icons(O$ui_workdir) file_plain
1998 set all_icons(T$ui_workdir) file_statechange
1999
2000 set max_status_desc 0
2001 foreach i {
2002 {__ {mc "Unmodified"}}
2003
2004 {_M {mc "Modified, not staged"}}
2005 {M_ {mc "Staged for commit"}}
2006 {MM {mc "Portions staged for commit"}}
2007 {MD {mc "Staged for commit, missing"}}
2008
2009 {_T {mc "File type changed, not staged"}}
2010 {MT {mc "File type changed, old type staged for commit"}}
2011 {AT {mc "File type changed, old type staged for commit"}}
2012 {T_ {mc "File type changed, staged"}}
2013 {TM {mc "File type change staged, modification not staged"}}
2014 {TD {mc "File type change staged, file missing"}}
2015
2016 {_O {mc "Untracked, not staged"}}
2017 {A_ {mc "Staged for commit"}}
2018 {AM {mc "Portions staged for commit"}}
2019 {AD {mc "Staged for commit, missing"}}
2020
2021 {_D {mc "Missing"}}
2022 {D_ {mc "Staged for removal"}}
2023 {DO {mc "Staged for removal, still present"}}
2024
2025 {_U {mc "Requires merge resolution"}}
2026 {U_ {mc "Requires merge resolution"}}
2027 {UU {mc "Requires merge resolution"}}
2028 {UM {mc "Requires merge resolution"}}
2029 {UD {mc "Requires merge resolution"}}
2030 {UT {mc "Requires merge resolution"}}
2031 } {
2032 set text [eval [lindex $i 1]]
2033 if {$max_status_desc < [string length $text]} {
2034 set max_status_desc [string length $text]
2035 }
2036 set all_descs([lindex $i 0]) $text
2037 }
2038 unset i
2039
2040 ######################################################################
2041 ##
2042 ## util
2043
2044 proc scrollbar2many {list mode args} {
2045 foreach w $list {eval $w $mode $args}
2046 }
2047
2048 proc many2scrollbar {list mode sb top bottom} {
2049 $sb set $top $bottom
2050 foreach w $list {$w $mode moveto $top}
2051 }
2052
2053 proc incr_font_size {font {amt 1}} {
2054 set sz [font configure $font -size]
2055 incr sz $amt
2056 font configure $font -size $sz
2057 font configure ${font}bold -size $sz
2058 font configure ${font}italic -size $sz
2059 }
2060
2061 ######################################################################
2062 ##
2063 ## ui commands
2064
2065 proc do_gitk {revs {is_submodule false}} {
2066 global current_diff_path file_states current_diff_side ui_index
2067
2068 # -- Always start gitk through whatever we were loaded with. This
2069 # lets us bypass using shell process on Windows systems.
2070 #
2071 set exe [_which gitk -script]
2072 set cmd [list [info nameofexecutable] $exe]
2073 if {$exe eq {}} {
2074 error_popup [mc "Couldn't find gitk in PATH"]
2075 } else {
2076 set pwd [pwd]
2077
2078 if {$is_submodule} {
2079 cd $current_diff_path
2080 if {$revs eq {--}} {
2081 set s $file_states($current_diff_path)
2082 set old_sha1 {}
2083 set new_sha1 {}
2084 switch -glob -- [lindex $s 0] {
2085 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2086 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2087 MM {
2088 if {$current_diff_side eq $ui_index} {
2089 set old_sha1 [lindex [lindex $s 2] 1]
2090 set new_sha1 [lindex [lindex $s 3] 1]
2091 } else {
2092 set old_sha1 [lindex [lindex $s 3] 1]
2093 }
2094 }
2095 }
2096 set revs $old_sha1...$new_sha1
2097 }
2098 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2099 # we've been using for the main repository, so unset them.
2100 # TODO we could make life easier (start up faster?) for gitk
2101 # by setting these to the appropriate values to allow gitk
2102 # to skip the heuristics to find their proper value
2103 unset_gitdir_vars
2104 }
2105 safe_exec_bg [concat $cmd $revs "--" "--"]
2106
2107 set_gitdir_vars
2108 cd $pwd
2109
2110 if {[info exists main_status]} {
2111 set status_operation [$::main_status \
2112 start \
2113 [mc "Starting %s... please wait..." "gitk"]]
2114
2115 after 3500 [list $status_operation stop]
2116 }
2117 }
2118 }
2119
2120 proc do_git_gui {} {
2121 global current_diff_path
2122
2123 # -- Always start git gui through whatever we were loaded with. This
2124 # lets us bypass using shell process on Windows systems.
2125 #
2126 set exe [list [_which git]]
2127 if {$exe eq {}} {
2128 error_popup [mc "Couldn't find git gui in PATH"]
2129 } else {
2130 # see note in do_gitk about unsetting these vars when
2131 # running tools in a submodule
2132 unset_gitdir_vars
2133
2134 set pwd [pwd]
2135 cd $current_diff_path
2136
2137 safe_exec_bg [concat $exe gui]
2138
2139 set_gitdir_vars
2140 cd $pwd
2141
2142 set status_operation [$::main_status \
2143 start \
2144 [mc "Starting %s... please wait..." "git-gui"]]
2145
2146 after 3500 [list $status_operation stop]
2147 }
2148 }
2149
2150 # Get the system-specific explorer app/command.
2151 proc get_explorer {} {
2152 if {[is_Cygwin]} {
2153 set explorer "/bin/cygstart.exe --explore"
2154 } elseif {[is_Windows]} {
2155 set explorer "explorer.exe"
2156 } elseif {[is_MacOSX]} {
2157 set explorer "open"
2158 } else {
2159 # freedesktop.org-conforming system is our best shot
2160 set explorer "xdg-open"
2161 }
2162 return $explorer
2163 }
2164
2165 proc do_explore {} {
2166 global _gitworktree
2167 set cmd [get_explorer]
2168 lappend cmd [file nativename $_gitworktree]
2169 safe_exec_bg $cmd
2170 }
2171
2172 # Open file relative to the working tree by the default associated app.
2173 proc do_file_open {file} {
2174 global _gitworktree
2175 set cmd [get_explorer]
2176 set full_file_path [file join $_gitworktree $file]
2177 lappend cmd [file nativename $full_file_path]
2178 safe_exec_bg $cmd
2179 }
2180
2181 set is_quitting 0
2182 set ret_code 1
2183
2184 proc terminate_me {win} {
2185 global ret_code
2186 if {$win ne {.}} return
2187 exit $ret_code
2188 }
2189
2190 proc do_quit {{rc {1}}} {
2191 global ui_comm is_quitting repo_config commit_type
2192 global GITGUI_BCK_exists GITGUI_BCK_i
2193 global ui_comm_spell
2194 global ret_code
2195
2196 if {$is_quitting} return
2197 set is_quitting 1
2198
2199 if {[winfo exists $ui_comm]} {
2200 # -- Stash our current commit buffer.
2201 #
2202 set save [gitdir GITGUI_MSG]
2203 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2204 catch { file rename -force [gitdir GITGUI_BCK] $save }
2205 set GITGUI_BCK_exists 0
2206 } elseif {[$ui_comm edit modified]} {
2207 set msg [string trim [$ui_comm get 0.0 end]]
2208 regsub -all -line {[ \r\t]+$} $msg {} msg
2209 if {![string match amend* $commit_type]
2210 && $msg ne {}} {
2211 catch {
2212 set fd [safe_open_file $save w]
2213 fconfigure $fd -encoding utf-8
2214 puts -nonewline $fd $msg
2215 close $fd
2216 }
2217 } else {
2218 catch {file delete $save}
2219 }
2220 }
2221
2222 # -- Cancel our spellchecker if its running.
2223 #
2224 if {[info exists ui_comm_spell]} {
2225 $ui_comm_spell stop
2226 }
2227
2228 # -- Remove our editor backup, its not needed.
2229 #
2230 after cancel $GITGUI_BCK_i
2231 if {$GITGUI_BCK_exists} {
2232 catch {file delete [gitdir GITGUI_BCK]}
2233 }
2234
2235 # -- Stash our current window geometry into this repository.
2236 #
2237 set cfg_wmstate [wm state .]
2238 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2239 set rc_wmstate {}
2240 }
2241 if {$cfg_wmstate ne $rc_wmstate} {
2242 catch {git config gui.wmstate $cfg_wmstate}
2243 }
2244 if {$cfg_wmstate eq {zoomed}} {
2245 # on Windows wm geometry will lie about window
2246 # position (but not size) when window is zoomed
2247 # restore the window before querying wm geometry
2248 wm state . normal
2249 }
2250 set cfg_geometry [list]
2251 lappend cfg_geometry [wm geometry .]
2252 lappend cfg_geometry [.vpane sashpos 0]
2253 lappend cfg_geometry [.vpane.files sashpos 0]
2254 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2255 set rc_geometry {}
2256 }
2257 if {$cfg_geometry ne $rc_geometry} {
2258 catch {git config gui.geometry $cfg_geometry}
2259 }
2260 }
2261
2262 set ret_code $rc
2263
2264 # Briefly enable send again, working around Tk bug
2265 # https://sourceforge.net/p/tktoolkit/bugs/2343/
2266 tk appname [appname]
2267
2268 destroy .
2269 }
2270
2271 proc do_rescan {} {
2272 rescan ui_ready
2273 }
2274
2275 proc ui_do_rescan {} {
2276 rescan {force_first_diff ui_ready}
2277 }
2278
2279 proc do_commit {} {
2280 commit_tree
2281 }
2282
2283 proc next_diff {{after {}}} {
2284 global next_diff_p next_diff_w next_diff_i
2285 show_diff $next_diff_p $next_diff_w {} {} $after
2286 }
2287
2288 proc find_anchor_pos {lst name} {
2289 set lid [lsearch -sorted -exact $lst $name]
2290
2291 if {$lid == -1} {
2292 set lid 0
2293 foreach lname $lst {
2294 if {$lname >= $name} break
2295 incr lid
2296 }
2297 }
2298
2299 return $lid
2300 }
2301
2302 proc find_file_from {flist idx delta path mmask} {
2303 global file_states
2304
2305 set len [llength $flist]
2306 while {$idx >= 0 && $idx < $len} {
2307 set name [lindex $flist $idx]
2308
2309 if {$name ne $path && [info exists file_states($name)]} {
2310 set state [lindex $file_states($name) 0]
2311
2312 if {$mmask eq {} || [regexp $mmask $state]} {
2313 return $idx
2314 }
2315 }
2316
2317 incr idx $delta
2318 }
2319
2320 return {}
2321 }
2322
2323 proc find_next_diff {w path {lno {}} {mmask {}}} {
2324 global next_diff_p next_diff_w next_diff_i
2325 global file_lists ui_index ui_workdir
2326
2327 set flist $file_lists($w)
2328 if {$lno eq {}} {
2329 set lno [find_anchor_pos $flist $path]
2330 } else {
2331 incr lno -1
2332 }
2333
2334 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2335 if {$w eq $ui_index} {
2336 set mmask "^$mmask"
2337 } else {
2338 set mmask "$mmask\$"
2339 }
2340 }
2341
2342 set idx [find_file_from $flist $lno 1 $path $mmask]
2343 if {$idx eq {}} {
2344 incr lno -1
2345 set idx [find_file_from $flist $lno -1 $path $mmask]
2346 }
2347
2348 if {$idx ne {}} {
2349 set next_diff_w $w
2350 set next_diff_p [lindex $flist $idx]
2351 set next_diff_i [expr {$idx+1}]
2352 return 1
2353 } else {
2354 return 0
2355 }
2356 }
2357
2358 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2359 global current_diff_path
2360
2361 if {$path ne $current_diff_path} {
2362 return {}
2363 } elseif {[find_next_diff $w $path $lno $mmask]} {
2364 return {next_diff;}
2365 } else {
2366 return {reshow_diff;}
2367 }
2368 }
2369
2370 proc select_first_diff {after} {
2371 global ui_workdir
2372
2373 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2374 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2375 next_diff $after
2376 } else {
2377 uplevel #0 $after
2378 }
2379 }
2380
2381 proc force_first_diff {after} {
2382 global ui_workdir current_diff_path file_states
2383
2384 if {[info exists file_states($current_diff_path)]} {
2385 set state [lindex $file_states($current_diff_path) 0]
2386 } else {
2387 set state {OO}
2388 }
2389
2390 set reselect 0
2391 if {[string first {U} $state] >= 0} {
2392 # Already a conflict, do nothing
2393 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2394 set reselect 1
2395 } elseif {[string index $state 1] ne {O}} {
2396 # Already a diff & no conflicts, do nothing
2397 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2398 set reselect 1
2399 }
2400
2401 if {$reselect} {
2402 next_diff $after
2403 } else {
2404 uplevel #0 $after
2405 }
2406 }
2407
2408 proc toggle_or_diff {mode w args} {
2409 global file_states file_lists current_diff_path ui_index ui_workdir
2410 global last_clicked selected_paths file_lists_last_clicked
2411
2412 if {$mode eq "click"} {
2413 foreach {x y} $args break
2414 set pos [split [$w index @$x,$y] .]
2415 foreach {lno col} $pos break
2416 } else {
2417 if {$mode eq "toggle"} {
2418 if {$w eq $ui_workdir} {
2419 do_add_selection
2420 set last_clicked {}
2421 return
2422 }
2423 if {$w eq $ui_index} {
2424 do_unstage_selection
2425 set last_clicked {}
2426 return
2427 }
2428 }
2429
2430 if {$last_clicked ne {}} {
2431 set lno [lindex $last_clicked 1]
2432 } else {
2433 if {![info exists file_lists]
2434 || ![info exists file_lists($w)]
2435 || [llength $file_lists($w)] == 0} {
2436 set last_clicked {}
2437 return
2438 }
2439 set lno [expr {int([lindex [$w tag ranges in_diff] 0])}]
2440 }
2441 if {$mode eq "toggle"} {
2442 set col 0; set y 2
2443 } else {
2444 incr lno [expr {$mode eq "up" ? -1 : 1}]
2445 set col 1
2446 }
2447 }
2448
2449 if {![info exists file_lists]
2450 || ![info exists file_lists($w)]
2451 || [llength $file_lists($w)] < $lno - 1} {
2452 set path {}
2453 } else {
2454 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2455 }
2456 if {$path eq {}} {
2457 set last_clicked {}
2458 return
2459 }
2460
2461 set last_clicked [list $w $lno]
2462 focus $w
2463 array unset selected_paths
2464 $ui_index tag remove in_sel 0.0 end
2465 $ui_workdir tag remove in_sel 0.0 end
2466
2467 set file_lists_last_clicked($w) $path
2468
2469 # Determine the state of the file
2470 if {[info exists file_states($path)]} {
2471 set state [lindex $file_states($path) 0]
2472 } else {
2473 set state {__}
2474 }
2475
2476 # Restage the file, or simply show the diff
2477 if {$col == 0 && $y > 1} {
2478 # Conflicts need special handling
2479 if {[string first {U} $state] >= 0} {
2480 # $w must always be $ui_workdir, but...
2481 if {$w ne $ui_workdir} { set lno {} }
2482 merge_stage_workdir $path $lno
2483 return
2484 }
2485
2486 if {[string index $state 1] eq {O}} {
2487 set mmask {}
2488 } else {
2489 set mmask {[^O]}
2490 }
2491
2492 set after [next_diff_after_action $w $path $lno $mmask]
2493
2494 if {$w eq $ui_index} {
2495 update_indexinfo \
2496 "Unstaging [short_path $path] from commit" \
2497 [list $path] \
2498 [concat $after {ui_ready;}]
2499 } elseif {$w eq $ui_workdir} {
2500 update_index \
2501 "Adding [short_path $path]" \
2502 [list $path] \
2503 [concat $after {ui_ready;}]
2504 }
2505 } else {
2506 set selected_paths($path) 1
2507 show_diff $path $w $lno
2508 }
2509 }
2510
2511 proc add_one_to_selection {w x y} {
2512 global file_lists last_clicked selected_paths
2513
2514 set lno [lindex [split [$w index @$x,$y] .] 0]
2515 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2516 if {$path eq {}} {
2517 set last_clicked {}
2518 return
2519 }
2520
2521 if {$last_clicked ne {}
2522 && [lindex $last_clicked 0] ne $w} {
2523 array unset selected_paths
2524 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2525 }
2526
2527 set last_clicked [list $w $lno]
2528 if {[catch {set in_sel $selected_paths($path)}]} {
2529 set in_sel 0
2530 }
2531 if {$in_sel} {
2532 unset selected_paths($path)
2533 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2534 } else {
2535 set selected_paths($path) 1
2536 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2537 }
2538 }
2539
2540 proc add_range_to_selection {w x y} {
2541 global file_lists last_clicked selected_paths
2542
2543 if {[lindex $last_clicked 0] ne $w} {
2544 toggle_or_diff click $w $x $y
2545 return
2546 }
2547
2548 set lno [lindex [split [$w index @$x,$y] .] 0]
2549 set lc [lindex $last_clicked 1]
2550 if {$lc < $lno} {
2551 set begin $lc
2552 set end $lno
2553 } else {
2554 set begin $lno
2555 set end $lc
2556 }
2557
2558 foreach path [lrange $file_lists($w) \
2559 [expr {$begin - 1}] \
2560 [expr {$end - 1}]] {
2561 set selected_paths($path) 1
2562 }
2563 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2564 }
2565
2566 proc show_more_context {} {
2567 global repo_config
2568 if {$repo_config(gui.diffcontext) < 99} {
2569 incr repo_config(gui.diffcontext)
2570 reshow_diff
2571 }
2572 }
2573
2574 proc show_less_context {} {
2575 global repo_config
2576 if {$repo_config(gui.diffcontext) > 1} {
2577 incr repo_config(gui.diffcontext) -1
2578 reshow_diff
2579 }
2580 }
2581
2582 proc focus_widget {widget} {
2583 global file_lists last_clicked selected_paths
2584 global file_lists_last_clicked
2585
2586 if {[llength $file_lists($widget)] > 0} {
2587 set path $file_lists_last_clicked($widget)
2588 set index [lsearch -sorted -exact $file_lists($widget) $path]
2589 if {$index < 0} {
2590 set index 0
2591 set path [lindex $file_lists($widget) $index]
2592 }
2593
2594 focus $widget
2595 set last_clicked [list $widget [expr $index + 1]]
2596 array unset selected_paths
2597 set selected_paths($path) 1
2598 show_diff $path $widget
2599 }
2600 }
2601
2602 proc toggle_commit_type {} {
2603 global commit_type_is_amend
2604 set commit_type_is_amend [expr !$commit_type_is_amend]
2605 do_select_commit_type
2606 }
2607
2608 ######################################################################
2609 ##
2610 ## ui construction
2611
2612 set ui_comm {}
2613
2614 # -- Menu Bar
2615 #
2616 menu .mbar -tearoff 0
2617 if {[is_MacOSX]} {
2618 # -- Apple Menu (Mac OS X only)
2619 #
2620 .mbar add cascade -label Apple -menu .mbar.apple
2621 menu .mbar.apple
2622 }
2623 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2624 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2625 if {[is_enabled branch]} {
2626 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2627 }
2628 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2629 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2630 }
2631 if {[is_enabled transport]} {
2632 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2633 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2634 }
2635 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2636 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2637 }
2638
2639 # -- Repository Menu
2640 #
2641 menu .mbar.repository
2642
2643 if {![is_bare]} {
2644 .mbar.repository add command \
2645 -label [mc "Explore Working Copy"] \
2646 -command {do_explore}
2647 }
2648
2649 if {[is_Windows]} {
2650 # Use /git-bash.exe if available
2651 set _git_bash [safe_exec [list cygpath -m /git-bash.exe]]
2652 if {[file executable $_git_bash]} {
2653 set _bash_cmdline [list "Git Bash" $_git_bash]
2654 } else {
2655 set _bash_cmdline [list "Git Bash" bash --login -l]
2656 }
2657 .mbar.repository add command \
2658 -label [mc "Git Bash"] \
2659 -command {safe_exec_bg [concat [list [_which cmd] /c start] $_bash_cmdline]}
2660 unset _git_bash
2661 }
2662
2663 if {[is_Windows] || ![is_bare]} {
2664 .mbar.repository add separator
2665 }
2666
2667 .mbar.repository add command \
2668 -label [mc "Browse Current Branch's Files"] \
2669 -command {browser::new $current_branch}
2670 set ui_browse_current [.mbar.repository index last]
2671 .mbar.repository add command \
2672 -label [mc "Browse Branch Files..."] \
2673 -command browser_open::dialog
2674 .mbar.repository add separator
2675
2676 .mbar.repository add command \
2677 -label [mc "Visualize Current Branch's History"] \
2678 -command {do_gitk $current_branch}
2679 set ui_visualize_current [.mbar.repository index last]
2680 .mbar.repository add command \
2681 -label [mc "Visualize All Branch History"] \
2682 -command {do_gitk --all}
2683 .mbar.repository add separator
2684
2685 proc current_branch_write {args} {
2686 global current_branch
2687 .mbar.repository entryconf $::ui_browse_current \
2688 -label [mc "Browse %s's Files" $current_branch]
2689 .mbar.repository entryconf $::ui_visualize_current \
2690 -label [mc "Visualize %s's History" $current_branch]
2691 }
2692 trace add variable current_branch write current_branch_write
2693
2694 if {[is_enabled multicommit]} {
2695 .mbar.repository add command -label [mc "Database Statistics"] \
2696 -command do_stats
2697
2698 .mbar.repository add command -label [mc "Compress Database"] \
2699 -command do_gc
2700
2701 .mbar.repository add command -label [mc "Verify Database"] \
2702 -command do_fsck_objects
2703
2704 .mbar.repository add separator
2705
2706 if {[is_Cygwin]} {
2707 .mbar.repository add command \
2708 -label [mc "Create Desktop Icon"] \
2709 -command do_cygwin_shortcut
2710 } elseif {[is_Windows]} {
2711 .mbar.repository add command \
2712 -label [mc "Create Desktop Icon"] \
2713 -command do_windows_shortcut
2714 } elseif {[is_MacOSX]} {
2715 .mbar.repository add command \
2716 -label [mc "Create Desktop Icon"] \
2717 -command do_macosx_app
2718 }
2719 }
2720
2721 if {[is_MacOSX]} {
2722 proc ::tk::mac::Quit {args} { do_quit }
2723 } else {
2724 .mbar.repository add command -label [mc Quit] \
2725 -command do_quit \
2726 -accelerator $M1T-Q
2727 }
2728
2729 # -- Edit Menu
2730 #
2731 menu .mbar.edit
2732 .mbar.edit add command -label [mc Undo] \
2733 -command {catch {[focus] edit undo}} \
2734 -accelerator $M1T-Z
2735 .mbar.edit add command -label [mc Redo] \
2736 -command {catch {[focus] edit redo}} \
2737 -accelerator $M1T-Y
2738 .mbar.edit add separator
2739 .mbar.edit add command -label [mc Cut] \
2740 -command {catch {tk_textCut [focus]}} \
2741 -accelerator $M1T-X
2742 .mbar.edit add command -label [mc Copy] \
2743 -command {catch {tk_textCopy [focus]}} \
2744 -accelerator $M1T-C
2745 .mbar.edit add command -label [mc Paste] \
2746 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2747 -accelerator $M1T-V
2748 .mbar.edit add command -label [mc Delete] \
2749 -command {catch {[focus] delete sel.first sel.last}} \
2750 -accelerator Del
2751 .mbar.edit add separator
2752 .mbar.edit add command -label [mc "Select All"] \
2753 -command {catch {[focus] tag add sel 0.0 end}} \
2754 -accelerator $M1T-A
2755
2756 # -- Branch Menu
2757 #
2758 if {[is_enabled branch]} {
2759 menu .mbar.branch
2760
2761 .mbar.branch add command -label [mc "Create..."] \
2762 -command branch_create::dialog \
2763 -accelerator $M1T-N
2764 lappend disable_on_lock [list .mbar.branch entryconf \
2765 [.mbar.branch index last] -state]
2766
2767 .mbar.branch add command -label [mc "Checkout..."] \
2768 -command branch_checkout::dialog \
2769 -accelerator $M1T-O
2770 lappend disable_on_lock [list .mbar.branch entryconf \
2771 [.mbar.branch index last] -state]
2772
2773 .mbar.branch add command -label [mc "Rename..."] \
2774 -command branch_rename::dialog
2775 lappend disable_on_lock [list .mbar.branch entryconf \
2776 [.mbar.branch index last] -state]
2777
2778 .mbar.branch add command -label [mc "Delete..."] \
2779 -command branch_delete::dialog
2780 lappend disable_on_lock [list .mbar.branch entryconf \
2781 [.mbar.branch index last] -state]
2782
2783 .mbar.branch add command -label [mc "Reset..."] \
2784 -command merge::reset_hard
2785 lappend disable_on_lock [list .mbar.branch entryconf \
2786 [.mbar.branch index last] -state]
2787 }
2788
2789 # -- Commit Menu
2790 #
2791 proc commit_btn_caption {} {
2792 if {[is_enabled nocommit]} {
2793 return [mc "Done"]
2794 } else {
2795 return [mc Commit@@verb]
2796 }
2797 }
2798
2799 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2800 menu .mbar.commit
2801
2802 if {![is_enabled nocommit]} {
2803 .mbar.commit add checkbutton \
2804 -label [mc "Amend Last Commit"] \
2805 -accelerator $M1T-E \
2806 -variable commit_type_is_amend \
2807 -command do_select_commit_type
2808 lappend disable_on_lock \
2809 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2810
2811 .mbar.commit add separator
2812 }
2813
2814 .mbar.commit add command -label [mc Rescan] \
2815 -command ui_do_rescan \
2816 -accelerator F5
2817 lappend disable_on_lock \
2818 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2819
2820 .mbar.commit add command -label [mc "Stage To Commit"] \
2821 -command do_add_selection \
2822 -accelerator $M1T-T
2823 lappend disable_on_lock \
2824 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2825
2826 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2827 -command do_add_all \
2828 -accelerator $M1T-I
2829 lappend disable_on_lock \
2830 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2831
2832 .mbar.commit add command -label [mc "Unstage From Commit"] \
2833 -command do_unstage_selection \
2834 -accelerator $M1T-U
2835 lappend disable_on_lock \
2836 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2837
2838 .mbar.commit add command -label [mc "Revert Changes"] \
2839 -command do_revert_selection \
2840 -accelerator $M1T-J
2841 lappend disable_on_lock \
2842 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2843
2844 .mbar.commit add separator
2845
2846 .mbar.commit add command -label [mc "Show Less Context"] \
2847 -command show_less_context \
2848 -accelerator $M1T-\-
2849
2850 .mbar.commit add command -label [mc "Show More Context"] \
2851 -command show_more_context \
2852 -accelerator $M1T-=
2853
2854 .mbar.commit add separator
2855
2856 if {![is_enabled nocommitmsg]} {
2857 .mbar.commit add command -label [mc "Sign Off"] \
2858 -command do_signoff \
2859 -accelerator $M1T-S
2860 }
2861
2862 .mbar.commit add command -label [commit_btn_caption] \
2863 -command do_commit \
2864 -accelerator $M1T-Return
2865 lappend disable_on_lock \
2866 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2867 }
2868
2869 # -- Merge Menu
2870 #
2871 if {[is_enabled branch]} {
2872 menu .mbar.merge
2873 .mbar.merge add command -label [mc "Local Merge..."] \
2874 -command merge::dialog \
2875 -accelerator $M1T-M
2876 lappend disable_on_lock \
2877 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2878 .mbar.merge add command -label [mc "Abort Merge..."] \
2879 -command merge::reset_hard
2880 lappend disable_on_lock \
2881 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2882 }
2883
2884 # -- Transport Menu
2885 #
2886 if {[is_enabled transport]} {
2887 menu .mbar.remote
2888
2889 .mbar.remote add command \
2890 -label [mc "Add..."] \
2891 -command remote_add::dialog \
2892 -accelerator $M1T-A
2893 .mbar.remote add command \
2894 -label [mc "Push..."] \
2895 -command do_push_anywhere \
2896 -accelerator $M1T-P
2897 .mbar.remote add command \
2898 -label [mc "Delete Branch..."] \
2899 -command remote_branch_delete::dialog
2900 }
2901
2902 if {[is_MacOSX]} {
2903 proc ::tk::mac::ShowPreferences {} {do_options}
2904 } else {
2905 # -- Edit Menu
2906 #
2907 .mbar.edit add separator
2908 .mbar.edit add command -label [mc "Options..."] \
2909 -command do_options
2910 }
2911
2912 # -- Tools Menu
2913 #
2914 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2915 set tools_menubar .mbar.tools
2916 menu $tools_menubar
2917 $tools_menubar add separator
2918 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2919 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2920 set tools_tailcnt 3
2921 if {[array names repo_config guitool.*.cmd] ne {}} {
2922 tools_populate_all
2923 }
2924 }
2925
2926 # -- Help Menu
2927 #
2928 .mbar add cascade -label [mc Help] -menu .mbar.help
2929 menu .mbar.help
2930
2931 if {[is_MacOSX]} {
2932 .mbar.apple add command -label [mc "About %s" [appname]] \
2933 -command do_about
2934 .mbar.apple add separator
2935 } else {
2936 .mbar.help add command -label [mc "About %s" [appname]] \
2937 -command do_about
2938 }
2939 . configure -menu .mbar
2940
2941 set doc_path [githtmldir]
2942 if {$doc_path ne {}} {
2943 set doc_path [file join $doc_path index.html]
2944 }
2945
2946 if {[file isfile $doc_path]} {
2947 set doc_url "file:$doc_path"
2948 } else {
2949 set doc_url {https://www.kernel.org/pub/software/scm/git/docs/}
2950 }
2951
2952 proc start_browser {url} {
2953 git "web--browse" $url
2954 }
2955
2956 .mbar.help add command -label [mc "Online Documentation"] \
2957 -command [list start_browser $doc_url]
2958
2959 .mbar.help add command -label [mc "Show SSH Key"] \
2960 -command do_ssh_key
2961
2962 unset doc_path doc_url
2963
2964 # -- Standard bindings
2965 #
2966 wm protocol . WM_DELETE_WINDOW do_quit
2967 bind all <$M1B-Key-q> do_quit
2968 bind all <$M1B-Key-Q> do_quit
2969
2970 set m1b_w_script {
2971 set toplvl_win [winfo toplevel %W]
2972
2973 # If we are destroying the main window, we should call do_quit to take
2974 # care of cleanup before exiting the program.
2975 if {$toplvl_win eq "."} {
2976 do_quit
2977 } else {
2978 destroy $toplvl_win
2979 }
2980 }
2981
2982 bind all <$M1B-Key-w> $m1b_w_script
2983 bind all <$M1B-Key-W> $m1b_w_script
2984
2985 unset m1b_w_script
2986
2987 set subcommand_args {}
2988 proc usage {} {
2989 set s "[mc usage:] $::argv0 $::subcommand $::subcommand_args"
2990 if {[tk windowingsystem] eq "win32"} {
2991 wm withdraw .
2992 tk_messageBox -icon info -message $s \
2993 -title [mc "Usage"]
2994 } else {
2995 puts stderr $s
2996 }
2997 exit 1
2998 }
2999
3000 proc normalize_relpath {path} {
3001 set elements {}
3002 foreach item [file split $path] {
3003 if {$item eq {.}} continue
3004 if {$item eq {..} && [llength $elements] > 0
3005 && [lindex $elements end] ne {..}} {
3006 set elements [lrange $elements 0 end-1]
3007 continue
3008 }
3009 lappend elements $item
3010 }
3011 if {$elements ne {}} {
3012 return [eval file join $elements]
3013 } else {
3014 return {.}
3015 }
3016 }
3017
3018 proc show_parse_err {err} {
3019 if {[tk windowingsystem] eq "win32"} {
3020 catch {wm withdraw .}
3021 error_popup $err
3022 } else {
3023 puts stderr $err
3024 }
3025 exit 1
3026 }
3027
3028 # -- Not a normal commit type invocation? Do that instead!
3029 #
3030 switch -- $subcommand {
3031 browser -
3032 blame {
3033 if {$subcommand eq "blame"} {
3034 set subcommand_args {[--line=<num>] [rev] [--] <filename>}
3035 set required_pathtype blob
3036 } else {
3037 set subcommand_args {[rev] [--] <dirname>}
3038 set required_pathtype tree
3039 }
3040 set maxargs [llength $subcommand_args]
3041 set nargs [llength $argv]
3042 if {$nargs < 1 || $nargs > $maxargs} usage
3043 set head {}
3044 set path {}
3045 set jump_spec {}
3046
3047 set iarg 0
3048 foreach a $argv {
3049 incr iarg
3050 if {$iarg == $nargs} {
3051 # final argument is path
3052 set path [normalize_relpath [file join $_prefix $a]]
3053 } elseif {$a eq {--}} {
3054 # allow before required final arg that must be path
3055 if {$iarg != $nargs - 1} {
3056 usage
3057 }
3058 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3059 # --line can only be the first arg
3060 if {$iarg != 1 || $subcommand ne {blame}} usage
3061 set jump_spec [list $lnum]
3062 } elseif {$head eq {}} {
3063 set head $a
3064 } else {
3065 usage
3066 }
3067 }
3068
3069 # If head not given, use current branch (HEAD),
3070 # and blame will use worktree if there is one.
3071 set use_worktree 0
3072 if {$head eq {}} {
3073 load_current_branch
3074 set head $current_branch
3075 if {$subcommand eq {blame} && ![is_bare]} {
3076 if {![file isfile $path]} {
3077 show_parse_err [mc "fatal: no such file '%s' in worktree" $path]
3078 }
3079 set use_worktree 1
3080 }
3081 } else {
3082 if {[catch {
3083 set commitid \
3084 [git rev-parse --verify --end-of-options \
3085 [strcat $head "^{commit}"]]
3086 }]} {
3087 show_parse_err [mc "fatal: '%s' is not a valid rev'" $head]
3088 } else {
3089 set current_branch $head
3090 }
3091 }
3092
3093 # check path is known in head, and is file / directory as required
3094 set pathtype {}
3095 catch {set pathtype [git ls-tree {--format=%(objecttype)} $head $path]}
3096 if {$pathtype ne {} && $path eq {.}} {
3097 # ls-tree gives contents of root-dir, we need root-dir itself
3098 set pathtype {tree}
3099 }
3100
3101 if {$pathtype ne $required_pathtype} {
3102 switch -- $required_pathtype {
3103 tree {show_parse_err \
3104 [mc "'%s' is not a directory in rev '%s'" $path $head]}
3105 blob {show_parse_err \
3106 [mc "'%s' is not a filename in rev '%s'" $path $head]}
3107 }
3108 }
3109
3110 wm deiconify .
3111 switch -- $subcommand {
3112 browser {
3113 browser::new $head $path
3114 }
3115 blame {
3116 blame::new [expr {$use_worktree ? {} : $head}] $path $jump_spec
3117 }
3118 }
3119 return
3120 }
3121 citool -
3122 gui -
3123 pick {
3124 if {[llength $argv] != 0} {
3125 usage
3126 }
3127 # fall through to setup UI for commits
3128 }
3129 default {
3130 set err "[mc usage:] $argv0 \[{blame|browser|citool|gui|pick}\]"
3131 if {[tk windowingsystem] eq "win32"} {
3132 wm withdraw .
3133 tk_messageBox -icon error -message $err \
3134 -title [mc "Usage"]
3135 } else {
3136 puts stderr $err
3137 }
3138 exit 1
3139 }
3140 }
3141
3142 # -- Branch Control
3143 #
3144 ttk::frame .branch
3145 ttk::label .branch.l1 \
3146 -text [mc "Current Branch:"] \
3147 -anchor w \
3148 -justify left
3149 ttk::label .branch.cb \
3150 -textvariable current_branch \
3151 -anchor w \
3152 -justify left
3153 pack .branch.l1 -side left
3154 pack .branch.cb -side left -fill x
3155 pack .branch -side top -fill x
3156
3157 # -- Main Window Layout
3158 #
3159 ttk::panedwindow .vpane -orient horizontal
3160 ttk::panedwindow .vpane.files -orient vertical
3161 .vpane add .vpane.files
3162 pack .vpane -anchor n -side top -fill both -expand 1
3163
3164 # -- Working Directory File List
3165
3166 textframe .vpane.files.workdir -height 100 -width 200
3167 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3168 -background lightsalmon -foreground black
3169 ttext $ui_workdir \
3170 -borderwidth 0 \
3171 -width 20 -height 10 \
3172 -wrap none \
3173 -takefocus 1 -highlightthickness 1\
3174 -cursor $cursor_ptr \
3175 -xscrollcommand {.vpane.files.workdir.sx set} \
3176 -yscrollcommand {.vpane.files.workdir.sy set} \
3177 -state disabled
3178 ttk::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3179 ttk::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3180 pack .vpane.files.workdir.title -side top -fill x
3181 pack .vpane.files.workdir.sx -side bottom -fill x
3182 pack .vpane.files.workdir.sy -side right -fill y
3183 pack $ui_workdir -side left -fill both -expand 1
3184
3185 # -- Index File List
3186 #
3187 textframe .vpane.files.index -height 100 -width 200
3188 tlabel .vpane.files.index.title \
3189 -text [mc "Staged Changes (Will Commit)"] \
3190 -background lightgreen -foreground black
3191 ttext $ui_index \
3192 -borderwidth 0 \
3193 -width 20 -height 10 \
3194 -wrap none \
3195 -takefocus 1 -highlightthickness 1\
3196 -cursor $cursor_ptr \
3197 -xscrollcommand {.vpane.files.index.sx set} \
3198 -yscrollcommand {.vpane.files.index.sy set} \
3199 -state disabled
3200 ttk::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3201 ttk::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3202 pack .vpane.files.index.title -side top -fill x
3203 pack .vpane.files.index.sx -side bottom -fill x
3204 pack .vpane.files.index.sy -side right -fill y
3205 pack $ui_index -side left -fill both -expand 1
3206
3207 # -- Insert the workdir and index into the panes
3208 #
3209 .vpane.files add .vpane.files.workdir
3210 .vpane.files add .vpane.files.index
3211
3212 proc set_selection_colors {w has_focus} {
3213 foreach tag [list in_diff in_sel] {
3214 $w tag conf $tag \
3215 -background [expr {$has_focus ? $color::select_bg : $color::inactive_select_bg}] \
3216 -foreground [expr {$has_focus ? $color::select_fg : $color::inactive_select_fg}]
3217 }
3218 }
3219
3220 foreach i [list $ui_index $ui_workdir] {
3221 rmsel_tag $i
3222
3223 set_selection_colors $i 0
3224 bind $i <FocusIn> { set_selection_colors %W 1 }
3225 bind $i <FocusOut> { set_selection_colors %W 0 }
3226 }
3227 unset i
3228
3229 # -- Diff and Commit Area
3230 #
3231 ttk::panedwindow .vpane.lower -orient vertical
3232 ttk::frame .vpane.lower.commarea
3233 ttk::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3234 .vpane.lower add .vpane.lower.diff
3235 .vpane.lower add .vpane.lower.commarea
3236 .vpane add .vpane.lower
3237 .vpane.lower pane .vpane.lower.diff -weight 1
3238 .vpane.lower pane .vpane.lower.commarea -weight 0
3239
3240 # -- Commit Area Buttons
3241 #
3242 ttk::frame .vpane.lower.commarea.buttons
3243 ttk::label .vpane.lower.commarea.buttons.l -text {} \
3244 -anchor w \
3245 -justify left
3246 pack .vpane.lower.commarea.buttons.l -side top -fill x
3247 pack .vpane.lower.commarea.buttons -side left -fill y
3248
3249 ttk::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3250 -command ui_do_rescan
3251 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3252 lappend disable_on_lock \
3253 {.vpane.lower.commarea.buttons.rescan conf -state}
3254
3255 ttk::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3256 -command do_add_all
3257 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3258 lappend disable_on_lock \
3259 {.vpane.lower.commarea.buttons.incall conf -state}
3260
3261 if {![is_enabled nocommitmsg]} {
3262 ttk::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3263 -command do_signoff
3264 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3265 }
3266
3267 ttk::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3268 -command do_commit
3269 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3270 lappend disable_on_lock \
3271 {.vpane.lower.commarea.buttons.commit conf -state}
3272
3273 if {![is_enabled nocommit]} {
3274 ttk::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3275 -command do_push_anywhere
3276 pack .vpane.lower.commarea.buttons.push -side top -fill x
3277 }
3278
3279 # -- Commit Message Buffer
3280 #
3281 ttk::frame .vpane.lower.commarea.buffer
3282 ttk::frame .vpane.lower.commarea.buffer.header
3283 set ui_comm .vpane.lower.commarea.buffer.frame.t
3284 set ui_coml .vpane.lower.commarea.buffer.header.l
3285
3286 if {![is_enabled nocommit]} {
3287 ttk::checkbutton .vpane.lower.commarea.buffer.header.amend \
3288 -text [mc "Amend Last Commit"] \
3289 -variable commit_type_is_amend \
3290 -command do_select_commit_type
3291 lappend disable_on_lock \
3292 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3293 }
3294
3295 ttk::label $ui_coml \
3296 -anchor w \
3297 -justify left
3298 proc trace_commit_type {varname args} {
3299 global ui_coml commit_type
3300 switch -glob -- $commit_type {
3301 initial {set txt [mc "Initial Commit Message:"]}
3302 amend {set txt [mc "Amended Commit Message:"]}
3303 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3304 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3305 merge {set txt [mc "Merge Commit Message:"]}
3306 * {set txt [mc "Commit Message:"]}
3307 }
3308 $ui_coml conf -text $txt
3309 }
3310 trace add variable commit_type write trace_commit_type
3311 pack $ui_coml -side left -fill x
3312
3313 if {![is_enabled nocommit]} {
3314 pack .vpane.lower.commarea.buffer.header.amend -side right
3315 }
3316
3317 textframe .vpane.lower.commarea.buffer.frame
3318 ttext $ui_comm \
3319 -borderwidth 1 \
3320 -undo true \
3321 -maxundo 20 \
3322 -autoseparators true \
3323 -takefocus 1 \
3324 -highlightthickness 1 \
3325 -relief sunken \
3326 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3327 -font font_diff \
3328 -xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \
3329 -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set}
3330 ttk::scrollbar .vpane.lower.commarea.buffer.frame.sbx \
3331 -orient horizontal \
3332 -command [list $ui_comm xview]
3333 ttk::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3334 -orient vertical \
3335 -command [list $ui_comm yview]
3336
3337 pack .vpane.lower.commarea.buffer.frame.sbx -side bottom -fill x
3338 pack .vpane.lower.commarea.buffer.frame.sby -side right -fill y
3339 pack $ui_comm -side left -fill y
3340 pack .vpane.lower.commarea.buffer.header -side top -fill x
3341 pack .vpane.lower.commarea.buffer.frame -side left -fill y
3342 pack .vpane.lower.commarea.buffer -side left -fill y
3343
3344 # -- Commit Message Buffer Context Menu
3345 #
3346 set ctxm .vpane.lower.commarea.buffer.ctxm
3347 menu $ctxm -tearoff 0
3348 $ctxm add command \
3349 -label [mc Cut] \
3350 -command {tk_textCut $ui_comm}
3351 $ctxm add command \
3352 -label [mc Copy] \
3353 -command {tk_textCopy $ui_comm}
3354 $ctxm add command \
3355 -label [mc Paste] \
3356 -command {tk_textPaste $ui_comm}
3357 $ctxm add command \
3358 -label [mc Delete] \
3359 -command {catch {$ui_comm delete sel.first sel.last}}
3360 $ctxm add separator
3361 $ctxm add command \
3362 -label [mc "Select All"] \
3363 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3364 $ctxm add command \
3365 -label [mc "Copy All"] \
3366 -command {
3367 $ui_comm tag add sel 0.0 end
3368 tk_textCopy $ui_comm
3369 $ui_comm tag remove sel 0.0 end
3370 }
3371 $ctxm add separator
3372 $ctxm add command \
3373 -label [mc "Sign Off"] \
3374 -command do_signoff
3375 set ui_comm_ctxm $ctxm
3376
3377 # -- Diff Header
3378 #
3379 proc trace_current_diff_path {varname args} {
3380 global current_diff_path diff_actions file_states
3381 if {$current_diff_path eq {}} {
3382 set s {}
3383 set f {}
3384 set p {}
3385 set o disabled
3386 } else {
3387 set p $current_diff_path
3388 set s [mapdesc [lindex $file_states($p) 0] $p]
3389 set f [mc "File:"]
3390 set p [escape_path $p]
3391 set o normal
3392 }
3393
3394 .vpane.lower.diff.header.status configure -text $s
3395 .vpane.lower.diff.header.file configure -text $f
3396 .vpane.lower.diff.header.path configure -text $p
3397 foreach w $diff_actions {
3398 uplevel #0 $w $o
3399 }
3400 }
3401 trace add variable current_diff_path write trace_current_diff_path
3402
3403 gold_frame .vpane.lower.diff.header
3404 tlabel .vpane.lower.diff.header.status \
3405 -background gold \
3406 -foreground black \
3407 -width $max_status_desc \
3408 -anchor w \
3409 -justify left
3410 tlabel .vpane.lower.diff.header.file \
3411 -background gold \
3412 -foreground black \
3413 -anchor w \
3414 -justify left
3415 tlabel .vpane.lower.diff.header.path \
3416 -background gold \
3417 -foreground blue \
3418 -anchor w \
3419 -justify left \
3420 -font [eval font create [font configure font_ui] -underline 1] \
3421 -cursor hand2
3422 pack .vpane.lower.diff.header.status -side left
3423 pack .vpane.lower.diff.header.file -side left
3424 pack .vpane.lower.diff.header.path -fill x
3425 set ctxm .vpane.lower.diff.header.ctxm
3426 menu $ctxm -tearoff 0
3427 $ctxm add command \
3428 -label [mc Copy] \
3429 -command {
3430 clipboard clear
3431 clipboard append \
3432 -format STRING \
3433 -type STRING \
3434 -- $current_diff_path
3435 }
3436 $ctxm add command \
3437 -label [mc Open] \
3438 -command {do_file_open $current_diff_path}
3439 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3440 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3441 bind .vpane.lower.diff.header.path <Button-1> {do_file_open $current_diff_path}
3442
3443 # -- Diff Body
3444 #
3445 textframe .vpane.lower.diff.body
3446 set ui_diff .vpane.lower.diff.body.t
3447 ttext $ui_diff \
3448 -borderwidth 0 \
3449 -width 80 -height 5 -wrap none \
3450 -font font_diff \
3451 -takefocus 1 -highlightthickness 1 \
3452 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3453 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3454 -state disabled
3455 catch {$ui_diff configure -tabstyle wordprocessor}
3456 ttk::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3457 -command [list $ui_diff xview]
3458 ttk::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3459 -command [list $ui_diff yview]
3460 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3461 pack .vpane.lower.diff.body.sby -side right -fill y
3462 pack $ui_diff -side left -fill both -expand 1
3463 pack .vpane.lower.diff.header -side top -fill x
3464 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3465
3466 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3467 $ui_diff tag configure clr4$n -background $c
3468 $ui_diff tag configure clri4$n -foreground $c
3469 $ui_diff tag configure clr3$n -foreground $c
3470 $ui_diff tag configure clri3$n -background $c
3471 }
3472 $ui_diff tag configure clr1 -font font_diffbold
3473 $ui_diff tag configure clr4 -underline 1
3474
3475 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3476 $ui_diff tag conf d_rescan -foreground blue -underline 1 -font font_diffbold
3477 $ui_diff tag bind d_rescan <Button-1> { clear_diff; rescan ui_ready 0 }
3478
3479 $ui_diff tag conf d_cr -elide true
3480 $ui_diff tag conf d_@ -font font_diffbold
3481 $ui_diff tag conf d_+ -foreground {#00a000}
3482 $ui_diff tag conf d_- -foreground red
3483
3484 $ui_diff tag conf d_++ -foreground {#00a000}
3485 $ui_diff tag conf d_-- -foreground red
3486 $ui_diff tag conf d_+s \
3487 -foreground {#00a000} \
3488 -background {#e2effa}
3489 $ui_diff tag conf d_-s \
3490 -foreground red \
3491 -background {#e2effa}
3492 $ui_diff tag conf d_s+ \
3493 -foreground {#00a000} \
3494 -background ivory1
3495 $ui_diff tag conf d_s- \
3496 -foreground red \
3497 -background ivory1
3498
3499 $ui_diff tag conf d< \
3500 -foreground orange \
3501 -font font_diffbold
3502 $ui_diff tag conf d| \
3503 -foreground orange \
3504 -font font_diffbold
3505 $ui_diff tag conf d= \
3506 -foreground orange \
3507 -font font_diffbold
3508 $ui_diff tag conf d> \
3509 -foreground orange \
3510 -font font_diffbold
3511
3512 $ui_diff tag raise sel
3513
3514 # -- Diff Body Context Menu
3515 #
3516
3517 proc create_common_diff_popup {ctxm} {
3518 $ctxm add command \
3519 -label [mc Refresh] \
3520 -command reshow_diff
3521 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3522 $ctxm add command \
3523 -label [mc Copy] \
3524 -command {tk_textCopy $ui_diff}
3525 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3526 $ctxm add command \
3527 -label [mc "Select All"] \
3528 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3529 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3530 $ctxm add command \
3531 -label [mc "Copy All"] \
3532 -command {
3533 $ui_diff tag add sel 0.0 end
3534 tk_textCopy $ui_diff
3535 $ui_diff tag remove sel 0.0 end
3536 }
3537 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3538 $ctxm add separator
3539 $ctxm add command \
3540 -label [mc "Decrease Font Size"] \
3541 -command {incr_font_size font_diff -1}
3542 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3543 $ctxm add command \
3544 -label [mc "Increase Font Size"] \
3545 -command {incr_font_size font_diff 1}
3546 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3547 $ctxm add separator
3548 set emenu $ctxm.enc
3549 menu $emenu
3550 build_encoding_menu $emenu [list force_diff_encoding]
3551 $ctxm add cascade \
3552 -label [mc "Encoding"] \
3553 -menu $emenu
3554 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3555 $ctxm add separator
3556 $ctxm add command -label [mc "Options..."] \
3557 -command do_options
3558 }
3559
3560 set ctxm .vpane.lower.diff.body.ctxm
3561 menu $ctxm -tearoff 0
3562 $ctxm add command \
3563 -label [mc "Apply/Reverse Hunk"] \
3564 -command {apply_or_revert_hunk $cursorX $cursorY 0}
3565 set ui_diff_applyhunk [$ctxm index last]
3566 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3567 $ctxm add command \
3568 -label [mc "Apply/Reverse Line"] \
3569 -command {apply_or_revert_range_or_line $cursorX $cursorY 0; do_rescan}
3570 set ui_diff_applyline [$ctxm index last]
3571 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3572 $ctxm add separator
3573 $ctxm add command \
3574 -label [mc "Revert Hunk"] \
3575 -command {apply_or_revert_hunk $cursorX $cursorY 1}
3576 set ui_diff_reverthunk [$ctxm index last]
3577 lappend diff_actions [list $ctxm entryconf $ui_diff_reverthunk -state]
3578 $ctxm add command \
3579 -label [mc "Revert Line"] \
3580 -command {apply_or_revert_range_or_line $cursorX $cursorY 1; do_rescan}
3581 set ui_diff_revertline [$ctxm index last]
3582 lappend diff_actions [list $ctxm entryconf $ui_diff_revertline -state]
3583 $ctxm add command \
3584 -label [mc "Undo Last Revert"] \
3585 -command {undo_last_revert; do_rescan}
3586 set ui_diff_undorevert [$ctxm index last]
3587 lappend diff_actions [list $ctxm entryconf $ui_diff_undorevert -state]
3588 $ctxm add separator
3589 $ctxm add command \
3590 -label [mc "Show Less Context"] \
3591 -command show_less_context
3592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3593 $ctxm add command \
3594 -label [mc "Show More Context"] \
3595 -command show_more_context
3596 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3597 $ctxm add separator
3598 create_common_diff_popup $ctxm
3599
3600 set ctxmmg .vpane.lower.diff.body.ctxmmg
3601 menu $ctxmmg -tearoff 0
3602 $ctxmmg add command \
3603 -label [mc "Run Merge Tool"] \
3604 -command {merge_resolve_tool}
3605 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3606 $ctxmmg add separator
3607 $ctxmmg add command \
3608 -label [mc "Use Remote Version"] \
3609 -command {merge_resolve_one 3}
3610 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3611 $ctxmmg add command \
3612 -label [mc "Use Local Version"] \
3613 -command {merge_resolve_one 2}
3614 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3615 $ctxmmg add command \
3616 -label [mc "Revert To Base"] \
3617 -command {merge_resolve_one 1}
3618 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3619 $ctxmmg add separator
3620 $ctxmmg add command \
3621 -label [mc "Show Less Context"] \
3622 -command show_less_context
3623 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3624 $ctxmmg add command \
3625 -label [mc "Show More Context"] \
3626 -command show_more_context
3627 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3628 $ctxmmg add separator
3629 create_common_diff_popup $ctxmmg
3630
3631 set ctxmsm .vpane.lower.diff.body.ctxmsm
3632 menu $ctxmsm -tearoff 0
3633 $ctxmsm add command \
3634 -label [mc "Visualize These Changes In The Submodule"] \
3635 -command {do_gitk -- true}
3636 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3637 $ctxmsm add command \
3638 -label [mc "Visualize Current Branch History In The Submodule"] \
3639 -command {do_gitk {} true}
3640 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3641 $ctxmsm add command \
3642 -label [mc "Visualize All Branch History In The Submodule"] \
3643 -command {do_gitk --all true}
3644 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3645 $ctxmsm add separator
3646 $ctxmsm add command \
3647 -label [mc "Start git gui In The Submodule"] \
3648 -command {do_git_gui}
3649 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3650 $ctxmsm add separator
3651 create_common_diff_popup $ctxmsm
3652
3653 proc has_textconv {path} {
3654 if {[is_config_false gui.textconv]} {
3655 return 0
3656 }
3657 set filter [gitattr $path diff set]
3658 set textconv [get_config [join [list diff $filter textconv] .]]
3659 if {$filter ne {set} && $textconv ne {}} {
3660 return 1
3661 } else {
3662 return 0
3663 }
3664 }
3665
3666 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3667 global current_diff_path file_states last_revert
3668 set ::cursorX $x
3669 set ::cursorY $y
3670 if {[info exists file_states($current_diff_path)]} {
3671 set state [lindex $file_states($current_diff_path) 0]
3672 } else {
3673 set state {__}
3674 }
3675 if {[string first {U} $state] >= 0} {
3676 tk_popup $ctxmmg $X $Y
3677 } elseif {$::is_submodule_diff} {
3678 tk_popup $ctxmsm $X $Y
3679 } else {
3680 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3681 set u [mc "Undo Last Revert"]
3682 if {$::ui_index eq $::current_diff_side} {
3683 set l [mc "Unstage Hunk From Commit"]
3684 set h [mc "Revert Hunk"]
3685
3686 if {$has_range} {
3687 set t [mc "Unstage Lines From Commit"]
3688 set r [mc "Revert Lines"]
3689 } else {
3690 set t [mc "Unstage Line From Commit"]
3691 set r [mc "Revert Line"]
3692 }
3693 } else {
3694 set l [mc "Stage Hunk For Commit"]
3695 set h [mc "Revert Hunk"]
3696
3697 if {$has_range} {
3698 set t [mc "Stage Lines For Commit"]
3699 set r [mc "Revert Lines"]
3700 } else {
3701 set t [mc "Stage Line For Commit"]
3702 set r [mc "Revert Line"]
3703 }
3704 }
3705 if {$::is_3way_diff
3706 || $current_diff_path eq {}
3707 || {__} eq $state
3708 || {_O} eq $state
3709 || [string match {?T} $state]
3710 || [string match {T?} $state]
3711 || [has_textconv $current_diff_path]} {
3712 set s disabled
3713 set revert_state disabled
3714 } else {
3715 set s normal
3716
3717 # Only allow reverting changes in the working tree. If
3718 # the user wants to revert changes in the index, they
3719 # need to unstage those first.
3720 if {$::ui_workdir eq $::current_diff_side} {
3721 set revert_state normal
3722 } else {
3723 set revert_state disabled
3724 }
3725 }
3726
3727 if {$last_revert eq {}} {
3728 set undo_state disabled
3729 } else {
3730 set undo_state normal
3731 }
3732
3733 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3734 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3735 $ctxm entryconf $::ui_diff_revertline -state $revert_state \
3736 -label $r
3737 $ctxm entryconf $::ui_diff_reverthunk -state $revert_state \
3738 -label $h
3739 $ctxm entryconf $::ui_diff_undorevert -state $undo_state \
3740 -label $u
3741
3742 tk_popup $ctxm $X $Y
3743 }
3744 }
3745 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3746
3747 # -- Status Bar
3748 #
3749 set main_status [::status_bar::new .status]
3750 pack .status -anchor w -side bottom -fill x
3751 $main_status show [mc "Initializing..."]
3752
3753 # -- Load geometry
3754 #
3755 proc on_ttk_pane_mapped {w pane pos} {
3756 bind $w <Map> {}
3757 after 0 [list after idle [list $w sashpos $pane $pos]]
3758 }
3759 proc on_application_mapped {} {
3760 global repo_config
3761 bind . <Map> {}
3762 set gm $repo_config(gui.geometry)
3763 bind .vpane <Map> \
3764 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3765 bind .vpane.files <Map> \
3766 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3767 wm geometry . [lindex $gm 0]
3768 }
3769 if {[info exists repo_config(gui.geometry)]} {
3770 bind . <Map> [list on_application_mapped]
3771 wm geometry . [lindex $repo_config(gui.geometry) 0]
3772 }
3773
3774 # -- Load window state
3775 #
3776 if {[info exists repo_config(gui.wmstate)]} {
3777 catch {wm state . $repo_config(gui.wmstate)}
3778 }
3779
3780 # -- Key Bindings
3781 #
3782 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3783 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3784 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3785 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3786 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3787 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3788 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3789 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3790 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3791 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3792 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3793 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3794 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3795 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3796 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3797 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3798 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3799 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3800 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3801 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3802 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3803 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3804 bind $ui_comm <$M1B-Key-BackSpace> {event generate %W <Meta-Delete>;break}
3805 bind $ui_comm <$M1B-Key-Delete> {event generate %W <Meta-d>;break}
3806
3807 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3808 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3809 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3810 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3811 bind $ui_diff <$M1B-Key-v> {break}
3812 bind $ui_diff <$M1B-Key-V> {break}
3813 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3814 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3815 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3816 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3817 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3818 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3819 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3820 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3821 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3822 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3823 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3824 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3825 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3826 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3827 bind $ui_diff <Button-1> {focus %W}
3828
3829 if {[is_enabled branch]} {
3830 bind . <$M1B-Key-n> branch_create::dialog
3831 bind . <$M1B-Key-N> branch_create::dialog
3832 bind . <$M1B-Key-o> branch_checkout::dialog
3833 bind . <$M1B-Key-O> branch_checkout::dialog
3834 bind . <$M1B-Key-m> merge::dialog
3835 bind . <$M1B-Key-M> merge::dialog
3836 }
3837 if {[is_enabled transport]} {
3838 bind . <$M1B-Key-p> do_push_anywhere
3839 bind . <$M1B-Key-P> do_push_anywhere
3840 }
3841
3842 bind . <Key-F5> ui_do_rescan
3843 bind . <$M1B-Key-r> ui_do_rescan
3844 bind . <$M1B-Key-R> ui_do_rescan
3845 bind . <$M1B-Key-s> do_signoff
3846 bind . <$M1B-Key-S> do_signoff
3847 bind . <$M1B-Key-t> { toggle_or_diff toggle %W }
3848 bind . <$M1B-Key-T> { toggle_or_diff toggle %W }
3849 bind . <$M1B-Key-u> { toggle_or_diff toggle %W }
3850 bind . <$M1B-Key-U> { toggle_or_diff toggle %W }
3851 bind . <$M1B-Key-j> do_revert_selection
3852 bind . <$M1B-Key-J> do_revert_selection
3853 bind . <$M1B-Key-i> do_add_all
3854 bind . <$M1B-Key-I> do_add_all
3855 bind . <$M1B-Key-e> toggle_commit_type
3856 bind . <$M1B-Key-E> toggle_commit_type
3857 bind . <$M1B-Key-minus> {show_less_context;break}
3858 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3859 bind . <$M1B-Key-equal> {show_more_context;break}
3860 bind . <$M1B-Key-plus> {show_more_context;break}
3861 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3862 bind . <$M1B-Key-Return> do_commit
3863 bind . <$M1B-Key-KP_Enter> do_commit
3864 foreach i [list $ui_index $ui_workdir] {
3865 bind $i <Button-1> { toggle_or_diff click %W %x %y; break }
3866 bind $i <$M1B-Button-1> { add_one_to_selection %W %x %y; break }
3867 bind $i <Shift-Button-1> { add_range_to_selection %W %x %y; break }
3868 bind $i <Key-Up> { toggle_or_diff up %W; break }
3869 bind $i <Key-Down> { toggle_or_diff down %W; break }
3870 }
3871 unset i
3872
3873 bind . <Alt-Key-1> {focus_widget $::ui_workdir}
3874 bind . <Alt-Key-2> {focus_widget $::ui_index}
3875 bind . <Alt-Key-3> {focus $::ui_diff}
3876 bind . <Alt-Key-4> {focus $::ui_comm}
3877
3878 set file_lists_last_clicked($ui_index) {}
3879 set file_lists_last_clicked($ui_workdir) {}
3880
3881 set file_lists($ui_index) [list]
3882 set file_lists($ui_workdir) [list]
3883
3884 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3885 focus -force $ui_comm
3886
3887 # -- Only initialize complex UI if we are going to stay running.
3888 #
3889 if {[is_enabled transport]} {
3890 load_all_remotes
3891
3892 set n [.mbar.remote index end]
3893 populate_remotes_menu
3894 set n [expr {[.mbar.remote index end] - $n}]
3895 if {$n > 0} {
3896 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3897 .mbar.remote insert $n separator
3898 }
3899 unset n
3900 }
3901
3902 if {[winfo exists $ui_comm]} {
3903 set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
3904
3905 # -- If both our backup and message files exist use the
3906 # newer of the two files to initialize the buffer.
3907 #
3908 if {$GITGUI_BCK_exists} {
3909 set m [gitdir GITGUI_MSG]
3910 if {[file isfile $m]} {
3911 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3912 catch {file delete [gitdir GITGUI_MSG]}
3913 } else {
3914 $ui_comm delete 0.0 end
3915 $ui_comm edit reset
3916 $ui_comm edit modified false
3917 catch {file delete [gitdir GITGUI_BCK]}
3918 set GITGUI_BCK_exists 0
3919 }
3920 }
3921 unset m
3922 }
3923
3924 proc backup_commit_buffer {} {
3925 global ui_comm GITGUI_BCK_exists
3926
3927 set m [$ui_comm edit modified]
3928 if {$m || $GITGUI_BCK_exists} {
3929 set msg [string trim [$ui_comm get 0.0 end]]
3930 regsub -all -line {[ \r\t]+$} $msg {} msg
3931
3932 if {$msg eq {}} {
3933 if {$GITGUI_BCK_exists} {
3934 catch {file delete [gitdir GITGUI_BCK]}
3935 set GITGUI_BCK_exists 0
3936 }
3937 } elseif {$m} {
3938 catch {
3939 set fd [safe_open_file [gitdir GITGUI_BCK] w]
3940 fconfigure $fd -encoding utf-8
3941 puts -nonewline $fd $msg
3942 close $fd
3943 set GITGUI_BCK_exists 1
3944 }
3945 }
3946
3947 $ui_comm edit modified false
3948 }
3949
3950 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3951 }
3952
3953 backup_commit_buffer
3954
3955 # Grey out comment lines (which are stripped from the final commit message by
3956 # wash_commit_message).
3957 $ui_comm tag configure commit_comment -foreground gray
3958 proc dim_commit_comment_lines {} {
3959 global ui_comm comment_string
3960 $ui_comm tag remove commit_comment 1.0 end
3961 set text [$ui_comm get 1.0 end]
3962 # See also cmt_rx in wash_commit_message
3963 set cmt_rx [strcat {^} [regsub -all {\W} $comment_string {\\&}]]
3964 set ranges [regexp -all -indices -inline -line -- $cmt_rx $text]
3965 foreach pair $ranges {
3966 set idx "1.0 + [lindex $pair 0] chars"
3967 $ui_comm tag add commit_comment $idx "$idx lineend + 1 char"
3968 }
3969 }
3970 dim_commit_comment_lines
3971 bind $ui_comm <<Modified>> { after idle dim_commit_comment_lines }
3972
3973 # -- If the user has aspell available we can drive it
3974 # in pipe mode to spellcheck the commit message.
3975 #
3976 set spell_cmd [list |]
3977 set spell_dict [get_config gui.spellingdictionary]
3978 lappend spell_cmd aspell
3979 if {$spell_dict ne {}} {
3980 lappend spell_cmd --master=$spell_dict
3981 }
3982 lappend spell_cmd --mode=none
3983 lappend spell_cmd --encoding=utf-8
3984 lappend spell_cmd pipe
3985 if {$spell_dict eq {none}
3986 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3987 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3988 } else {
3989 set ui_comm_spell [spellcheck::init \
3990 $spell_fd \
3991 $ui_comm \
3992 $ui_comm_ctxm \
3993 ]
3994 }
3995 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3996 }
3997
3998 lock_index begin-read
3999 if {![winfo ismapped .]} {
4000 wm deiconify .
4001 }
4002 after 1 {
4003 if {[is_enabled initialamend]} {
4004 force_amend
4005 } else {
4006 do_rescan
4007 }
4008
4009 if {[is_enabled nocommitmsg]} {
4010 $ui_comm configure -state disabled -background gray
4011 }
4012 }
4013 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4014 after 1000 hint_gc
4015 }
4016 if {[is_enabled retcode]} {
4017 bind . <Destroy> {+terminate_me %W}
4018 }
4019 if {$picked && [is_config_true gui.autoexplore]} {
4020 do_explore
4021 }
4022
4023 # Clear "Initializing..." status
4024 after 500 {$main_status show ""}
4025
4026 # Local variables:
4027 # mode: tcl
4028 # indent-tabs-mode: t
4029 # tab-width: 4
4030 # End: