2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GITGUI_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
26 ######################################################################
30 set _appname
[lindex
[file split $argv0] end
]
46 return [eval [concat
[list
file join $_gitdir] $args]]
51 if {$_gitexec eq
{}} {
52 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
53 error
"Git not installed?\n\n$err"
59 return [eval [concat
[list
file join $_gitexec] $args]]
68 global tcl_platform tk_library
69 if {[tk windowingsystem
] eq
{aqua
}} {
77 if {$tcl_platform(platform
) eq
{windows
}} {
84 global tcl_platform _iscygwin
85 if {$_iscygwin eq
{}} {
86 if {$tcl_platform(platform
) eq
{windows
}} {
87 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
99 proc is_enabled
{option
} {
100 global enabled_options
101 if {[catch
{set on
$enabled_options($option)}]} {return 0}
105 proc enable_option
{option
} {
106 global enabled_options
107 set enabled_options
($option) 1
110 proc disable_option
{option
} {
111 global enabled_options
112 set enabled_options
($option) 0
115 ######################################################################
119 proc is_many_config
{name
} {
120 switch
-glob -- $name {
129 proc is_config_true
{name
} {
131 if {[catch
{set v
$repo_config($name)}]} {
133 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
140 proc load_config
{include_global
} {
141 global repo_config global_config default_config
143 array
unset global_config
144 if {$include_global} {
146 set fd_rc
[open
"| git config --global --list" r
]
147 while {[gets
$fd_rc line
] >= 0} {
148 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
149 if {[is_many_config
$name]} {
150 lappend global_config
($name) $value
152 set global_config
($name) $value
160 array
unset repo_config
162 set fd_rc
[open
"| git config --list" r
]
163 while {[gets
$fd_rc line
] >= 0} {
164 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
165 if {[is_many_config
$name]} {
166 lappend repo_config
($name) $value
168 set repo_config
($name) $value
175 foreach name
[array names default_config
] {
176 if {[catch
{set v
$global_config($name)}]} {
177 set global_config
($name) $default_config($name)
179 if {[catch
{set v
$repo_config($name)}]} {
180 set repo_config
($name) $default_config($name)
185 proc save_config
{} {
186 global default_config font_descs
187 global repo_config global_config
188 global repo_config_new global_config_new
190 foreach option
$font_descs {
191 set name
[lindex
$option 0]
192 set font
[lindex
$option 1]
193 font configure
$font \
194 -family $global_config_new(gui.
$font^^family
) \
195 -size $global_config_new(gui.
$font^^size
)
196 font configure
${font}bold \
197 -family $global_config_new(gui.
$font^^family
) \
198 -size $global_config_new(gui.
$font^^size
)
199 set global_config_new
(gui.
$name) [font configure
$font]
200 unset global_config_new
(gui.
$font^^family
)
201 unset global_config_new
(gui.
$font^^size
)
204 foreach name
[array names default_config
] {
205 set value
$global_config_new($name)
206 if {$value ne
$global_config($name)} {
207 if {$value eq
$default_config($name)} {
208 catch
{git config
--global --unset $name}
210 regsub
-all "\[{}\]" $value {"} value
211 git config --global $name $value
213 set global_config($name) $value
214 if {$value eq $repo_config($name)} {
215 catch {git config --unset $name}
216 set repo_config($name) $value
221 foreach name [array names default_config] {
222 set value $repo_config_new($name)
223 if {$value ne $repo_config($name)} {
224 if {$value eq $global_config($name)} {
225 catch {git config --unset $name}
227 regsub -all "\
[{}\
]" $value {"} value
228 git config
$name $value
230 set repo_config
($name) $value
235 ######################################################################
240 return [eval exec git
$args]
243 proc error_popup
{msg
} {
245 if {[reponame
] ne
{}} {
246 append title
" ([reponame])"
248 set cmd
[list tk_messageBox \
251 -title "$title: error" \
253 if {[winfo ismapped .
]} {
254 lappend cmd
-parent .
259 proc warn_popup
{msg
} {
261 if {[reponame
] ne
{}} {
262 append title
" ([reponame])"
264 set cmd
[list tk_messageBox \
267 -title "$title: warning" \
269 if {[winfo ismapped .
]} {
270 lappend cmd
-parent .
275 proc info_popup
{msg
{parent .
}} {
277 if {[reponame
] ne
{}} {
278 append title
" ([reponame])"
288 proc ask_popup
{msg
} {
290 if {[reponame
] ne
{}} {
291 append title
" ([reponame])"
293 return [tk_messageBox \
301 ######################################################################
308 if {[catch
{set v
[git
--version]} err
]} {
309 catch
{wm withdraw .
}
310 error_popup
"Cannot determine Git version:
314 [appname] requires Git $req_maj.$req_min or later."
317 if {[regexp
{^git version
(\d
+)\.
(\d
+)} $v _junk act_maj act_min
]} {
318 if {$act_maj < $req_maj
319 ||
($act_maj == $req_maj && $act_min < $req_min)} {
320 catch
{wm withdraw .
}
321 error_popup
"[appname] requires Git $req_maj.$req_min or later.
327 catch
{wm withdraw .
}
328 error_popup
"Cannot parse Git version string:\n\n$v"
331 unset -nocomplain v _junk act_maj act_min req_maj req_min
333 ######################################################################
337 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
338 && [catch
{set _gitdir
[git rev-parse
--git-dir]} err
]} {
339 catch
{wm withdraw .
}
340 error_popup
"Cannot find the git directory:\n\n$err"
343 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
344 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
346 if {![file isdirectory
$_gitdir]} {
347 catch
{wm withdraw .
}
348 error_popup
"Git directory not found:\n\n$_gitdir"
351 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
352 catch
{wm withdraw .
}
353 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
356 if {[catch
{cd [file dirname $_gitdir]} err
]} {
357 catch
{wm withdraw .
}
358 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
361 set _reponame
[lindex
[file split \
362 [file normalize
[file dirname $_gitdir]]] \
365 ######################################################################
369 set current_diff_path
{}
370 set current_diff_side
{}
371 set diff_actions
[list
]
372 set ui_status_value
{Initializing...
}
376 set MERGE_HEAD
[list
]
379 set current_branch
{}
380 set current_diff_path
{}
381 set selected_commit_type new
383 ######################################################################
391 set disable_on_lock
[list
]
392 set index_lock_type none
394 proc lock_index
{type} {
395 global index_lock_type disable_on_lock
397 if {$index_lock_type eq
{none
}} {
398 set index_lock_type
$type
399 foreach w
$disable_on_lock {
400 uplevel
#0 $w disabled
403 } elseif
{$index_lock_type eq
"begin-$type"} {
404 set index_lock_type
$type
410 proc unlock_index
{} {
411 global index_lock_type disable_on_lock
413 set index_lock_type none
414 foreach w
$disable_on_lock {
419 ######################################################################
423 proc repository_state
{ctvar hdvar mhvar
} {
424 global current_branch
425 upvar
$ctvar ct
$hdvar hd
$mhvar mh
429 if {[catch
{set current_branch
[git symbolic-ref HEAD
]}]} {
430 set current_branch
{}
432 regsub ^refs
/((heads|tags|remotes
)/)? \
438 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
444 set merge_head
[gitdir MERGE_HEAD
]
445 if {[file exists
$merge_head]} {
447 set fd_mh
[open
$merge_head r
]
448 while {[gets
$fd_mh line
] >= 0} {
459 global PARENT empty_tree
461 set p
[lindex
$PARENT 0]
465 if {$empty_tree eq
{}} {
466 set empty_tree
[git mktree
<< {}]
471 proc rescan
{after
{honor_trustmtime
1}} {
472 global HEAD PARENT MERGE_HEAD commit_type
473 global ui_index ui_workdir ui_status_value ui_comm
474 global rescan_active file_states
477 if {$rescan_active > 0 ||
![lock_index
read]} return
479 repository_state newType newHEAD newMERGE_HEAD
480 if {[string match amend
* $commit_type]
481 && $newType eq
{normal
}
482 && $newHEAD eq
$HEAD} {
486 set MERGE_HEAD
$newMERGE_HEAD
487 set commit_type
$newType
490 array
unset file_states
492 if {![$ui_comm edit modified
]
493 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
494 if {[load_message GITGUI_MSG
]} {
495 } elseif
{[load_message MERGE_MSG
]} {
496 } elseif
{[load_message SQUASH_MSG
]} {
499 $ui_comm edit modified false
502 if {[is_enabled branch
]} {
507 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
508 rescan_stage2
{} $after
511 set ui_status_value
{Refreshing
file status...
}
512 set cmd
[list git update-index
]
514 lappend cmd
--unmerged
515 lappend cmd
--ignore-missing
516 lappend cmd
--refresh
517 set fd_rf
[open
"| $cmd" r
]
518 fconfigure
$fd_rf -blocking 0 -translation binary
519 fileevent
$fd_rf readable \
520 [list rescan_stage2
$fd_rf $after]
524 proc rescan_stage2
{fd after
} {
525 global ui_status_value
526 global rescan_active buf_rdi buf_rdf buf_rlo
530 if {![eof
$fd]} return
534 set ls_others
[list | git ls-files
--others -z \
535 --exclude-per-directory=.gitignore
]
536 set info_exclude
[gitdir info exclude
]
537 if {[file readable
$info_exclude]} {
538 lappend ls_others
"--exclude-from=$info_exclude"
546 set ui_status_value
{Scanning
for modified files ...
}
547 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
548 set fd_df
[open
"| git diff-files -z" r
]
549 set fd_lo
[open
$ls_others r
]
551 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
552 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
553 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
554 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
555 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
556 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
559 proc load_message
{file} {
563 if {[file isfile
$f]} {
564 if {[catch
{set fd
[open
$f r
]}]} {
567 set content
[string trim
[read $fd]]
569 regsub
-all -line {[ \r\t]+$
} $content {} content
570 $ui_comm delete
0.0 end
571 $ui_comm insert end
$content
577 proc read_diff_index
{fd after
} {
580 append buf_rdi
[read $fd]
582 set n
[string length
$buf_rdi]
584 set z1
[string first
"\0" $buf_rdi $c]
587 set z2
[string first
"\0" $buf_rdi $z1]
591 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
592 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
594 [encoding convertfrom
$p] \
596 [list
[lindex
$i 0] [lindex
$i 2]] \
602 set buf_rdi
[string range
$buf_rdi $c end
]
607 rescan_done
$fd buf_rdi
$after
610 proc read_diff_files
{fd after
} {
613 append buf_rdf
[read $fd]
615 set n
[string length
$buf_rdf]
617 set z1
[string first
"\0" $buf_rdf $c]
620 set z2
[string first
"\0" $buf_rdf $z1]
624 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
625 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
627 [encoding convertfrom
$p] \
630 [list
[lindex
$i 0] [lindex
$i 2]]
635 set buf_rdf
[string range
$buf_rdf $c end
]
640 rescan_done
$fd buf_rdf
$after
643 proc read_ls_others
{fd after
} {
646 append buf_rlo
[read $fd]
647 set pck
[split $buf_rlo "\0"]
648 set buf_rlo
[lindex
$pck end
]
649 foreach p
[lrange
$pck 0 end-1
] {
650 merge_state
[encoding convertfrom
$p] ?O
652 rescan_done
$fd buf_rlo
$after
655 proc rescan_done
{fd buf after
} {
657 global file_states repo_config
660 if {![eof
$fd]} return
663 if {[incr rescan_active
-1] > 0} return
672 proc prune_selection
{} {
673 global file_states selected_paths
675 foreach path
[array names selected_paths
] {
676 if {[catch
{set still_here
$file_states($path)}]} {
677 unset selected_paths
($path)
682 ######################################################################
687 global ui_diff current_diff_path current_diff_header
688 global ui_index ui_workdir
690 $ui_diff conf
-state normal
691 $ui_diff delete
0.0 end
692 $ui_diff conf
-state disabled
694 set current_diff_path
{}
695 set current_diff_header
{}
697 $ui_index tag remove in_diff
0.0 end
698 $ui_workdir tag remove in_diff
0.0 end
701 proc reshow_diff
{} {
702 global ui_status_value file_states file_lists
703 global current_diff_path current_diff_side
705 set p
$current_diff_path
707 # No diff is being shown.
708 } elseif
{$current_diff_side eq
{}
709 ||
[catch
{set s
$file_states($p)}]
710 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
713 show_diff
$p $current_diff_side
717 proc handle_empty_diff
{} {
718 global current_diff_path file_states file_lists
720 set path
$current_diff_path
721 set s
$file_states($path)
722 if {[lindex
$s 0] ne
{_M
}} return
724 info_popup
"No differences detected.
726 [short_path $path] has no changes.
728 The modification date of this file was updated
729 by another application, but the content within
730 the file was not changed.
732 A rescan will be automatically started to find
733 other files which may have the same state."
736 display_file
$path __
737 rescan
{set ui_status_value
{Ready.
}} 0
740 proc show_diff
{path w
{lno
{}}} {
741 global file_states file_lists
742 global is_3way_diff diff_active repo_config
743 global ui_diff ui_status_value ui_index ui_workdir
744 global current_diff_path current_diff_side current_diff_header
746 if {$diff_active ||
![lock_index
read]} return
750 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
756 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
759 set s
$file_states($path)
763 set current_diff_path
$path
764 set current_diff_side
$w
765 set current_diff_header
{}
766 set ui_status_value
"Loading diff of [escape_path $path]..."
768 # - Git won't give us the diff, there's nothing to compare to!
771 set max_sz
[expr {128 * 1024}]
773 set fd
[open
$path r
]
774 set content
[read $fd $max_sz]
776 set sz
[file size
$path]
780 set ui_status_value
"Unable to display [escape_path $path]"
781 error_popup
"Error loading file:\n\n$err"
784 $ui_diff conf
-state normal
785 if {![catch
{set type [exec file $path]}]} {
786 set n
[string length
$path]
787 if {[string equal
-length $n $path $type]} {
788 set type [string range
$type $n end
]
789 regsub
{^
:?\s
*} $type {} type
791 $ui_diff insert end
"* $type\n" d_@
793 if {[string first
"\0" $content] != -1} {
794 $ui_diff insert end \
795 "* Binary file (not showing content)." \
799 $ui_diff insert end \
800 "* Untracked file is $sz bytes.
801 * Showing only first $max_sz bytes.
804 $ui_diff insert end
$content
806 $ui_diff insert end
"
807 * Untracked file clipped here by [appname].
808 * To see the entire file, use an external editor.
812 $ui_diff conf
-state disabled
815 set ui_status_value
{Ready.
}
820 if {$w eq
$ui_index} {
821 lappend cmd diff-index
823 } elseif
{$w eq
$ui_workdir} {
824 if {[string index
$m 0] eq
{U
}} {
827 lappend cmd diff-files
832 lappend cmd
--no-color
833 if {$repo_config(gui.diffcontext
) > 0} {
834 lappend cmd
"-U$repo_config(gui.diffcontext)"
836 if {$w eq
$ui_index} {
842 if {[catch
{set fd
[open
$cmd r
]} err
]} {
845 set ui_status_value
"Unable to display [escape_path $path]"
846 error_popup
"Error loading diff:\n\n$err"
854 fileevent
$fd readable
[list read_diff
$fd]
857 proc read_diff
{fd
} {
858 global ui_diff ui_status_value diff_active
859 global is_3way_diff current_diff_header
861 $ui_diff conf
-state normal
862 while {[gets
$fd line
] >= 0} {
863 # -- Cleanup uninteresting diff header lines.
865 if { [string match
{diff --git *} $line]
866 ||
[string match
{diff --cc *} $line]
867 ||
[string match
{diff --combined *} $line]
868 ||
[string match
{--- *} $line]
869 ||
[string match
{+++ *} $line]} {
870 append current_diff_header
$line "\n"
873 if {[string match
{index
*} $line]} continue
874 if {$line eq
{deleted
file mode
120000}} {
875 set line
"deleted symlink"
878 # -- Automatically detect if this is a 3 way diff.
880 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
882 if {[string match
{mode
*} $line]
883 ||
[string match
{new
file *} $line]
884 ||
[string match
{deleted
file *} $line]
885 ||
[string match
{Binary files
* and
* differ
} $line]
886 ||
$line eq
{\ No newline
at end of
file}
887 ||
[regexp
{^\
* Unmerged path
} $line]} {
889 } elseif
{$is_3way_diff} {
890 set op
[string range
$line 0 1]
900 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
901 set line
[string replace
$line 0 1 { }]
908 puts
"error: Unhandled 3 way diff marker: {$op}"
913 set op
[string index
$line 0]
919 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
920 set line
[string replace
$line 0 0 { }]
927 puts
"error: Unhandled 2 way diff marker: {$op}"
932 $ui_diff insert end
$line $tags
933 if {[string index
$line end
] eq
"\r"} {
934 $ui_diff tag add d_cr
{end
- 2c
}
936 $ui_diff insert end
"\n" $tags
938 $ui_diff conf
-state disabled
944 set ui_status_value
{Ready.
}
946 if {[$ui_diff index end
] eq
{2.0}} {
952 proc apply_hunk
{x y
} {
953 global current_diff_path current_diff_header current_diff_side
954 global ui_diff ui_index file_states
956 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
957 if {![lock_index apply_hunk
]} return
959 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
960 set mi
[lindex
$file_states($current_diff_path) 0]
961 if {$current_diff_side eq
$ui_index} {
963 lappend apply_cmd
--reverse
964 if {[string index
$mi 0] ne
{M
}} {
970 if {[string index
$mi 1] ne
{M
}} {
976 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
977 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
983 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
989 set p
[open
"| $apply_cmd" w
]
990 fconfigure
$p -translation binary
-encoding binary
991 puts
-nonewline $p $current_diff_header
992 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
994 error_popup
"Failed to $mode selected hunk.\n\n$err"
999 $ui_diff conf
-state normal
1000 $ui_diff delete
$s_lno $e_lno
1001 $ui_diff conf
-state disabled
1003 if {[$ui_diff get
1.0 end
] eq
"\n"} {
1009 if {$current_diff_side eq
$ui_index} {
1011 } elseif
{[string index
$mi 0] eq
{_
}} {
1017 display_file
$current_diff_path $mi
1023 ######################################################################
1027 proc load_last_commit
{} {
1028 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1031 if {[llength
$PARENT] == 0} {
1032 error_popup
{There is nothing to amend.
1034 You are about to create the initial commit.
1035 There is no commit before this to amend.
1040 repository_state curType curHEAD curMERGE_HEAD
1041 if {$curType eq
{merge
}} {
1042 error_popup
{Cannot amend
while merging.
1044 You are currently
in the middle of a merge that
1045 has not been fully completed. You cannot amend
1046 the prior commit unless you first abort the
1047 current merge activity.
1055 set fd
[open
"| git cat-file commit $curHEAD" r
]
1056 fconfigure
$fd -encoding binary
-translation lf
1057 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1060 while {[gets
$fd line
] > 0} {
1061 if {[string match
{parent
*} $line]} {
1062 lappend parents
[string range
$line 7 end
]
1063 } elseif
{[string match
{encoding
*} $line]} {
1064 set enc
[string tolower
[string range
$line 9 end
]]
1067 fconfigure
$fd -encoding $enc
1068 set msg
[string trim
[read $fd]]
1071 error_popup
"Error loading commit data for amend:\n\n$err"
1077 set MERGE_HEAD
[list
]
1078 switch
-- [llength
$parents] {
1079 0 {set commit_type amend-initial
}
1080 1 {set commit_type amend
}
1081 default
{set commit_type amend-merge
}
1084 $ui_comm delete
0.0 end
1085 $ui_comm insert end
$msg
1087 $ui_comm edit modified false
1088 rescan
{set ui_status_value
{Ready.
}}
1091 proc create_new_commit
{} {
1092 global commit_type ui_comm
1094 set commit_type normal
1095 $ui_comm delete
0.0 end
1097 $ui_comm edit modified false
1098 rescan
{set ui_status_value
{Ready.
}}
1101 set GIT_COMMITTER_IDENT
{}
1103 proc committer_ident
{} {
1104 global GIT_COMMITTER_IDENT
1106 if {$GIT_COMMITTER_IDENT eq
{}} {
1107 if {[catch
{set me
[git var GIT_COMMITTER_IDENT
]} err
]} {
1108 error_popup
"Unable to obtain your identity:\n\n$err"
1111 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1112 $me me GIT_COMMITTER_IDENT
]} {
1113 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1118 return $GIT_COMMITTER_IDENT
1121 proc commit_tree
{} {
1122 global HEAD commit_type file_states ui_comm repo_config
1123 global ui_status_value pch_error
1125 if {[committer_ident
] eq
{}} return
1126 if {![lock_index update
]} return
1128 # -- Our in memory state should match the repository.
1130 repository_state curType curHEAD curMERGE_HEAD
1131 if {[string match amend
* $commit_type]
1132 && $curType eq
{normal
}
1133 && $curHEAD eq
$HEAD} {
1134 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1135 info_popup
{Last scanned state does not match repository state.
1137 Another Git program has modified this repository
1138 since the last scan. A rescan must be performed
1139 before another commit can be created.
1141 The rescan will be automatically started now.
1144 rescan
{set ui_status_value
{Ready.
}}
1148 # -- At least one file should differ in the index.
1151 foreach path
[array names file_states
] {
1152 switch
-glob -- [lindex
$file_states($path) 0] {
1156 M?
{set files_ready
1}
1158 error_popup
"Unmerged files cannot be committed.
1160 File [short_path $path] has merge conflicts.
1161 You must resolve them and add the file before committing.
1167 error_popup
"Unknown file state [lindex $s 0] detected.
1169 File [short_path $path] cannot be committed by this program.
1174 if {!$files_ready} {
1175 info_popup
{No changes to commit.
1177 You must add
at least
1 file before you can commit.
1183 # -- A message is required.
1185 set msg
[string trim
[$ui_comm get
1.0 end
]]
1186 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1188 error_popup
{Please supply a commit message.
1190 A good commit message has the following format
:
1192 - First line
: Describe
in one sentance what you did.
1193 - Second line
: Blank
1194 - Remaining lines
: Describe why this change is good.
1200 # -- Run the pre-commit hook.
1202 set pchook
[gitdir hooks pre-commit
]
1204 # On Cygwin [file executable] might lie so we need to ask
1205 # the shell if the hook is executable. Yes that's annoying.
1207 if {[is_Cygwin
] && [file isfile
$pchook]} {
1208 set pchook
[list sh
-c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\" 2>&1;" \
1212 } elseif
{[file executable
$pchook]} {
1213 set pchook
[list
$pchook |
& cat]
1215 commit_writetree
$curHEAD $msg
1219 set ui_status_value
{Calling pre-commit hook...
}
1221 set fd_ph
[open
"| $pchook" r
]
1222 fconfigure
$fd_ph -blocking 0 -translation binary
1223 fileevent
$fd_ph readable \
1224 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1227 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1228 global pch_error ui_status_value
1230 append pch_error
[read $fd_ph]
1231 fconfigure
$fd_ph -blocking 1
1233 if {[catch
{close
$fd_ph}]} {
1234 set ui_status_value
{Commit declined by pre-commit hook.
}
1235 hook_failed_popup pre-commit
$pch_error
1238 commit_writetree
$curHEAD $msg
1243 fconfigure
$fd_ph -blocking 0
1246 proc commit_writetree
{curHEAD msg
} {
1247 global ui_status_value
1249 set ui_status_value
{Committing changes...
}
1250 set fd_wt
[open
"| git write-tree" r
]
1251 fileevent
$fd_wt readable \
1252 [list commit_committree
$fd_wt $curHEAD $msg]
1255 proc commit_committree
{fd_wt curHEAD msg
} {
1256 global HEAD PARENT MERGE_HEAD commit_type
1257 global all_heads current_branch
1258 global ui_status_value ui_comm selected_commit_type
1259 global file_states selected_paths rescan_active
1263 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1264 error_popup
"write-tree failed:\n\n$err"
1265 set ui_status_value
{Commit failed.
}
1270 # -- Verify this wasn't an empty change.
1272 if {$commit_type eq
{normal
}} {
1273 set old_tree
[git rev-parse
"$PARENT^{tree}"]
1274 if {$tree_id eq
$old_tree} {
1275 info_popup
{No changes to commit.
1277 No files were modified by this commit and it
1278 was not a merge commit.
1280 A rescan will be automatically started now.
1283 rescan
{set ui_status_value
{No changes to commit.
}}
1288 # -- Build the message.
1290 set msg_p
[gitdir COMMIT_EDITMSG
]
1291 set msg_wt
[open
$msg_p w
]
1292 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1295 fconfigure
$msg_wt -encoding $enc -translation binary
1296 puts
-nonewline $msg_wt $msg
1299 # -- Create the commit.
1301 set cmd
[list git commit-tree
$tree_id]
1302 foreach p
[concat
$PARENT $MERGE_HEAD] {
1306 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1307 error_popup
"commit-tree failed:\n\n$err"
1308 set ui_status_value
{Commit failed.
}
1313 # -- Update the HEAD ref.
1316 if {$commit_type ne
{normal
}} {
1317 append reflogm
" ($commit_type)"
1319 set i
[string first
"\n" $msg]
1321 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1323 append reflogm
{: } $msg
1325 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1326 if {[catch
{eval exec $cmd} err
]} {
1327 error_popup
"update-ref failed:\n\n$err"
1328 set ui_status_value
{Commit failed.
}
1333 # -- Cleanup after ourselves.
1335 catch
{file delete
$msg_p}
1336 catch
{file delete
[gitdir MERGE_HEAD
]}
1337 catch
{file delete
[gitdir MERGE_MSG
]}
1338 catch
{file delete
[gitdir SQUASH_MSG
]}
1339 catch
{file delete
[gitdir GITGUI_MSG
]}
1341 # -- Let rerere do its thing.
1343 if {[file isdirectory
[gitdir rr-cache
]]} {
1347 # -- Run the post-commit hook.
1349 set pchook
[gitdir hooks post-commit
]
1350 if {[is_Cygwin
] && [file isfile
$pchook]} {
1351 set pchook
[list sh
-c [concat \
1352 "if test -x \"$pchook\";" \
1353 "then exec \"$pchook\";" \
1355 } elseif
{![file executable
$pchook]} {
1358 if {$pchook ne
{}} {
1359 catch
{exec $pchook &}
1362 $ui_comm delete
0.0 end
1364 $ui_comm edit modified false
1366 if {[is_enabled singlecommit
]} do_quit
1368 # -- Make sure our current branch exists.
1370 if {$commit_type eq
{initial
}} {
1371 lappend all_heads
$current_branch
1372 set all_heads
[lsort
-unique $all_heads]
1373 populate_branch_menu
1376 # -- Update in memory status
1378 set selected_commit_type new
1379 set commit_type normal
1382 set MERGE_HEAD
[list
]
1384 foreach path
[array names file_states
] {
1385 set s
$file_states($path)
1387 switch
-glob -- $m {
1395 unset file_states
($path)
1396 catch
{unset selected_paths
($path)}
1399 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1405 set file_states
($path) [list \
1406 _
[string index
$m 1] \
1417 set ui_status_value \
1418 "Changes committed as [string range $cmt_id 0 7]."
1421 ######################################################################
1425 proc fetch_from
{remote
} {
1426 set w
[new_console \
1428 "Fetching new changes from $remote"]
1429 set cmd
[list git fetch
]
1431 console_exec
$w $cmd console_done
1434 proc push_to
{remote
} {
1435 set w
[new_console \
1437 "Pushing changes to $remote"]
1438 set cmd
[list git push
]
1441 console_exec
$w $cmd console_done
1444 ######################################################################
1448 proc mapicon
{w state path
} {
1451 if {[catch
{set r
$all_icons($state$w)}]} {
1452 puts
"error: no icon for $w state={$state} $path"
1458 proc mapdesc
{state path
} {
1461 if {[catch
{set r
$all_descs($state)}]} {
1462 puts
"error: no desc for state={$state} $path"
1468 proc escape_path
{path
} {
1469 regsub
-all {\\} $path "\\\\" path
1470 regsub
-all "\n" $path "\\n" path
1474 proc short_path
{path
} {
1475 return [escape_path
[lindex
[file split $path] end
]]
1479 set null_sha1
[string repeat
0 40]
1481 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1482 global file_states next_icon_id null_sha1
1484 set s0
[string index
$new_state 0]
1485 set s1
[string index
$new_state 1]
1487 if {[catch
{set info
$file_states($path)}]} {
1489 set icon n
[incr next_icon_id
]
1491 set state
[lindex
$info 0]
1492 set icon
[lindex
$info 1]
1493 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1494 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1497 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1498 elseif
{$s0 eq
{_
}} {set s0 _
}
1500 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1501 elseif
{$s1 eq
{_
}} {set s1 _
}
1503 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1504 set head_info
[list
0 $null_sha1]
1505 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1506 && $head_info eq
{}} {
1507 set head_info
$index_info
1510 set file_states
($path) [list
$s0$s1 $icon \
1511 $head_info $index_info \
1516 proc display_file_helper
{w path icon_name old_m new_m
} {
1519 if {$new_m eq
{_
}} {
1520 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1522 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1524 $w conf
-state normal
1525 $w delete
$lno.0 [expr {$lno + 1}].0
1526 $w conf
-state disabled
1528 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1529 lappend file_lists
($w) $path
1530 set file_lists
($w) [lsort
-unique $file_lists($w)]
1531 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1533 $w conf
-state normal
1534 $w image create
$lno.0 \
1535 -align center
-padx 5 -pady 1 \
1537 -image [mapicon
$w $new_m $path]
1538 $w insert
$lno.1 "[escape_path $path]\n"
1539 $w conf
-state disabled
1540 } elseif
{$old_m ne
$new_m} {
1541 $w conf
-state normal
1542 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1543 $w conf
-state disabled
1547 proc display_file
{path state
} {
1548 global file_states selected_paths
1549 global ui_index ui_workdir
1551 set old_m
[merge_state
$path $state]
1552 set s
$file_states($path)
1553 set new_m
[lindex
$s 0]
1554 set icon_name
[lindex
$s 1]
1556 set o
[string index
$old_m 0]
1557 set n
[string index
$new_m 0]
1564 display_file_helper
$ui_index $path $icon_name $o $n
1566 if {[string index
$old_m 0] eq
{U
}} {
1569 set o
[string index
$old_m 1]
1571 if {[string index
$new_m 0] eq
{U
}} {
1574 set n
[string index
$new_m 1]
1576 display_file_helper
$ui_workdir $path $icon_name $o $n
1578 if {$new_m eq
{__
}} {
1579 unset file_states
($path)
1580 catch
{unset selected_paths
($path)}
1584 proc display_all_files_helper
{w path icon_name m
} {
1587 lappend file_lists
($w) $path
1588 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1589 $w image create end \
1590 -align center
-padx 5 -pady 1 \
1592 -image [mapicon
$w $m $path]
1593 $w insert end
"[escape_path $path]\n"
1596 proc display_all_files
{} {
1597 global ui_index ui_workdir
1598 global file_states file_lists
1601 $ui_index conf
-state normal
1602 $ui_workdir conf
-state normal
1604 $ui_index delete
0.0 end
1605 $ui_workdir delete
0.0 end
1608 set file_lists
($ui_index) [list
]
1609 set file_lists
($ui_workdir) [list
]
1611 foreach path
[lsort
[array names file_states
]] {
1612 set s
$file_states($path)
1614 set icon_name
[lindex
$s 1]
1616 set s
[string index
$m 0]
1617 if {$s ne
{U
} && $s ne
{_
}} {
1618 display_all_files_helper
$ui_index $path \
1622 if {[string index
$m 0] eq
{U
}} {
1625 set s
[string index
$m 1]
1628 display_all_files_helper
$ui_workdir $path \
1633 $ui_index conf
-state disabled
1634 $ui_workdir conf
-state disabled
1637 proc update_indexinfo
{msg pathList after
} {
1638 global update_index_cp ui_status_value
1640 if {![lock_index update
]} return
1642 set update_index_cp
0
1643 set pathList
[lsort
$pathList]
1644 set totalCnt
[llength
$pathList]
1645 set batch [expr {int
($totalCnt * .01) + 1}]
1646 if {$batch > 25} {set batch 25}
1648 set ui_status_value
[format \
1649 "$msg... %i/%i files (%.2f%%)" \
1653 set fd
[open
"| git update-index -z --index-info" w
]
1660 fileevent
$fd writable
[list \
1661 write_update_indexinfo \
1671 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1672 global update_index_cp ui_status_value
1673 global file_states current_diff_path
1675 if {$update_index_cp >= $totalCnt} {
1682 for {set i
$batch} \
1683 {$update_index_cp < $totalCnt && $i > 0} \
1685 set path
[lindex
$pathList $update_index_cp]
1686 incr update_index_cp
1688 set s
$file_states($path)
1689 switch
-glob -- [lindex
$s 0] {
1696 set info
[lindex
$s 2]
1697 if {$info eq
{}} continue
1699 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1700 display_file
$path $new
1703 set ui_status_value
[format \
1704 "$msg... %i/%i files (%.2f%%)" \
1707 [expr {100.0 * $update_index_cp / $totalCnt}]]
1710 proc update_index
{msg pathList after
} {
1711 global update_index_cp ui_status_value
1713 if {![lock_index update
]} return
1715 set update_index_cp
0
1716 set pathList
[lsort
$pathList]
1717 set totalCnt
[llength
$pathList]
1718 set batch [expr {int
($totalCnt * .01) + 1}]
1719 if {$batch > 25} {set batch 25}
1721 set ui_status_value
[format \
1722 "$msg... %i/%i files (%.2f%%)" \
1726 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1733 fileevent
$fd writable
[list \
1734 write_update_index \
1744 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1745 global update_index_cp ui_status_value
1746 global file_states current_diff_path
1748 if {$update_index_cp >= $totalCnt} {
1755 for {set i
$batch} \
1756 {$update_index_cp < $totalCnt && $i > 0} \
1758 set path
[lindex
$pathList $update_index_cp]
1759 incr update_index_cp
1761 switch
-glob -- [lindex
$file_states($path) 0] {
1767 if {[file exists
$path]} {
1776 puts
-nonewline $fd "[encoding convertto $path]\0"
1777 display_file
$path $new
1780 set ui_status_value
[format \
1781 "$msg... %i/%i files (%.2f%%)" \
1784 [expr {100.0 * $update_index_cp / $totalCnt}]]
1787 proc checkout_index
{msg pathList after
} {
1788 global update_index_cp ui_status_value
1790 if {![lock_index update
]} return
1792 set update_index_cp
0
1793 set pathList
[lsort
$pathList]
1794 set totalCnt
[llength
$pathList]
1795 set batch [expr {int
($totalCnt * .01) + 1}]
1796 if {$batch > 25} {set batch 25}
1798 set ui_status_value
[format \
1799 "$msg... %i/%i files (%.2f%%)" \
1803 set cmd
[list git checkout-index
]
1809 set fd
[open
"| $cmd " w
]
1816 fileevent
$fd writable
[list \
1817 write_checkout_index \
1827 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1828 global update_index_cp ui_status_value
1829 global file_states current_diff_path
1831 if {$update_index_cp >= $totalCnt} {
1838 for {set i
$batch} \
1839 {$update_index_cp < $totalCnt && $i > 0} \
1841 set path
[lindex
$pathList $update_index_cp]
1842 incr update_index_cp
1843 switch
-glob -- [lindex
$file_states($path) 0] {
1847 puts
-nonewline $fd "[encoding convertto $path]\0"
1848 display_file
$path ?_
1853 set ui_status_value
[format \
1854 "$msg... %i/%i files (%.2f%%)" \
1857 [expr {100.0 * $update_index_cp / $totalCnt}]]
1860 ######################################################################
1862 ## branch management
1864 proc is_tracking_branch
{name
} {
1865 global tracking_branches
1867 if {![catch
{set info
$tracking_branches($name)}]} {
1870 foreach t
[array names tracking_branches
] {
1871 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1878 proc load_all_heads
{} {
1881 set all_heads
[list
]
1882 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1883 while {[gets
$fd line
] > 0} {
1884 if {[is_tracking_branch
$line]} continue
1885 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1886 lappend all_heads
$name
1890 set all_heads
[lsort
$all_heads]
1893 proc populate_branch_menu
{} {
1894 global all_heads disable_on_lock
1897 set last
[$m index last
]
1898 for {set i
0} {$i <= $last} {incr i
} {
1899 if {[$m type $i] eq
{separator
}} {
1902 foreach a
$disable_on_lock {
1903 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1907 set disable_on_lock
$new_dol
1912 if {$all_heads ne
{}} {
1915 foreach b
$all_heads {
1916 $m add radiobutton \
1918 -command [list switch_branch
$b] \
1919 -variable current_branch \
1922 lappend disable_on_lock \
1923 [list
$m entryconf
[$m index last
] -state]
1927 proc all_tracking_branches
{} {
1928 global tracking_branches
1930 set all_trackings
{}
1932 foreach name
[array names tracking_branches
] {
1933 if {[regsub
{/\
*$
} $name {} name
]} {
1936 regsub ^refs
/(heads|remotes
)/ $name {} name
1937 lappend all_trackings
$name
1942 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1943 while {[gets
$fd name
] > 0} {
1944 regsub ^refs
/(heads|remotes
)/ $name {} name
1945 lappend all_trackings
$name
1950 return [lsort
-unique $all_trackings]
1953 proc load_all_tags
{} {
1955 set fd
[open
"| git for-each-ref --format=%(refname) refs/tags" r
]
1956 while {[gets
$fd line
] > 0} {
1957 if {![regsub ^refs
/tags
/ $line {} name
]} continue
1958 lappend all_tags
$name
1962 return [lsort
$all_tags]
1965 proc do_create_branch_action
{w
} {
1966 global all_heads null_sha1 repo_config
1967 global create_branch_checkout create_branch_revtype
1968 global create_branch_head create_branch_trackinghead
1969 global create_branch_name create_branch_revexp
1970 global create_branch_tag
1972 set newbranch
$create_branch_name
1973 if {$newbranch eq
{}
1974 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1978 -title [wm title
$w] \
1980 -message "Please supply a branch name."
1981 focus
$w.desc.name_t
1984 if {![catch
{git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1988 -title [wm title
$w] \
1990 -message "Branch '$newbranch' already exists."
1991 focus
$w.desc.name_t
1994 if {[catch
{git check-ref-format
"heads/$newbranch"}]} {
1998 -title [wm title
$w] \
2000 -message "We do not like '$newbranch' as a branch name."
2001 focus
$w.desc.name_t
2006 switch
-- $create_branch_revtype {
2007 head {set rev $create_branch_head}
2008 tracking
{set rev $create_branch_trackinghead}
2009 tag
{set rev $create_branch_tag}
2010 expression
{set rev $create_branch_revexp}
2012 if {[catch
{set cmt
[git rev-parse
--verify "${rev}^0"]}]} {
2016 -title [wm title
$w] \
2018 -message "Invalid starting revision: $rev"
2021 set cmd
[list git update-ref
]
2023 lappend cmd
"branch: Created from $rev"
2024 lappend cmd
"refs/heads/$newbranch"
2026 lappend cmd
$null_sha1
2027 if {[catch
{eval exec $cmd} err
]} {
2031 -title [wm title
$w] \
2033 -message "Failed to create '$newbranch'.\n\n$err"
2037 lappend all_heads
$newbranch
2038 set all_heads
[lsort
$all_heads]
2039 populate_branch_menu
2041 if {$create_branch_checkout} {
2042 switch_branch
$newbranch
2046 proc radio_selector
{varname value args
} {
2047 upvar
#0 $varname var
2051 trace add variable create_branch_head
write \
2052 [list radio_selector create_branch_revtype
head]
2053 trace add variable create_branch_trackinghead
write \
2054 [list radio_selector create_branch_revtype tracking
]
2055 trace add variable create_branch_tag
write \
2056 [list radio_selector create_branch_revtype tag
]
2058 trace add variable delete_branch_head
write \
2059 [list radio_selector delete_branch_checktype
head]
2060 trace add variable delete_branch_trackinghead
write \
2061 [list radio_selector delete_branch_checktype tracking
]
2063 proc do_create_branch
{} {
2064 global all_heads current_branch repo_config
2065 global create_branch_checkout create_branch_revtype
2066 global create_branch_head create_branch_trackinghead
2067 global create_branch_name create_branch_revexp
2068 global create_branch_tag
2070 set w .branch_editor
2072 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2074 label
$w.header
-text {Create New Branch
} \
2076 pack
$w.header
-side top
-fill x
2079 button
$w.buttons.create
-text Create \
2082 -command [list do_create_branch_action
$w]
2083 pack
$w.buttons.create
-side right
2084 button
$w.buttons.cancel
-text {Cancel
} \
2086 -command [list destroy
$w]
2087 pack
$w.buttons.cancel
-side right
-padx 5
2088 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2090 labelframe
$w.desc \
2091 -text {Branch Description
} \
2093 label
$w.desc.name_l
-text {Name
:} -font font_ui
2094 entry
$w.desc.name_t \
2098 -textvariable create_branch_name \
2102 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2105 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2106 grid columnconfigure
$w.desc
1 -weight 1
2107 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2109 labelframe
$w.from \
2110 -text {Starting Revision
} \
2112 radiobutton
$w.from.head_r \
2113 -text {Local Branch
:} \
2115 -variable create_branch_revtype \
2117 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2118 grid
$w.from.head_r
$w.from.head_m
-sticky w
2119 set all_trackings
[all_tracking_branches
]
2120 if {$all_trackings ne
{}} {
2121 set create_branch_trackinghead
[lindex
$all_trackings 0]
2122 radiobutton
$w.from.tracking_r \
2123 -text {Tracking Branch
:} \
2125 -variable create_branch_revtype \
2127 eval tk_optionMenu
$w.from.tracking_m \
2128 create_branch_trackinghead \
2130 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2132 set all_tags
[load_all_tags
]
2133 if {$all_tags ne
{}} {
2134 set create_branch_tag
[lindex
$all_tags 0]
2135 radiobutton
$w.from.tag_r \
2138 -variable create_branch_revtype \
2140 eval tk_optionMenu
$w.from.tag_m \
2143 grid
$w.from.tag_r
$w.from.tag_m
-sticky w
2145 radiobutton
$w.from.exp_r \
2146 -text {Revision Expression
:} \
2148 -variable create_branch_revtype \
2150 entry
$w.from.exp_t \
2154 -textvariable create_branch_revexp \
2158 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2159 if {%d
== 1 && [string length
%S
] > 0} {
2160 set create_branch_revtype expression
2164 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2165 grid columnconfigure
$w.from
1 -weight 1
2166 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2168 labelframe
$w.postActions \
2169 -text {Post Creation Actions
} \
2171 checkbutton
$w.postActions.checkout \
2172 -text {Checkout after creation
} \
2173 -variable create_branch_checkout \
2175 pack
$w.postActions.checkout
-anchor nw
2176 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2178 set create_branch_checkout
1
2179 set create_branch_head
$current_branch
2180 set create_branch_revtype
head
2181 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2182 set create_branch_revexp
{}
2184 bind $w <Visibility
> "
2186 $w.desc.name_t icursor end
2187 focus $w.desc.name_t
2189 bind $w <Key-Escape
> "destroy $w"
2190 bind $w <Key-Return
> "do_create_branch_action $w;break"
2191 wm title
$w "[appname] ([reponame]): Create Branch"
2195 proc do_delete_branch_action
{w
} {
2197 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2200 switch
-- $delete_branch_checktype {
2201 head {set check_rev
$delete_branch_head}
2202 tracking
{set check_rev
$delete_branch_trackinghead}
2203 always
{set check_rev
{:none
}}
2205 if {$check_rev eq
{:none
}} {
2207 } elseif
{[catch
{set check_cmt
[git rev-parse
--verify "${check_rev}^0"]}]} {
2211 -title [wm title
$w] \
2213 -message "Invalid check revision: $check_rev"
2217 set to_delete
[list
]
2218 set not_merged
[list
]
2219 foreach i
[$w.list.l curselection
] {
2220 set b
[$w.list.l get
$i]
2221 if {[catch
{set o
[git rev-parse
--verify $b]}]} continue
2222 if {$check_cmt ne
{}} {
2223 if {$b eq
$check_rev} continue
2224 if {[catch
{set m
[git merge-base
$o $check_cmt]}]} continue
2226 lappend not_merged
$b
2230 lappend to_delete
[list
$b $o]
2232 if {$not_merged ne
{}} {
2233 set msg
"The following branches are not completely merged into $check_rev:
2235 - [join $not_merged "\n - "]"
2239 -title [wm title
$w] \
2243 if {$to_delete eq
{}} return
2244 if {$delete_branch_checktype eq
{always
}} {
2245 set msg
{Recovering deleted branches is difficult.
2247 Delete the selected branches?
}
2248 if {[tk_messageBox \
2251 -title [wm title
$w] \
2253 -message $msg] ne
yes} {
2259 foreach i
$to_delete {
2262 if {[catch
{git update-ref
-d "refs/heads/$b" $o} err
]} {
2263 append failed
" - $b: $err\n"
2265 set x
[lsearch
-sorted -exact $all_heads $b]
2267 set all_heads
[lreplace
$all_heads $x $x]
2272 if {$failed ne
{}} {
2276 -title [wm title
$w] \
2278 -message "Failed to delete branches:\n$failed"
2281 set all_heads
[lsort
$all_heads]
2282 populate_branch_menu
2286 proc do_delete_branch
{} {
2287 global all_heads tracking_branches current_branch
2288 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2290 set w .branch_editor
2292 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2294 label
$w.header
-text {Delete Local Branch
} \
2296 pack
$w.header
-side top
-fill x
2299 button
$w.buttons.create
-text Delete \
2301 -command [list do_delete_branch_action
$w]
2302 pack
$w.buttons.create
-side right
2303 button
$w.buttons.cancel
-text {Cancel
} \
2305 -command [list destroy
$w]
2306 pack
$w.buttons.cancel
-side right
-padx 5
2307 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2309 labelframe
$w.list \
2310 -text {Local Branches
} \
2315 -selectmode extended \
2316 -yscrollcommand [list
$w.list.sby
set] \
2318 foreach h
$all_heads {
2319 if {$h ne
$current_branch} {
2320 $w.list.l insert end
$h
2323 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2324 pack
$w.list.sby
-side right
-fill y
2325 pack
$w.list.l
-side left
-fill both
-expand 1
2326 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2328 labelframe
$w.validate \
2329 -text {Delete Only If
} \
2331 radiobutton
$w.validate.head_r \
2332 -text {Merged Into Local Branch
:} \
2334 -variable delete_branch_checktype \
2336 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2337 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2338 set all_trackings
[all_tracking_branches
]
2339 if {$all_trackings ne
{}} {
2340 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2341 radiobutton
$w.validate.tracking_r \
2342 -text {Merged Into Tracking Branch
:} \
2344 -variable delete_branch_checktype \
2346 eval tk_optionMenu
$w.validate.tracking_m \
2347 delete_branch_trackinghead \
2349 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2351 radiobutton
$w.validate.always_r \
2352 -text {Always
(Do not perform merge checks
)} \
2354 -variable delete_branch_checktype \
2356 grid
$w.validate.always_r
-columnspan 2 -sticky w
2357 grid columnconfigure
$w.validate
1 -weight 1
2358 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2360 set delete_branch_head
$current_branch
2361 set delete_branch_checktype
head
2363 bind $w <Visibility
> "grab $w; focus $w"
2364 bind $w <Key-Escape
> "destroy $w"
2365 wm title
$w "[appname] ([reponame]): Delete Branch"
2369 proc switch_branch
{new_branch
} {
2370 global HEAD commit_type current_branch repo_config
2372 if {![lock_index switch
]} return
2374 # -- Our in memory state should match the repository.
2376 repository_state curType curHEAD curMERGE_HEAD
2377 if {[string match amend
* $commit_type]
2378 && $curType eq
{normal
}
2379 && $curHEAD eq
$HEAD} {
2380 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2381 info_popup
{Last scanned state does not match repository state.
2383 Another Git program has modified this repository
2384 since the last scan. A rescan must be performed
2385 before the current branch can be changed.
2387 The rescan will be automatically started now.
2390 rescan
{set ui_status_value
{Ready.
}}
2394 # -- Don't do a pointless switch.
2396 if {$current_branch eq
$new_branch} {
2401 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2402 switch_branch_stage2
{} $new_branch
2404 set ui_status_value
{Refreshing
file status...
}
2405 set cmd
[list git update-index
]
2407 lappend cmd
--unmerged
2408 lappend cmd
--ignore-missing
2409 lappend cmd
--refresh
2410 set fd_rf
[open
"| $cmd" r
]
2411 fconfigure
$fd_rf -blocking 0 -translation binary
2412 fileevent
$fd_rf readable \
2413 [list switch_branch_stage2
$fd_rf $new_branch]
2417 proc switch_branch_stage2
{fd_rf new_branch
} {
2418 global ui_status_value HEAD
2422 if {![eof
$fd_rf]} return
2426 set ui_status_value
"Updating working directory to '$new_branch'..."
2427 set cmd
[list git read-tree
]
2430 lappend cmd
--exclude-per-directory=.gitignore
2432 lappend cmd
$new_branch
2433 set fd_rt
[open
"| $cmd" r
]
2434 fconfigure
$fd_rt -blocking 0 -translation binary
2435 fileevent
$fd_rt readable \
2436 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2439 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2440 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2441 global current_branch
2442 global ui_comm ui_status_value
2444 # -- We never get interesting output on stdout; only stderr.
2447 fconfigure
$fd_rt -blocking 1
2448 if {![eof
$fd_rt]} {
2449 fconfigure
$fd_rt -blocking 0
2453 # -- The working directory wasn't in sync with the index and
2454 # we'd have to overwrite something to make the switch. A
2455 # merge is required.
2457 if {[catch
{close
$fd_rt} err
]} {
2458 regsub
{^fatal
: } $err {} err
2459 warn_popup
"File level merge required.
2463 Staying on branch '$current_branch'."
2464 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2469 # -- Update the symbolic ref. Core git doesn't even check for failure
2470 # here, it Just Works(tm). If it doesn't we are in some really ugly
2471 # state that is difficult to recover from within git-gui.
2473 if {[catch
{git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2474 error_popup
"Failed to set current branch.
2476 This working directory is only partially switched.
2477 We successfully updated your files, but failed to
2478 update an internal Git file.
2480 This should not have occurred. [appname] will now
2488 # -- Update our repository state. If we were previously in amend mode
2489 # we need to toss the current buffer and do a full rescan to update
2490 # our file lists. If we weren't in amend mode our file lists are
2491 # accurate and we can avoid the rescan.
2494 set selected_commit_type new
2495 if {[string match amend
* $commit_type]} {
2496 $ui_comm delete
0.0 end
2498 $ui_comm edit modified false
2499 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2501 repository_state commit_type HEAD MERGE_HEAD
2503 set ui_status_value
"Checked out branch '$current_branch'."
2507 ######################################################################
2509 ## remote management
2511 proc load_all_remotes
{} {
2513 global all_remotes tracking_branches
2515 set all_remotes
[list
]
2516 array
unset tracking_branches
2518 set rm_dir
[gitdir remotes
]
2519 if {[file isdirectory
$rm_dir]} {
2520 set all_remotes
[glob \
2524 -directory $rm_dir *]
2526 foreach name
$all_remotes {
2528 set fd
[open
[file join $rm_dir $name] r
]
2529 while {[gets
$fd line
] >= 0} {
2530 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2531 $line line src dst
]} continue
2532 if {![regexp ^refs
/ $dst]} {
2533 set dst
"refs/heads/$dst"
2535 set tracking_branches
($dst) [list
$name $src]
2542 foreach line
[array names repo_config remote.
*.url
] {
2543 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2544 lappend all_remotes
$name
2546 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2550 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2551 if {![regexp ^refs
/ $dst]} {
2552 set dst
"refs/heads/$dst"
2554 set tracking_branches
($dst) [list
$name $src]
2558 set all_remotes
[lsort
-unique $all_remotes]
2561 proc populate_fetch_menu
{} {
2562 global all_remotes repo_config
2565 foreach r
$all_remotes {
2567 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2568 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2573 set fd
[open
[gitdir remotes
$r] r
]
2574 while {[gets
$fd n
] >= 0} {
2575 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2586 -label "Fetch from $r..." \
2587 -command [list fetch_from
$r] \
2593 proc populate_push_menu
{} {
2594 global all_remotes repo_config
2598 foreach r
$all_remotes {
2600 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2601 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2606 set fd
[open
[gitdir remotes
$r] r
]
2607 while {[gets
$fd n
] >= 0} {
2608 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2622 -label "Push to $r..." \
2623 -command [list push_to
$r] \
2630 proc start_push_anywhere_action
{w
} {
2631 global push_urltype push_remote push_url push_thin push_tags
2634 switch
-- $push_urltype {
2635 remote
{set r_url
$push_remote}
2636 url
{set r_url
$push_url}
2638 if {$r_url eq
{}} return
2640 set cmd
[list git push
]
2650 foreach i
[$w.
source.l curselection
] {
2651 set b
[$w.
source.l get
$i]
2652 lappend cmd
"refs/heads/$b:refs/heads/$b"
2657 } elseif
{$cnt == 1} {
2663 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2664 console_exec
$cons $cmd console_done
2668 trace add variable push_remote
write \
2669 [list radio_selector push_urltype remote
]
2671 proc do_push_anywhere
{} {
2672 global all_heads all_remotes current_branch
2673 global push_urltype push_remote push_url push_thin push_tags
2677 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2679 label
$w.header
-text {Push Branches
} -font font_uibold
2680 pack
$w.header
-side top
-fill x
2683 button
$w.buttons.create
-text Push \
2685 -command [list start_push_anywhere_action
$w]
2686 pack
$w.buttons.create
-side right
2687 button
$w.buttons.cancel
-text {Cancel
} \
2689 -command [list destroy
$w]
2690 pack
$w.buttons.cancel
-side right
-padx 5
2691 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2693 labelframe
$w.
source \
2694 -text {Source Branches
} \
2696 listbox
$w.
source.l \
2699 -selectmode extended \
2700 -yscrollcommand [list
$w.
source.sby
set] \
2702 foreach h
$all_heads {
2703 $w.
source.l insert end
$h
2704 if {$h eq
$current_branch} {
2705 $w.
source.l
select set end
2708 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2709 pack
$w.
source.sby
-side right
-fill y
2710 pack
$w.
source.l
-side left
-fill both
-expand 1
2711 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2713 labelframe
$w.dest \
2714 -text {Destination Repository
} \
2716 if {$all_remotes ne
{}} {
2717 radiobutton
$w.dest.remote_r \
2720 -variable push_urltype \
2722 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2723 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2724 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2725 set push_remote origin
2727 set push_remote
[lindex
$all_remotes 0]
2729 set push_urltype remote
2731 set push_urltype url
2733 radiobutton
$w.dest.url_r \
2734 -text {Arbitrary URL
:} \
2736 -variable push_urltype \
2738 entry
$w.dest.url_t \
2742 -textvariable push_url \
2746 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2747 if {%d
== 1 && [string length
%S
] > 0} {
2748 set push_urltype url
2752 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2753 grid columnconfigure
$w.dest
1 -weight 1
2754 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2756 labelframe
$w.options \
2757 -text {Transfer Options
} \
2759 checkbutton
$w.options.thin \
2760 -text {Use thin pack
(for slow network connections
)} \
2761 -variable push_thin \
2763 grid
$w.options.thin
-columnspan 2 -sticky w
2764 checkbutton
$w.options.tags \
2765 -text {Include tags
} \
2766 -variable push_tags \
2768 grid
$w.options.tags
-columnspan 2 -sticky w
2769 grid columnconfigure
$w.options
1 -weight 1
2770 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2776 bind $w <Visibility
> "grab $w"
2777 bind $w <Key-Escape
> "destroy $w"
2778 wm title
$w "[appname] ([reponame]): Push"
2782 ######################################################################
2787 global HEAD commit_type file_states
2789 if {[string match amend
* $commit_type]} {
2790 info_popup
{Cannot merge
while amending.
2792 You must finish amending this commit before
2793 starting any
type of merge.
2798 if {[committer_ident
] eq
{}} {return 0}
2799 if {![lock_index merge
]} {return 0}
2801 # -- Our in memory state should match the repository.
2803 repository_state curType curHEAD curMERGE_HEAD
2804 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2805 info_popup
{Last scanned state does not match repository state.
2807 Another Git program has modified this repository
2808 since the last scan. A rescan must be performed
2809 before a merge can be performed.
2811 The rescan will be automatically started now.
2814 rescan
{set ui_status_value
{Ready.
}}
2818 foreach path
[array names file_states
] {
2819 switch
-glob -- [lindex
$file_states($path) 0] {
2821 continue; # and pray it works!
2824 error_popup
"You are in the middle of a conflicted merge.
2826 File [short_path $path] has merge conflicts.
2828 You must resolve them, add the file, and commit to
2829 complete the current merge. Only then can you
2830 begin another merge.
2836 error_popup
"You are in the middle of a change.
2838 File [short_path $path] is modified.
2840 You should complete the current commit before
2841 starting a merge. Doing so will help you abort
2842 a failed merge, should the need arise.
2853 proc visualize_local_merge
{w
} {
2855 foreach i
[$w.
source.l curselection
] {
2856 lappend revs
[$w.
source.l get
$i]
2858 if {$revs eq
{}} return
2859 lappend revs
--not HEAD
2863 proc start_local_merge_action
{w
} {
2864 global HEAD ui_status_value current_branch
2866 set cmd
[list git merge
]
2869 foreach i
[$w.
source.l curselection
] {
2870 set b
[$w.
source.l get
$i]
2878 } elseif
{$revcnt == 1} {
2880 } elseif
{$revcnt <= 15} {
2886 -title [wm title
$w] \
2888 -message "Too many branches selected.
2890 You have requested to merge $revcnt branches
2891 in an octopus merge. This exceeds Git's
2892 internal limit of 15 branches per merge.
2894 Please select fewer branches. To merge more
2895 than 15 branches, merge the branches in batches.
2900 set msg
"Merging $current_branch, [join $names {, }]"
2901 set ui_status_value
"$msg..."
2902 set cons
[new_console
"Merge" $msg]
2903 console_exec
$cons $cmd [list finish_merge
$revcnt]
2904 bind $w <Destroy
> {}
2908 proc finish_merge
{revcnt w ok
} {
2911 set msg
{Merge completed successfully.
}
2914 info_popup
"Octopus merge failed.
2916 Your merge of $revcnt branches has failed.
2918 There are file-level conflicts between the
2919 branches which must be resolved manually.
2921 The working directory will now be reset.
2923 You can attempt this merge again
2924 by merging only one branch at a time." $w
2926 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2927 fconfigure
$fd -blocking 0 -translation binary
2928 fileevent
$fd readable
[list reset_hard_wait
$fd]
2929 set ui_status_value
{Aborting... please
wait...
}
2933 set msg
{Merge failed. Conflict resolution is required.
}
2936 rescan
[list
set ui_status_value
$msg]
2939 proc do_local_merge
{} {
2940 global current_branch
2942 if {![can_merge
]} return
2946 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2949 -text "Merge Into $current_branch" \
2951 pack
$w.header
-side top
-fill x
2954 button
$w.buttons.visualize
-text Visualize \
2956 -command [list visualize_local_merge
$w]
2957 pack
$w.buttons.visualize
-side left
2958 button
$w.buttons.create
-text Merge \
2960 -command [list start_local_merge_action
$w]
2961 pack
$w.buttons.create
-side right
2962 button
$w.buttons.cancel
-text {Cancel
} \
2964 -command [list destroy
$w]
2965 pack
$w.buttons.cancel
-side right
-padx 5
2966 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2968 labelframe
$w.
source \
2969 -text {Source Branches
} \
2971 listbox
$w.
source.l \
2974 -selectmode extended \
2975 -yscrollcommand [list
$w.
source.sby
set] \
2977 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2978 pack
$w.
source.sby
-side right
-fill y
2979 pack
$w.
source.l
-side left
-fill both
-expand 1
2980 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2982 set cmd
[list git for-each-ref
]
2983 lappend cmd
{--format=%(objectname
) %(*objectname
) %(refname
)}
2984 lappend cmd refs
/heads
2985 lappend cmd refs
/remotes
2986 lappend cmd refs
/tags
2987 set fr_fd
[open
"| $cmd" r
]
2988 fconfigure
$fr_fd -translation binary
2989 while {[gets
$fr_fd line
] > 0} {
2990 set line
[split $line { }]
2991 set sha1
([lindex
$line 0]) [lindex
$line 2]
2992 set sha1
([lindex
$line 1]) [lindex
$line 2]
2997 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2998 while {[gets
$fr_fd line
] > 0} {
2999 if {[catch
{set ref
$sha1($line)}]} continue
3000 regsub ^refs
/(heads|remotes|tags
)/ $ref {} ref
3001 lappend to_show
$ref
3005 foreach ref
[lsort
-unique $to_show] {
3006 $w.
source.l insert end
$ref
3009 bind $w <Visibility
> "grab $w"
3010 bind $w <Key-Escape
> "unlock_index;destroy $w"
3011 bind $w <Destroy
> unlock_index
3012 wm title
$w "[appname] ([reponame]): Merge"
3016 proc do_reset_hard
{} {
3017 global HEAD commit_type file_states
3019 if {[string match amend
* $commit_type]} {
3020 info_popup
{Cannot abort
while amending.
3022 You must finish amending this commit.
3027 if {![lock_index abort
]} return
3029 if {[string match
*merge
* $commit_type]} {
3035 if {[ask_popup
"Abort $op?
3037 Aborting the current $op will cause
3038 *ALL* uncommitted changes to be lost.
3040 Continue with aborting the current $op?"] eq
{yes}} {
3041 set fd
[open
"| git read-tree --reset -u HEAD" r
]
3042 fconfigure
$fd -blocking 0 -translation binary
3043 fileevent
$fd readable
[list reset_hard_wait
$fd]
3044 set ui_status_value
{Aborting... please
wait...
}
3050 proc reset_hard_wait
{fd
} {
3058 $ui_comm delete
0.0 end
3059 $ui_comm edit modified false
3061 catch
{file delete
[gitdir MERGE_HEAD
]}
3062 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
3063 catch
{file delete
[gitdir SQUASH_MSG
]}
3064 catch
{file delete
[gitdir MERGE_MSG
]}
3065 catch
{file delete
[gitdir GITGUI_MSG
]}
3067 rescan
{set ui_status_value
{Abort completed. Ready.
}}
3071 ######################################################################
3075 set next_browser_id
0
3077 proc new_browser
{commit
} {
3078 global next_browser_id cursor_ptr M1B
3079 global browser_commit browser_status browser_stack browser_path browser_busy
3081 if {[winfo ismapped .
]} {
3082 set w .browser
[incr next_browser_id
]
3089 set w_list
$w.list.l
3090 set browser_commit
($w_list) $commit
3091 set browser_status
($w_list) {Starting...
}
3092 set browser_stack
($w_list) {}
3093 set browser_path
($w_list) $browser_commit($w_list):
3094 set browser_busy
($w_list) 1
3096 label
$w.path
-textvariable browser_path
($w_list) \
3102 pack
$w.path
-anchor w
-side top
-fill x
3105 text
$w_list -background white
-borderwidth 0 \
3106 -cursor $cursor_ptr \
3111 -xscrollcommand [list
$w.list.sbx
set] \
3112 -yscrollcommand [list
$w.list.sby
set] \
3114 $w_list tag conf in_sel \
3115 -background [$w_list cget
-foreground] \
3116 -foreground [$w_list cget
-background]
3117 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
3118 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
3119 pack
$w.list.sbx
-side bottom
-fill x
3120 pack
$w.list.sby
-side right
-fill y
3121 pack
$w_list -side left
-fill both
-expand 1
3122 pack
$w.list
-side top
-fill both
-expand 1
3124 label
$w.status
-textvariable browser_status
($w_list) \
3130 pack
$w.status
-anchor w
-side bottom
-fill x
3132 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3133 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3134 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3135 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3136 bind $w_list <Up
> "browser_move -1 $w_list;break"
3137 bind $w_list <Down
> "browser_move 1 $w_list;break"
3138 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3139 bind $w_list <Return
> "browser_enter $w_list;break"
3140 bind $w_list <Prior
> "browser_page -1 $w_list;break"
3141 bind $w_list <Next
> "browser_page 1 $w_list;break"
3142 bind $w_list <Left
> break
3143 bind $w_list <Right
> break
3145 bind $tl <Visibility
> "focus $w"
3146 bind $tl <Destroy
> "
3147 array unset browser_buffer $w_list
3148 array unset browser_files $w_list
3149 array unset browser_status $w_list
3150 array unset browser_stack $w_list
3151 array unset browser_path $w_list
3152 array unset browser_commit $w_list
3153 array unset browser_busy $w_list
3155 wm title
$tl "[appname] ([reponame]): File Browser"
3156 ls_tree
$w_list $browser_commit($w_list) {}
3159 proc browser_move
{dir w
} {
3160 global browser_files browser_busy
3162 if {$browser_busy($w)} return
3163 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3165 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3166 $w tag remove in_sel
0.0 end
3167 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3172 proc browser_page
{dir w
} {
3173 global browser_files browser_busy
3175 if {$browser_busy($w)} return
3176 $w yview scroll
$dir pages
3178 [lindex
[$w yview
] 0]
3179 * [llength
$browser_files($w)]
3181 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3182 $w tag remove in_sel
0.0 end
3183 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3188 proc browser_parent
{w
} {
3189 global browser_files browser_status browser_path
3190 global browser_stack browser_busy
3192 if {$browser_busy($w)} return
3193 set info
[lindex
$browser_files($w) 0]
3194 if {[lindex
$info 0] eq
{parent
}} {
3195 set parent
[lindex
$browser_stack($w) end-1
]
3196 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3197 if {$browser_stack($w) eq
{}} {
3198 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3200 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3202 set browser_status
($w) "Loading $browser_path($w)..."
3203 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3207 proc browser_enter
{w
} {
3208 global browser_files browser_status browser_path
3209 global browser_commit browser_stack browser_busy
3211 if {$browser_busy($w)} return
3212 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3213 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3215 switch
-- [lindex
$info 0] {
3220 set name
[lindex
$info 2]
3221 set escn
[escape_path
$name]
3222 set browser_status
($w) "Loading $escn..."
3223 append browser_path
($w) $escn
3224 ls_tree
$w [lindex
$info 1] $name
3227 set name
[lindex
$info 2]
3229 foreach n
$browser_stack($w) {
3230 append p
[lindex
$n 1]
3233 show_blame
$browser_commit($w) $p
3239 proc browser_click
{was_double_click w pos
} {
3240 global browser_files browser_busy
3242 if {$browser_busy($w)} return
3243 set lno
[lindex
[split [$w index
$pos] .
] 0]
3246 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3247 $w tag remove in_sel
0.0 end
3248 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3249 if {$was_double_click} {
3255 proc ls_tree
{w tree_id name
} {
3256 global browser_buffer browser_files browser_stack browser_busy
3258 set browser_buffer
($w) {}
3259 set browser_files
($w) {}
3260 set browser_busy
($w) 1
3262 $w conf
-state normal
3263 $w tag remove in_sel
0.0 end
3265 if {$browser_stack($w) ne
{}} {
3266 $w image create end \
3267 -align center
-padx 5 -pady 1 \
3270 $w insert end
{[Up To Parent
]}
3271 lappend browser_files
($w) parent
3273 lappend browser_stack
($w) [list
$tree_id $name]
3274 $w conf
-state disabled
3276 set cmd
[list git ls-tree
-z $tree_id]
3277 set fd
[open
"| $cmd" r
]
3278 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3279 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3282 proc read_ls_tree
{fd w
} {
3283 global browser_buffer browser_files browser_status browser_busy
3285 if {![winfo exists
$w]} {
3290 append browser_buffer
($w) [read $fd]
3291 set pck
[split $browser_buffer($w) "\0"]
3292 set browser_buffer
($w) [lindex
$pck end
]
3294 set n
[llength
$browser_files($w)]
3295 $w conf
-state normal
3296 foreach p
[lrange
$pck 0 end-1
] {
3297 set info
[split $p "\t"]
3298 set path
[lindex
$info 1]
3299 set info
[split [lindex
$info 0] { }]
3300 set type [lindex
$info 1]
3301 set object
[lindex
$info 2]
3312 set image file_question
3316 if {$n > 0} {$w insert end
"\n"}
3317 $w image create end \
3318 -align center
-padx 5 -pady 1 \
3319 -name icon
[incr n
] \
3321 $w insert end
[escape_path
$path]
3322 lappend browser_files
($w) [list
$type $object $path]
3324 $w conf
-state disabled
3328 set browser_status
($w) Ready.
3329 set browser_busy
($w) 0
3330 array
unset browser_buffer
$w
3332 $w tag add in_sel
1.0 2.0
3338 proc show_blame
{commit path
} {
3339 global next_browser_id blame_status blame_data
3341 if {[winfo ismapped .
]} {
3342 set w .browser
[incr next_browser_id
]
3349 set blame_status
($w) {Loading current
file content...
}
3351 label
$w.path
-text "$commit:$path" \
3357 pack
$w.path
-side top
-fill x
3360 text
$w.out.loaded_t \
3361 -background white
-borderwidth 0 \
3367 $w.out.loaded_t tag conf annotated
-background grey
3369 text
$w.out.linenumber_t \
3370 -background white
-borderwidth 0 \
3376 $w.out.linenumber_t tag conf linenumber
-justify right
3378 text
$w.out.file_t \
3379 -background white
-borderwidth 0 \
3384 -xscrollcommand [list
$w.out.sbx
set] \
3387 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3388 scrollbar
$w.out.sby
-orient v \
3389 -command [list scrollbar2many
[list \
3391 $w.out.linenumber_t \
3395 $w.out.linenumber_t \
3400 grid conf
$w.out.sbx
-column 2 -sticky we
3401 grid columnconfigure
$w.out
2 -weight 1
3402 grid rowconfigure
$w.out
0 -weight 1
3403 pack
$w.out
-fill both
-expand 1
3405 label
$w.status
-textvariable blame_status
($w) \
3411 pack
$w.status
-side bottom
-fill x
3415 -background white
-borderwidth 0 \
3420 -xscrollcommand [list
$w.cm.sbx
set] \
3421 -yscrollcommand [list
$w.cm.sby
set] \
3423 scrollbar
$w.cm.sbx
-orient h
-command [list
$w.cm.t xview
]
3424 scrollbar
$w.cm.sby
-orient v
-command [list
$w.cm.t yview
]
3425 pack
$w.cm.sby
-side right
-fill y
3426 pack
$w.cm.sbx
-side bottom
-fill x
3427 pack
$w.cm.t
-expand 1 -fill both
3428 pack
$w.cm
-side bottom
-fill x
3430 menu
$w.ctxm
-tearoff 0
3431 $w.ctxm add
command -label "Copy Commit" \
3433 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3437 $w.out.linenumber_t \
3439 $i tag conf in_sel \
3440 -background [$i cget
-foreground] \
3441 -foreground [$i cget
-background]
3442 $i conf
-yscrollcommand \
3443 [list many2scrollbar
[list \
3445 $w.out.linenumber_t \
3448 bind $i <Button-1
> "
3451 $w.out.linenumber_t \\
3460 tk_popup $w.ctxm %X %Y
3464 bind $w.cm.t
<Button-1
> "focus $w.cm.t"
3465 bind $tl <Visibility
> "focus $tl"
3466 bind $tl <Destroy
> "
3467 array unset blame_status {$w}
3468 array unset blame_data $w,*
3470 wm title
$tl "[appname] ([reponame]): File Viewer"
3472 set blame_data
($w,commit_count
) 0
3473 set blame_data
($w,commit_list
) {}
3474 set blame_data
($w,total_lines
) 0
3475 set blame_data
($w,blame_lines
) 0
3476 set blame_data
($w,highlight_commit
) {}
3477 set blame_data
($w,highlight_line
) -1
3479 set cmd
[list git cat-file blob
"$commit:$path"]
3480 set fd
[open
"| $cmd" r
]
3481 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3482 fileevent
$fd readable
[list read_blame_catfile \
3483 $fd $w $commit $path \
3484 $w.cm.t
$w.out.loaded_t
$w.out.linenumber_t
$w.out.file_t
]
3487 proc read_blame_catfile
{fd w commit path w_cmit w_load w_line w_file
} {
3488 global blame_status blame_data
3490 if {![winfo exists
$w_file]} {
3495 set n
$blame_data($w,total_lines
)
3496 $w_load conf
-state normal
3497 $w_line conf
-state normal
3498 $w_file conf
-state normal
3499 while {[gets
$fd line
] >= 0} {
3500 regsub
"\r\$" $line {} line
3502 $w_load insert end
"\n"
3503 $w_line insert end
"$n\n" linenumber
3504 $w_file insert end
"$line\n"
3506 $w_load conf
-state disabled
3507 $w_line conf
-state disabled
3508 $w_file conf
-state disabled
3509 set blame_data
($w,total_lines
) $n
3513 blame_incremental_status
$w
3514 set cmd
[list git blame
-M -C --incremental]
3515 lappend cmd
$commit -- $path
3516 set fd
[open
"| $cmd" r
]
3517 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3518 fileevent
$fd readable
[list read_blame_incremental
$fd $w \
3519 $w_load $w_cmit $w_line $w_file]
3523 proc read_blame_incremental
{fd w w_load w_cmit w_line w_file
} {
3524 global blame_status blame_data
3526 if {![winfo exists
$w_file]} {
3531 while {[gets
$fd line
] >= 0} {
3532 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3533 cmit original_line final_line line_count
]} {
3534 set blame_data
($w,commit
) $cmit
3535 set blame_data
($w,original_line
) $original_line
3536 set blame_data
($w,final_line
) $final_line
3537 set blame_data
($w,line_count
) $line_count
3539 if {[catch
{set g
$blame_data($w,$cmit,order
)}]} {
3540 $w_line tag conf g
$cmit
3541 $w_file tag conf g
$cmit
3542 $w_line tag raise in_sel
3543 $w_file tag raise in_sel
3544 $w_file tag raise sel
3545 set blame_data
($w,$cmit,order
) $blame_data($w,commit_count
)
3546 incr blame_data
($w,commit_count
)
3547 lappend blame_data
($w,commit_list
) $cmit
3549 } elseif
{[string match
{filename
*} $line]} {
3550 set file [string range
$line 9 end
]
3551 set n
$blame_data($w,line_count
)
3552 set lno
$blame_data($w,final_line
)
3553 set cmit
$blame_data($w,commit
)
3556 if {[catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3557 $w_load tag add annotated
$lno.0 "$lno.0 lineend + 1c"
3559 $w_line tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3560 $w_file tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3563 set blame_data
($w,line
$lno,commit
) $cmit
3564 set blame_data
($w,line
$lno,file) $file
3565 $w_line tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3566 $w_file tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3568 if {$blame_data($w,highlight_line
) == -1} {
3569 if {[lindex
[$w_file yview
] 0] == 0} {
3571 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3573 } elseif
{$blame_data($w,highlight_line
) == $lno} {
3574 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3579 incr blame_data
($w,blame_lines
)
3582 set hc
$blame_data($w,highlight_commit
)
3584 && [expr {$blame_data($w,$hc,order
) + 1}]
3585 == $blame_data($w,$cmit,order
)} {
3586 blame_showcommit
$w $w_cmit $w_line $w_file \
3587 $blame_data($w,highlight_line
)
3589 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3590 set blame_data
($w,$blame_data($w,commit
),$header) $data
3596 set blame_status
($w) {Annotation complete.
}
3598 blame_incremental_status
$w
3602 proc blame_incremental_status
{w
} {
3603 global blame_status blame_data
3605 set blame_status
($w) [format \
3606 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3607 $blame_data($w,blame_lines
) \
3608 $blame_data($w,total_lines
) \
3609 [expr {100 * $blame_data($w,blame_lines
)
3610 / $blame_data($w,total_lines
)}]]
3613 proc blame_click
{w w_cmit w_line w_file cur_w pos
} {
3614 set lno
[lindex
[split [$cur_w index
$pos] .
] 0]
3615 if {$lno eq
{}} return
3617 $w_line tag remove in_sel
0.0 end
3618 $w_file tag remove in_sel
0.0 end
3619 $w_line tag add in_sel
$lno.0 "$lno.0 + 1 line"
3620 $w_file tag add in_sel
$lno.0 "$lno.0 + 1 line"
3622 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3631 proc blame_showcommit
{w w_cmit w_line w_file lno
} {
3632 global blame_colors blame_data repo_config
3634 set cmit
$blame_data($w,highlight_commit
)
3636 set idx
$blame_data($w,$cmit,order
)
3638 foreach c
$blame_colors {
3639 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3640 $w_line tag conf g
$h -background white
3641 $w_file tag conf g
$h -background white
3646 $w_cmit conf
-state normal
3647 $w_cmit delete
0.0 end
3648 if {[catch
{set cmit
$blame_data($w,line
$lno,commit
)}]} {
3650 $w_cmit insert end
"Loading annotation..."
3652 set idx
$blame_data($w,$cmit,order
)
3654 foreach c
$blame_colors {
3655 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3656 $w_line tag conf g
$h -background $c
3657 $w_file tag conf g
$h -background $c
3661 if {[catch
{set msg
$blame_data($w,$cmit,message
)}]} {
3664 set fd
[open
"| git cat-file commit $cmit" r
]
3665 fconfigure
$fd -encoding binary
-translation lf
3666 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
3669 while {[gets
$fd line
] > 0} {
3670 if {[string match
{encoding
*} $line]} {
3671 set enc
[string tolower
[string range
$line 9 end
]]
3674 fconfigure
$fd -encoding $enc
3675 set msg
[string trim
[read $fd]]
3678 set blame_data
($w,$cmit,message
) $msg
3684 catch
{set author_name
$blame_data($w,$cmit,author
)}
3685 catch
{set author_email
$blame_data($w,$cmit,author-mail
)}
3686 catch
{set author_time
[clock format
$blame_data($w,$cmit,author-time
)]}
3688 set committer_name
{}
3689 set committer_email
{}
3690 set committer_time
{}
3691 catch
{set committer_name
$blame_data($w,$cmit,committer
)}
3692 catch
{set committer_email
$blame_data($w,$cmit,committer-mail
)}
3693 catch
{set committer_time
[clock format
$blame_data($w,$cmit,committer-time
)]}
3695 $w_cmit insert end
"commit $cmit\n"
3696 $w_cmit insert end
"Author: $author_name $author_email $author_time\n"
3697 $w_cmit insert end
"Committer: $committer_name $committer_email $committer_time\n"
3698 $w_cmit insert end
"Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3699 $w_cmit insert end
"\n"
3700 $w_cmit insert end
$msg
3702 $w_cmit conf
-state disabled
3704 set blame_data
($w,highlight_line
) $lno
3705 set blame_data
($w,highlight_commit
) $cmit
3708 proc blame_copycommit
{w i pos
} {
3710 set lno
[lindex
[split [$i index
$pos] .
] 0]
3711 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3720 ######################################################################
3725 #define mask_width 14
3726 #define mask_height 15
3727 static unsigned char mask_bits
[] = {
3728 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3729 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3730 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3733 image create bitmap file_plain
-background white
-foreground black
-data {
3734 #define plain_width 14
3735 #define plain_height 15
3736 static unsigned char plain_bits
[] = {
3737 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3738 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3739 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3740 } -maskdata $filemask
3742 image create bitmap file_mod
-background white
-foreground blue
-data {
3743 #define mod_width 14
3744 #define mod_height 15
3745 static unsigned char mod_bits
[] = {
3746 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3747 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3748 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3749 } -maskdata $filemask
3751 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3752 #define file_fulltick_width 14
3753 #define file_fulltick_height 15
3754 static unsigned char file_fulltick_bits
[] = {
3755 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3756 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3757 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3758 } -maskdata $filemask
3760 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3761 #define parttick_width 14
3762 #define parttick_height 15
3763 static unsigned char parttick_bits
[] = {
3764 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3765 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3766 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3767 } -maskdata $filemask
3769 image create bitmap file_question
-background white
-foreground black
-data {
3770 #define file_question_width 14
3771 #define file_question_height 15
3772 static unsigned char file_question_bits
[] = {
3773 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3774 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3775 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3776 } -maskdata $filemask
3778 image create bitmap file_removed
-background white
-foreground red
-data {
3779 #define file_removed_width 14
3780 #define file_removed_height 15
3781 static unsigned char file_removed_bits
[] = {
3782 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3783 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3784 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3785 } -maskdata $filemask
3787 image create bitmap file_merge
-background white
-foreground blue
-data {
3788 #define file_merge_width 14
3789 #define file_merge_height 15
3790 static unsigned char file_merge_bits
[] = {
3791 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3792 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3793 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3794 } -maskdata $filemask
3797 #define file_width 18
3798 #define file_height 18
3799 static unsigned char file_bits
[] = {
3800 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3801 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3802 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3803 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3804 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3806 image create bitmap file_dir
-background white
-foreground blue \
3807 -data $file_dir_data -maskdata $file_dir_data
3810 set file_uplevel_data
{
3812 #define up_height 15
3813 static unsigned char up_bits
[] = {
3814 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3815 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3816 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3818 image create bitmap file_uplevel
-background white
-foreground red \
3819 -data $file_uplevel_data -maskdata $file_uplevel_data
3820 unset file_uplevel_data
3822 set ui_index .vpane.files.index.list
3823 set ui_workdir .vpane.files.workdir.list
3825 set all_icons
(_
$ui_index) file_plain
3826 set all_icons
(A
$ui_index) file_fulltick
3827 set all_icons
(M
$ui_index) file_fulltick
3828 set all_icons
(D
$ui_index) file_removed
3829 set all_icons
(U
$ui_index) file_merge
3831 set all_icons
(_
$ui_workdir) file_plain
3832 set all_icons
(M
$ui_workdir) file_mod
3833 set all_icons
(D
$ui_workdir) file_question
3834 set all_icons
(U
$ui_workdir) file_merge
3835 set all_icons
(O
$ui_workdir) file_plain
3837 set max_status_desc
0
3841 {_M
"Modified, not staged"}
3842 {M_
"Staged for commit"}
3843 {MM
"Portions staged for commit"}
3844 {MD
"Staged for commit, missing"}
3846 {_O
"Untracked, not staged"}
3847 {A_
"Staged for commit"}
3848 {AM
"Portions staged for commit"}
3849 {AD
"Staged for commit, missing"}
3852 {D_
"Staged for removal"}
3853 {DO
"Staged for removal, still present"}
3855 {U_
"Requires merge resolution"}
3856 {UU
"Requires merge resolution"}
3857 {UM
"Requires merge resolution"}
3858 {UD
"Requires merge resolution"}
3860 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3861 set max_status_desc
[string length
[lindex
$i 1]]
3863 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3867 ######################################################################
3871 proc bind_button3
{w cmd
} {
3872 bind $w <Any-Button-3
> $cmd
3874 bind $w <Control-Button-1
> $cmd
3878 proc scrollbar2many
{list mode args
} {
3879 foreach w
$list {eval $w $mode $args}
3882 proc many2scrollbar
{list mode sb top bottom
} {
3883 $sb set $top $bottom
3884 foreach w
$list {$w $mode moveto
$top}
3887 proc incr_font_size
{font
{amt
1}} {
3888 set sz
[font configure
$font -size]
3890 font configure
$font -size $sz
3891 font configure
${font}bold
-size $sz
3894 proc hook_failed_popup
{hook msg
} {
3899 label
$w.m.l1
-text "$hook hook failed:" \
3904 -background white
-borderwidth 1 \
3906 -width 80 -height 10 \
3908 -yscrollcommand [list
$w.m.sby
set]
3910 -text {You must correct the above errors before committing.
} \
3914 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3915 pack
$w.m.l1
-side top
-fill x
3916 pack
$w.m.l2
-side bottom
-fill x
3917 pack
$w.m.sby
-side right
-fill y
3918 pack
$w.m.t
-side left
-fill both
-expand 1
3919 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3921 $w.m.t insert
1.0 $msg
3922 $w.m.t conf
-state disabled
3924 button
$w.ok
-text OK \
3927 -command "destroy $w"
3928 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3930 bind $w <Visibility
> "grab $w; focus $w"
3931 bind $w <Key-Return
> "destroy $w"
3932 wm title
$w "[appname] ([reponame]): error"
3936 set next_console_id
0
3938 proc new_console
{short_title long_title
} {
3939 global next_console_id console_data
3940 set w .console
[incr next_console_id
]
3941 set console_data
($w) [list
$short_title $long_title]
3942 return [console_init
$w]
3945 proc console_init
{w
} {
3946 global console_cr console_data M1B
3948 set console_cr
($w) 1.0
3951 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3956 -background white
-borderwidth 1 \
3958 -width 80 -height 10 \
3961 -yscrollcommand [list
$w.m.sby
set]
3962 label
$w.m.s
-text {Working... please
wait...
} \
3966 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3967 pack
$w.m.l1
-side top
-fill x
3968 pack
$w.m.s
-side bottom
-fill x
3969 pack
$w.m.sby
-side right
-fill y
3970 pack
$w.m.t
-side left
-fill both
-expand 1
3971 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3973 menu
$w.ctxm
-tearoff 0
3974 $w.ctxm add
command -label "Copy" \
3976 -command "tk_textCopy $w.m.t"
3977 $w.ctxm add
command -label "Select All" \
3979 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3980 $w.ctxm add
command -label "Copy All" \
3983 $w.m.t tag add sel 0.0 end
3985 $w.m.t tag remove sel 0.0 end
3988 button
$w.ok
-text {Close
} \
3991 -command "destroy $w"
3992 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3994 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3995 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3996 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3997 bind $w <Visibility
> "focus $w"
3998 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
4002 proc console_exec
{w cmd after
} {
4003 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4004 # But most users need that so we have to relogin. :-(
4007 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
4010 # -- Tcl won't let us redirect both stdout and stderr to
4011 # the same pipe. So pass it through cat...
4013 set cmd
[concat |
$cmd |
& cat]
4015 set fd_f
[open
$cmd r
]
4016 fconfigure
$fd_f -blocking 0 -translation binary
4017 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
4020 proc console_read
{w fd after
} {
4025 if {![winfo exists
$w]} {console_init
$w}
4026 $w.m.t conf
-state normal
4028 set n
[string length
$buf]
4030 set cr
[string first
"\r" $buf $c]
4031 set lf
[string first
"\n" $buf $c]
4032 if {$cr < 0} {set cr
[expr {$n + 1}]}
4033 if {$lf < 0} {set lf
[expr {$n + 1}]}
4036 $w.m.t insert end
[string range
$buf $c $lf]
4037 set console_cr
($w) [$w.m.t index
{end
-1c}]
4041 $w.m.t delete
$console_cr($w) end
4042 $w.m.t insert end
"\n"
4043 $w.m.t insert end
[string range
$buf $c $cr]
4048 $w.m.t conf
-state disabled
4052 fconfigure
$fd -blocking 1
4054 if {[catch
{close
$fd}]} {
4059 uplevel
#0 $after $w $ok
4062 fconfigure
$fd -blocking 0
4065 proc console_chain
{cmdlist w
{ok
1}} {
4067 if {[llength
$cmdlist] == 0} {
4072 set cmd
[lindex
$cmdlist 0]
4073 set cmdlist
[lrange
$cmdlist 1 end
]
4075 if {[lindex
$cmd 0] eq
{console_exec
}} {
4078 [list console_chain
$cmdlist]
4080 uplevel
#0 $cmd $cmdlist $w $ok
4087 proc console_done
{args
} {
4088 global console_cr console_data
4090 switch
-- [llength
$args] {
4092 set w
[lindex
$args 0]
4093 set ok
[lindex
$args 1]
4096 set w
[lindex
$args 1]
4097 set ok
[lindex
$args 2]
4100 error
"wrong number of args: console_done ?ignored? w ok"
4105 if {[winfo exists
$w]} {
4106 $w.m.s conf
-background green
-text {Success
}
4107 $w.ok conf
-state normal
4110 if {![winfo exists
$w]} {
4113 $w.m.s conf
-background red
-text {Error
: Command Failed
}
4114 $w.ok conf
-state normal
4117 array
unset console_cr
$w
4118 array
unset console_data
$w
4121 ######################################################################
4125 set starting_gitk_msg
{Starting gitk... please
wait...
}
4127 proc do_gitk
{revs
} {
4128 global env ui_status_value starting_gitk_msg
4130 # -- Always start gitk through whatever we were loaded with. This
4131 # lets us bypass using shell process on Windows systems.
4133 set cmd
[info nameofexecutable
]
4134 lappend cmd
[gitexec gitk
]
4140 if {[catch
{eval exec $cmd &} err
]} {
4141 error_popup
"Failed to start gitk:\n\n$err"
4143 set ui_status_value
$starting_gitk_msg
4145 if {$ui_status_value eq
$starting_gitk_msg} {
4146 set ui_status_value
{Ready.
}
4153 set fd
[open
"| git count-objects -v" r
]
4154 while {[gets
$fd line
] > 0} {
4155 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
4156 set stats
($name) $value
4162 foreach p
[glob
-directory [gitdir objects pack
] \
4165 incr packed_sz
[file size
$p]
4167 if {$packed_sz > 0} {
4168 set stats
(size-pack
) [expr {$packed_sz / 1024}]
4173 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4175 label
$w.header
-text {Database Statistics
} \
4177 pack
$w.header
-side top
-fill x
4179 frame
$w.buttons
-border 1
4180 button
$w.buttons.close
-text Close \
4182 -command [list destroy
$w]
4183 button
$w.buttons.gc
-text {Compress Database
} \
4185 -command "destroy $w;do_gc"
4186 pack
$w.buttons.close
-side right
4187 pack
$w.buttons.gc
-side left
4188 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4190 frame
$w.stat
-borderwidth 1 -relief solid
4192 {count
{Number of loose objects
}}
4193 {size
{Disk space used by loose objects
} { KiB
}}
4194 {in-pack
{Number of packed objects
}}
4195 {packs
{Number of packs
}}
4196 {size-pack
{Disk space used by packed objects
} { KiB
}}
4197 {prune-packable
{Packed objects waiting
for pruning
}}
4198 {garbage
{Garbage files
}}
4200 set name
[lindex
$s 0]
4201 set label
[lindex
$s 1]
4202 if {[catch
{set value
$stats($name)}]} continue
4203 if {[llength
$s] > 2} {
4204 set value
"$value[lindex $s 2]"
4207 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4208 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4209 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4211 pack
$w.stat
-pady 10 -padx 10
4213 bind $w <Visibility
> "grab $w; focus $w"
4214 bind $w <Key-Escape
> [list destroy
$w]
4215 bind $w <Key-Return
> [list destroy
$w]
4216 wm title
$w "[appname] ([reponame]): Database Statistics"
4221 set w
[new_console
{gc
} {Compressing the object database
}]
4223 {console_exec
{git pack-refs
--prune}}
4224 {console_exec
{git reflog expire
--all}}
4225 {console_exec
{git repack
-a -d -l}}
4226 {console_exec
{git rerere gc
}}
4230 proc do_fsck_objects
{} {
4231 set w
[new_console
{fsck-objects
} \
4232 {Verifying the object database with fsck-objects
}]
4233 set cmd
[list git fsck-objects
]
4236 lappend cmd
--strict
4237 console_exec
$w $cmd console_done
4243 global ui_comm is_quitting repo_config commit_type
4245 if {$is_quitting} return
4248 if {[winfo exists
$ui_comm]} {
4249 # -- Stash our current commit buffer.
4251 set save
[gitdir GITGUI_MSG
]
4252 set msg
[string trim
[$ui_comm get
0.0 end
]]
4253 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4254 if {(![string match amend
* $commit_type]
4255 ||
[$ui_comm edit modified
])
4258 set fd
[open
$save w
]
4259 puts
-nonewline $fd $msg
4263 catch
{file delete
$save}
4266 # -- Stash our current window geometry into this repository.
4268 set cfg_geometry
[list
]
4269 lappend cfg_geometry
[wm geometry .
]
4270 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4271 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4272 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4275 if {$cfg_geometry ne
$rc_geometry} {
4276 catch
{git config gui.geometry
$cfg_geometry}
4284 rescan
{set ui_status_value
{Ready.
}}
4287 proc unstage_helper
{txt paths
} {
4288 global file_states current_diff_path
4290 if {![lock_index begin-update
]} return
4294 foreach path
$paths {
4295 switch
-glob -- [lindex
$file_states($path) 0] {
4299 lappend pathList
$path
4300 if {$path eq
$current_diff_path} {
4301 set after
{reshow_diff
;}
4306 if {$pathList eq
{}} {
4312 [concat
$after {set ui_status_value
{Ready.
}}]
4316 proc do_unstage_selection
{} {
4317 global current_diff_path selected_paths
4319 if {[array size selected_paths
] > 0} {
4321 {Unstaging selected files from commit
} \
4322 [array names selected_paths
]
4323 } elseif
{$current_diff_path ne
{}} {
4325 "Unstaging [short_path $current_diff_path] from commit" \
4326 [list
$current_diff_path]
4330 proc add_helper
{txt paths
} {
4331 global file_states current_diff_path
4333 if {![lock_index begin-update
]} return
4337 foreach path
$paths {
4338 switch
-glob -- [lindex
$file_states($path) 0] {
4343 lappend pathList
$path
4344 if {$path eq
$current_diff_path} {
4345 set after
{reshow_diff
;}
4350 if {$pathList eq
{}} {
4356 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4360 proc do_add_selection
{} {
4361 global current_diff_path selected_paths
4363 if {[array size selected_paths
] > 0} {
4365 {Adding selected files
} \
4366 [array names selected_paths
]
4367 } elseif
{$current_diff_path ne
{}} {
4369 "Adding [short_path $current_diff_path]" \
4370 [list
$current_diff_path]
4374 proc do_add_all
{} {
4378 foreach path
[array names file_states
] {
4379 switch
-glob -- [lindex
$file_states($path) 0] {
4382 ?D
{lappend paths
$path}
4385 add_helper
{Adding all changed files
} $paths
4388 proc revert_helper
{txt paths
} {
4389 global file_states current_diff_path
4391 if {![lock_index begin-update
]} return
4395 foreach path
$paths {
4396 switch
-glob -- [lindex
$file_states($path) 0] {
4400 lappend pathList
$path
4401 if {$path eq
$current_diff_path} {
4402 set after
{reshow_diff
;}
4408 set n
[llength
$pathList]
4412 } elseif
{$n == 1} {
4413 set s
"[short_path [lindex $pathList]]"
4415 set s
"these $n files"
4418 set reply
[tk_dialog \
4420 "[appname] ([reponame])" \
4421 "Revert changes in $s?
4423 Any unadded changes will be permanently lost by the revert." \
4433 [concat
$after {set ui_status_value
{Ready.
}}]
4439 proc do_revert_selection
{} {
4440 global current_diff_path selected_paths
4442 if {[array size selected_paths
] > 0} {
4444 {Reverting selected files
} \
4445 [array names selected_paths
]
4446 } elseif
{$current_diff_path ne
{}} {
4448 "Reverting [short_path $current_diff_path]" \
4449 [list
$current_diff_path]
4453 proc do_signoff
{} {
4456 set me
[committer_ident
]
4457 if {$me eq
{}} return
4459 set sob
"Signed-off-by: $me"
4460 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4461 if {$last ne
$sob} {
4462 $ui_comm edit separator
4464 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4465 $ui_comm insert end
"\n"
4467 $ui_comm insert end
"\n$sob"
4468 $ui_comm edit separator
4473 proc do_select_commit_type
{} {
4474 global commit_type selected_commit_type
4476 if {$selected_commit_type eq
{new
}
4477 && [string match amend
* $commit_type]} {
4479 } elseif
{$selected_commit_type eq
{amend
}
4480 && ![string match amend
* $commit_type]} {
4483 # The amend request was rejected...
4485 if {![string match amend
* $commit_type]} {
4486 set selected_commit_type new
4495 proc do_credits
{} {
4496 global gitgui_credits
4498 set w .credits_dialog
4501 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4503 label
$w.header
-text {git-gui Contributors
} -font font_uibold
4504 pack
$w.header
-side top
-fill x
4507 button
$w.buttons.close
-text {Close
} \
4509 -command [list destroy
$w]
4510 pack
$w.buttons.close
-side right
4511 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4515 -background [$w.header cget
-background] \
4516 -yscrollcommand [list
$w.credits.sby
set] \
4524 scrollbar
$w.credits.sby
-command [list
$w.credits.t yview
]
4525 pack
$w.credits.sby
-side right
-fill y
4526 pack
$w.credits.t
-fill both
-expand 1
4527 pack
$w.credits
-side top
-fill both
-expand 1 -padx 5 -pady 5
4530 -text "All portions are copyrighted by their respective authors
4531 and are distributed under the GNU General Public License." \
4538 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4540 $w.credits.t insert end
"[string trim $gitgui_credits]\n"
4541 $w.credits.t conf
-state disabled
4542 $w.credits.t see
1.0
4544 bind $w <Visibility
> "grab $w; focus $w"
4545 bind $w <Key-Escape
> [list destroy
$w]
4546 wm title
$w [$w.header cget
-text]
4551 global appvers copyright
4552 global tcl_patchLevel tk_patchLevel
4556 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4558 label
$w.header
-text "About [appname]" \
4560 pack
$w.header
-side top
-fill x
4563 button
$w.buttons.close
-text {Close
} \
4565 -command [list destroy
$w]
4566 button
$w.buttons.credits
-text {Contributors
} \
4569 pack
$w.buttons.credits
-side left
4570 pack
$w.buttons.close
-side right
4571 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4574 -text "git-gui - a graphical user interface for Git.
4582 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4585 append v
"git-gui version $appvers\n"
4586 append v
"[git version]\n"
4588 if {$tcl_patchLevel eq
$tk_patchLevel} {
4589 append v
"Tcl/Tk version $tcl_patchLevel"
4591 append v
"Tcl version $tcl_patchLevel"
4592 append v
", Tk version $tk_patchLevel"
4603 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4605 menu
$w.ctxm
-tearoff 0
4606 $w.ctxm add
command \
4611 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4614 bind $w <Visibility
> "grab $w; focus $w"
4615 bind $w <Key-Escape
> "destroy $w"
4616 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4617 wm title
$w "About [appname]"
4621 proc do_options
{} {
4622 global repo_config global_config font_descs
4623 global repo_config_new global_config_new
4625 array
unset repo_config_new
4626 array
unset global_config_new
4627 foreach name
[array names repo_config
] {
4628 set repo_config_new
($name) $repo_config($name)
4631 foreach name
[array names repo_config
] {
4633 gui.diffcontext
{continue}
4635 set repo_config_new
($name) $repo_config($name)
4637 foreach name
[array names global_config
] {
4638 set global_config_new
($name) $global_config($name)
4641 set w .options_editor
4643 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4645 label
$w.header
-text "Options" \
4647 pack
$w.header
-side top
-fill x
4650 button
$w.buttons.restore
-text {Restore Defaults
} \
4652 -command do_restore_defaults
4653 pack
$w.buttons.restore
-side left
4654 button
$w.buttons.save
-text Save \
4656 -command [list do_save_config
$w]
4657 pack
$w.buttons.save
-side right
4658 button
$w.buttons.cancel
-text {Cancel
} \
4660 -command [list destroy
$w]
4661 pack
$w.buttons.cancel
-side right
-padx 5
4662 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4664 labelframe
$w.repo
-text "[reponame] Repository" \
4666 labelframe
$w.global
-text {Global
(All Repositories
)} \
4668 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4669 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4673 {t user.name
{User Name
}}
4674 {t user.email
{Email Address
}}
4676 {b merge.summary
{Summarize Merge Commits
}}
4677 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4679 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4680 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4681 {t gui.newbranchtemplate
{New Branch Name Template
}}
4683 set type [lindex
$option 0]
4684 set name
[lindex
$option 1]
4685 set text
[lindex
$option 2]
4687 foreach f
{repo global
} {
4688 switch
-glob -- $type {
4690 checkbutton
$w.
$f.
$optid -text $text \
4691 -variable ${f}_config_new
($name) \
4695 pack
$w.
$f.
$optid -side top
-anchor w
4698 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4700 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4701 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4702 spinbox
$w.
$f.
$optid.v \
4703 -textvariable ${f}_config_new
($name) \
4707 -width [expr {1 + [string length
$max]}] \
4709 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4710 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4711 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4715 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4716 entry
$w.
$f.
$optid.v \
4720 -textvariable ${f}_config_new
($name) \
4722 pack
$w.
$f.
$optid.l
-side left
-anchor w
4723 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4726 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4732 set all_fonts
[lsort
[font families
]]
4733 foreach option
$font_descs {
4734 set name
[lindex
$option 0]
4735 set font
[lindex
$option 1]
4736 set text
[lindex
$option 2]
4738 set global_config_new
(gui.
$font^^family
) \
4739 [font configure
$font -family]
4740 set global_config_new
(gui.
$font^^size
) \
4741 [font configure
$font -size]
4743 frame
$w.global.
$name
4744 label
$w.global.
$name.l
-text "$text:" -font font_ui
4745 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4746 eval tk_optionMenu
$w.global.
$name.family \
4747 global_config_new
(gui.
$font^^family
) \
4749 spinbox
$w.global.
$name.size \
4750 -textvariable global_config_new
(gui.
$font^^size
) \
4751 -from 2 -to 80 -increment 1 \
4754 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4755 pack
$w.global.
$name.size
-side right
-anchor e
4756 pack
$w.global.
$name.family
-side right
-anchor e
4757 pack
$w.global.
$name -side top
-anchor w
-fill x
4760 bind $w <Visibility
> "grab $w; focus $w"
4761 bind $w <Key-Escape
> "destroy $w"
4762 wm title
$w "[appname] ([reponame]): Options"
4766 proc do_restore_defaults
{} {
4767 global font_descs default_config repo_config
4768 global repo_config_new global_config_new
4770 foreach name
[array names default_config
] {
4771 set repo_config_new
($name) $default_config($name)
4772 set global_config_new
($name) $default_config($name)
4775 foreach option
$font_descs {
4776 set name
[lindex
$option 0]
4777 set repo_config
(gui.
$name) $default_config(gui.
$name)
4781 foreach option
$font_descs {
4782 set name
[lindex
$option 0]
4783 set font
[lindex
$option 1]
4784 set global_config_new
(gui.
$font^^family
) \
4785 [font configure
$font -family]
4786 set global_config_new
(gui.
$font^^size
) \
4787 [font configure
$font -size]
4791 proc do_save_config
{w
} {
4792 if {[catch
{save_config
} err
]} {
4793 error_popup
"Failed to completely save options:\n\n$err"
4799 proc do_windows_shortcut
{} {
4802 set fn
[tk_getSaveFile \
4804 -title "[appname] ([reponame]): Create Desktop Icon" \
4805 -initialfile "Git [reponame].bat"]
4809 puts
$fd "@ECHO Entering [reponame]"
4810 puts
$fd "@ECHO Starting git-gui... please wait..."
4811 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4812 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4813 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4814 puts
$fd " \"[file normalize $argv0]\""
4817 error_popup
"Cannot write script:\n\n$err"
4822 proc do_cygwin_shortcut
{} {
4826 set desktop
[exec cygpath \
4834 set fn
[tk_getSaveFile \
4836 -title "[appname] ([reponame]): Create Desktop Icon" \
4837 -initialdir $desktop \
4838 -initialfile "Git [reponame].bat"]
4842 set sh
[exec cygpath \
4846 set me
[exec cygpath \
4850 set gd
[exec cygpath \
4854 set gw
[exec cygpath \
4857 [file dirname [gitdir
]]]
4858 regsub
-all ' $me "'\\''" me
4859 regsub -all ' $gd "'\\''" gd
4860 puts $fd "@ECHO Entering $gw"
4861 puts $fd "@ECHO Starting git-gui... please wait..."
4862 puts -nonewline $fd "@\"$sh\" --login -c \""
4863 puts -nonewline $fd "GIT_DIR='$gd'"
4864 puts -nonewline $fd " '$me'"
4868 error_popup "Cannot write script:\n\n$err"
4873 proc do_macosx_app {} {
4876 set fn [tk_getSaveFile \
4878 -title "[appname] ([reponame]): Create Desktop Icon" \
4879 -initialdir [file join $env(HOME) Desktop] \
4880 -initialfile "Git [reponame].app"]
4883 set Contents [file join $fn Contents]
4884 set MacOS [file join $Contents MacOS]
4885 set exe [file join $MacOS git-gui]
4889 set fd [open [file join $Contents Info.plist] w]
4890 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4891 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4892 <plist version="1.0">
4894 <key>CFBundleDevelopmentRegion</key>
4895 <string>English</string>
4896 <key>CFBundleExecutable</key>
4897 <string>git-gui</string>
4898 <key>CFBundleIdentifier</key>
4899 <string>org.spearce.git-gui</string>
4900 <key>CFBundleInfoDictionaryVersion</key>
4901 <string>6.0</string>
4902 <key>CFBundlePackageType</key>
4903 <string>APPL</string>
4904 <key>CFBundleSignature</key>
4905 <string>????</string>
4906 <key>CFBundleVersion</key>
4907 <string>1.0</string>
4908 <key>NSPrincipalClass</key>
4909 <string>NSApplication</string>
4914 set fd [open $exe w]
4915 set gd [file normalize [gitdir]]
4916 set ep [file normalize [gitexec]]
4917 regsub -all ' $gd "'\\''" gd
4918 regsub
-all ' $ep "'\\''" ep
4919 puts $fd "#!/bin/sh"
4920 foreach name
[array names env
] {
4921 if {[string match GIT_
* $name]} {
4922 regsub
-all ' $env($name) "'\\''" v
4923 puts $fd "export $name='$v'"
4926 puts $fd "export PATH
='$ep':\
$PATH"
4927 puts $fd "export GIT_DIR
='$gd'"
4928 puts $fd "exec [file normalize
$argv0]"
4931 file attributes $exe -permissions u+x,g+x,o+x
4933 error_popup "Cannot
write icon
:\n\n$err"
4938 proc toggle_or_diff {w x y} {
4939 global file_states file_lists current_diff_path ui_index ui_workdir
4940 global last_clicked selected_paths
4942 set pos [split [$w index @$x,$y] .]
4943 set lno [lindex $pos 0]
4944 set col [lindex $pos 1]
4945 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4951 set last_clicked [list $w $lno]
4952 array unset selected_paths
4953 $ui_index tag remove in_sel 0.0 end
4954 $ui_workdir tag remove in_sel 0.0 end
4957 if {$current_diff_path eq $path} {
4958 set after {reshow_diff;}
4962 if {$w eq $ui_index} {
4964 "Unstaging
[short_path
$path] from commit
" \
4966 [concat $after {set ui_status_value {Ready.}}]
4967 } elseif {$w eq $ui_workdir} {
4969 "Adding
[short_path
$path]" \
4971 [concat $after {set ui_status_value {Ready.}}]
4974 show_diff $path $w $lno
4978 proc add_one_to_selection {w x y} {
4979 global file_lists last_clicked selected_paths
4981 set lno [lindex [split [$w index @$x,$y] .] 0]
4982 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4988 if {$last_clicked ne {}
4989 && [lindex $last_clicked 0] ne $w} {
4990 array unset selected_paths
4991 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4994 set last_clicked [list $w $lno]
4995 if {[catch {set in_sel $selected_paths($path)}]} {
4999 unset selected_paths($path)
5000 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
5002 set selected_paths($path) 1
5003 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
5007 proc add_range_to_selection {w x y} {
5008 global file_lists last_clicked selected_paths
5010 if {[lindex $last_clicked 0] ne $w} {
5011 toggle_or_diff $w $x $y
5015 set lno [lindex [split [$w index @$x,$y] .] 0]
5016 set lc [lindex $last_clicked 1]
5025 foreach path [lrange $file_lists($w) \
5026 [expr {$begin - 1}] \
5027 [expr {$end - 1}]] {
5028 set selected_paths($path) 1
5030 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5033 ######################################################################
5037 set cursor_ptr arrow
5038 font create font_diff -family Courier -size 10
5042 eval font configure font_ui [font actual [.dummy cget -font]]
5046 font create font_uibold
5047 font create font_diffbold
5052 } elseif {[is_MacOSX]} {
5060 proc apply_config {} {
5061 global repo_config font_descs
5063 foreach option $font_descs {
5064 set name [lindex $option 0]
5065 set font [lindex $option 1]
5067 foreach {cn cv} $repo_config(gui.$name) {
5068 font configure $font $cn $cv
5071 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
5073 foreach {cn cv} [font configure $font] {
5074 font configure ${font}bold $cn $cv
5076 font configure ${font}bold -weight bold
5080 set default_config(merge.summary) false
5081 set default_config(merge.verbosity) 2
5082 set default_config(user.name) {}
5083 set default_config(user.email) {}
5085 set default_config(gui.trustmtime) false
5086 set default_config(gui.diffcontext) 5
5087 set default_config(gui.newbranchtemplate) {}
5088 set default_config(gui.fontui) [font configure font_ui]
5089 set default_config(gui.fontdiff) [font configure font_diff]
5091 {fontui font_ui {Main Font}}
5092 {fontdiff font_diff {Diff/Console Font}}
5097 ######################################################################
5099 ## feature option selection
5101 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5106 if {$subcommand eq {gui.sh}} {
5109 if {$subcommand eq {gui} && [llength $argv] > 0} {
5110 set subcommand [lindex $argv 0]
5111 set argv [lrange $argv 1 end]
5114 enable_option multicommit
5115 enable_option branch
5116 enable_option transport
5118 switch -- $subcommand {
5123 disable_option multicommit
5124 disable_option branch
5125 disable_option transport
5128 enable_option singlecommit
5130 disable_option multicommit
5131 disable_option branch
5132 disable_option transport
5136 ######################################################################
5144 menu .mbar -tearoff 0
5145 .mbar add cascade -label Repository -menu .mbar.repository
5146 .mbar add cascade -label Edit -menu .mbar.edit
5147 if {[is_enabled branch]} {
5148 .mbar add cascade -label Branch -menu .mbar.branch
5150 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5151 .mbar add cascade -label Commit -menu .mbar.commit
5153 if {[is_enabled transport]} {
5154 .mbar add cascade -label Merge -menu .mbar.merge
5155 .mbar add cascade -label Fetch -menu .mbar.fetch
5156 .mbar add cascade -label Push -menu .mbar.push
5158 . configure -menu .mbar
5160 # -- Repository Menu
5162 menu .mbar.repository
5164 .mbar.repository add command \
5165 -label {Browse Current Branch} \
5166 -command {new_browser $current_branch} \
5168 trace add variable current_branch write ".mbar.repository entryconf
[.mbar.repository index last
] -label \"Browse \
$current_branch\" ;#"
5169 .mbar.repository add separator
5171 .mbar.repository add
command \
5172 -label {Visualize Current Branch
} \
5173 -command {do_gitk
$current_branch} \
5175 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5176 .mbar.repository add
command \
5177 -label {Visualize All Branches
} \
5178 -command {do_gitk
--all} \
5180 .mbar.repository add separator
5182 if {[is_enabled multicommit
]} {
5183 .mbar.repository add
command -label {Database Statistics
} \
5187 .mbar.repository add
command -label {Compress Database
} \
5191 .mbar.repository add
command -label {Verify Database
} \
5192 -command do_fsck_objects \
5195 .mbar.repository add separator
5198 .mbar.repository add
command \
5199 -label {Create Desktop Icon
} \
5200 -command do_cygwin_shortcut \
5202 } elseif
{[is_Windows
]} {
5203 .mbar.repository add
command \
5204 -label {Create Desktop Icon
} \
5205 -command do_windows_shortcut \
5207 } elseif
{[is_MacOSX
]} {
5208 .mbar.repository add
command \
5209 -label {Create Desktop Icon
} \
5210 -command do_macosx_app \
5215 .mbar.repository add
command -label Quit \
5217 -accelerator $M1T-Q \
5223 .mbar.edit add
command -label Undo \
5224 -command {catch
{[focus
] edit undo
}} \
5225 -accelerator $M1T-Z \
5227 .mbar.edit add
command -label Redo \
5228 -command {catch
{[focus
] edit redo
}} \
5229 -accelerator $M1T-Y \
5231 .mbar.edit add separator
5232 .mbar.edit add
command -label Cut \
5233 -command {catch
{tk_textCut
[focus
]}} \
5234 -accelerator $M1T-X \
5236 .mbar.edit add
command -label Copy \
5237 -command {catch
{tk_textCopy
[focus
]}} \
5238 -accelerator $M1T-C \
5240 .mbar.edit add
command -label Paste \
5241 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
5242 -accelerator $M1T-V \
5244 .mbar.edit add
command -label Delete \
5245 -command {catch
{[focus
] delete sel.first sel.last
}} \
5248 .mbar.edit add separator
5249 .mbar.edit add
command -label {Select All
} \
5250 -command {catch
{[focus
] tag add sel
0.0 end
}} \
5251 -accelerator $M1T-A \
5256 if {[is_enabled branch
]} {
5259 .mbar.branch add
command -label {Create...
} \
5260 -command do_create_branch \
5261 -accelerator $M1T-N \
5263 lappend disable_on_lock
[list .mbar.branch entryconf \
5264 [.mbar.branch index last
] -state]
5266 .mbar.branch add
command -label {Delete...
} \
5267 -command do_delete_branch \
5269 lappend disable_on_lock
[list .mbar.branch entryconf \
5270 [.mbar.branch index last
] -state]
5272 .mbar.branch add
command -label {Reset...
} \
5273 -command do_reset_hard \
5275 lappend disable_on_lock
[list .mbar.branch entryconf \
5276 [.mbar.branch index last
] -state]
5281 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
5284 .mbar.commit add radiobutton \
5285 -label {New Commit
} \
5286 -command do_select_commit_type \
5287 -variable selected_commit_type \
5290 lappend disable_on_lock \
5291 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5293 .mbar.commit add radiobutton \
5294 -label {Amend Last Commit
} \
5295 -command do_select_commit_type \
5296 -variable selected_commit_type \
5299 lappend disable_on_lock \
5300 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5302 .mbar.commit add separator
5304 .mbar.commit add
command -label Rescan \
5305 -command do_rescan \
5308 lappend disable_on_lock \
5309 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5311 .mbar.commit add
command -label {Add To Commit
} \
5312 -command do_add_selection \
5314 lappend disable_on_lock \
5315 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5317 .mbar.commit add
command -label {Add Existing To Commit
} \
5318 -command do_add_all \
5319 -accelerator $M1T-I \
5321 lappend disable_on_lock \
5322 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5324 .mbar.commit add
command -label {Unstage From Commit
} \
5325 -command do_unstage_selection \
5327 lappend disable_on_lock \
5328 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5330 .mbar.commit add
command -label {Revert Changes
} \
5331 -command do_revert_selection \
5333 lappend disable_on_lock \
5334 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5336 .mbar.commit add separator
5338 .mbar.commit add
command -label {Sign Off
} \
5339 -command do_signoff \
5340 -accelerator $M1T-S \
5343 .mbar.commit add
command -label Commit \
5344 -command do_commit \
5345 -accelerator $M1T-Return \
5347 lappend disable_on_lock \
5348 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5353 if {[is_enabled branch
]} {
5355 .mbar.merge add
command -label {Local Merge...
} \
5356 -command do_local_merge \
5358 lappend disable_on_lock \
5359 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5360 .mbar.merge add
command -label {Abort Merge...
} \
5361 -command do_reset_hard \
5363 lappend disable_on_lock \
5364 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5370 if {[is_enabled transport
]} {
5374 .mbar.push add
command -label {Push...
} \
5375 -command do_push_anywhere \
5380 # -- Apple Menu (Mac OS X only)
5382 .mbar add cascade
-label Apple
-menu .mbar.apple
5385 .mbar.apple add
command -label "About [appname]" \
5388 .mbar.apple add
command -label "Options..." \
5389 -command do_options \
5394 .mbar.edit add separator
5395 .mbar.edit add
command -label {Options...
} \
5396 -command do_options \
5401 if {[file exists
/usr
/local
/miga
/lib
/gui-miga
]
5402 && [file exists .pvcsrc
]} {
5404 global ui_status_value
5405 if {![lock_index update
]} return
5406 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5407 set miga_fd
[open
"|$cmd" r
]
5408 fconfigure
$miga_fd -blocking 0
5409 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
5410 set ui_status_value
{Running miga...
}
5412 proc miga_done
{fd
} {
5417 rescan
[list
set ui_status_value
{Ready.
}]
5420 .mbar add cascade
-label Tools
-menu .mbar.tools
5422 .mbar.tools add
command -label "Migrate" \
5425 lappend disable_on_lock \
5426 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
5432 .mbar add cascade
-label Help
-menu .mbar.
help
5436 .mbar.
help add
command -label "About [appname]" \
5442 catch
{set browser
$repo_config(instaweb.browser
)}
5443 set doc_path
[file dirname [gitexec
]]
5444 set doc_path
[file join $doc_path Documentation index.html
]
5447 set doc_path
[exec cygpath
--mixed $doc_path]
5450 if {$browser eq
{}} {
5453 } elseif
{[is_Cygwin
]} {
5454 set program_files
[file dirname [exec cygpath
--windir]]
5455 set program_files
[file join $program_files {Program Files
}]
5456 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
5457 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
5458 if {[file exists
$firefox]} {
5459 set browser
$firefox
5460 } elseif
{[file exists
$ie]} {
5463 unset program_files firefox ie
5467 if {[file isfile
$doc_path]} {
5468 set doc_url
"file:$doc_path"
5470 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
5473 if {$browser ne
{}} {
5474 .mbar.
help add
command -label {Online Documentation
} \
5475 -command [list
exec $browser $doc_url &] \
5478 unset browser doc_path doc_url
5480 # -- Standard bindings
5482 bind .
<Destroy
> do_quit
5483 bind all
<$M1B-Key-q> do_quit
5484 bind all
<$M1B-Key-Q> do_quit
5485 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
5486 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
5488 # -- Not a normal commit type invocation? Do that instead!
5490 switch
-- $subcommand {
5493 puts
"git-gui version $appvers"
5497 if {[llength
$argv] != 1} {
5498 puts stderr
"usage: $argv0 browser commit"
5501 set current_branch
[lindex
$argv 0]
5502 new_browser
$current_branch
5506 if {[llength
$argv] != 2} {
5507 puts stderr
"usage: $argv0 blame commit path"
5510 set current_branch
[lindex
$argv 0]
5511 show_blame
$current_branch [lindex
$argv 1]
5516 if {[llength
$argv] != 0} {
5517 puts
-nonewline stderr
"usage: $argv0"
5518 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
5519 puts
-nonewline stderr
" $subcommand"
5524 # fall through to setup UI for commits
5527 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
5538 -text {Current Branch
:} \
5543 -textvariable current_branch \
5547 pack .branch.l1
-side left
5548 pack .branch.cb
-side left
-fill x
5549 pack .branch
-side top
-fill x
5551 # -- Main Window Layout
5553 panedwindow .vpane
-orient vertical
5554 panedwindow .vpane.files
-orient horizontal
5555 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
5556 pack .vpane
-anchor n
-side top
-fill both
-expand 1
5558 # -- Index File List
5560 frame .vpane.files.index
-height 100 -width 200
5561 label .vpane.files.index.title
-text {Changes To Be Committed
} \
5564 text
$ui_index -background white
-borderwidth 0 \
5565 -width 20 -height 10 \
5568 -cursor $cursor_ptr \
5569 -xscrollcommand {.vpane.files.index.sx
set} \
5570 -yscrollcommand {.vpane.files.index.sy
set} \
5572 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
5573 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
5574 pack .vpane.files.index.title
-side top
-fill x
5575 pack .vpane.files.index.sx
-side bottom
-fill x
5576 pack .vpane.files.index.sy
-side right
-fill y
5577 pack
$ui_index -side left
-fill both
-expand 1
5578 .vpane.files add .vpane.files.index
-sticky nsew
5580 # -- Working Directory File List
5582 frame .vpane.files.workdir
-height 100 -width 200
5583 label .vpane.files.workdir.title
-text {Changed But Not Updated
} \
5586 text
$ui_workdir -background white
-borderwidth 0 \
5587 -width 20 -height 10 \
5590 -cursor $cursor_ptr \
5591 -xscrollcommand {.vpane.files.workdir.sx
set} \
5592 -yscrollcommand {.vpane.files.workdir.sy
set} \
5594 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
5595 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
5596 pack .vpane.files.workdir.title
-side top
-fill x
5597 pack .vpane.files.workdir.sx
-side bottom
-fill x
5598 pack .vpane.files.workdir.sy
-side right
-fill y
5599 pack
$ui_workdir -side left
-fill both
-expand 1
5600 .vpane.files add .vpane.files.workdir
-sticky nsew
5602 foreach i
[list
$ui_index $ui_workdir] {
5603 $i tag conf in_diff
-font font_uibold
5604 $i tag conf in_sel \
5605 -background [$i cget
-foreground] \
5606 -foreground [$i cget
-background]
5610 # -- Diff and Commit Area
5612 frame .vpane.lower
-height 300 -width 400
5613 frame .vpane.lower.commarea
5614 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
5615 pack .vpane.lower.commarea
-side top
-fill x
5616 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
5617 .vpane add .vpane.lower
-sticky nsew
5619 # -- Commit Area Buttons
5621 frame .vpane.lower.commarea.buttons
5622 label .vpane.lower.commarea.buttons.l
-text {} \
5626 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
5627 pack .vpane.lower.commarea.buttons
-side left
-fill y
5629 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
5630 -command do_rescan \
5632 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
5633 lappend disable_on_lock \
5634 {.vpane.lower.commarea.buttons.rescan conf
-state}
5636 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
5637 -command do_add_all \
5639 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
5640 lappend disable_on_lock \
5641 {.vpane.lower.commarea.buttons.incall conf
-state}
5643 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
5644 -command do_signoff \
5646 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
5648 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
5649 -command do_commit \
5651 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
5652 lappend disable_on_lock \
5653 {.vpane.lower.commarea.buttons.commit conf
-state}
5655 # -- Commit Message Buffer
5657 frame .vpane.lower.commarea.buffer
5658 frame .vpane.lower.commarea.buffer.header
5659 set ui_comm .vpane.lower.commarea.buffer.t
5660 set ui_coml .vpane.lower.commarea.buffer.header.l
5661 radiobutton .vpane.lower.commarea.buffer.header.new \
5662 -text {New Commit
} \
5663 -command do_select_commit_type \
5664 -variable selected_commit_type \
5667 lappend disable_on_lock \
5668 [list .vpane.lower.commarea.buffer.header.new conf
-state]
5669 radiobutton .vpane.lower.commarea.buffer.header.amend \
5670 -text {Amend Last Commit
} \
5671 -command do_select_commit_type \
5672 -variable selected_commit_type \
5675 lappend disable_on_lock \
5676 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
5681 proc trace_commit_type
{varname args
} {
5682 global ui_coml commit_type
5683 switch
-glob -- $commit_type {
5684 initial
{set txt
{Initial Commit Message
:}}
5685 amend
{set txt
{Amended Commit Message
:}}
5686 amend-initial
{set txt
{Amended Initial Commit Message
:}}
5687 amend-merge
{set txt
{Amended Merge Commit Message
:}}
5688 merge
{set txt
{Merge Commit Message
:}}
5689 * {set txt
{Commit Message
:}}
5691 $ui_coml conf
-text $txt
5693 trace add variable commit_type
write trace_commit_type
5694 pack
$ui_coml -side left
-fill x
5695 pack .vpane.lower.commarea.buffer.header.amend
-side right
5696 pack .vpane.lower.commarea.buffer.header.new
-side right
5698 text
$ui_comm -background white
-borderwidth 1 \
5701 -autoseparators true \
5703 -width 75 -height 9 -wrap none \
5705 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
5706 scrollbar .vpane.lower.commarea.buffer.sby \
5707 -command [list
$ui_comm yview
]
5708 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
5709 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
5710 pack
$ui_comm -side left
-fill y
5711 pack .vpane.lower.commarea.buffer
-side left
-fill y
5713 # -- Commit Message Buffer Context Menu
5715 set ctxm .vpane.lower.commarea.buffer.ctxm
5716 menu
$ctxm -tearoff 0
5720 -command {tk_textCut
$ui_comm}
5724 -command {tk_textCopy
$ui_comm}
5728 -command {tk_textPaste
$ui_comm}
5732 -command {$ui_comm delete sel.first sel.last
}
5735 -label {Select All
} \
5737 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
5742 $ui_comm tag add sel
0.0 end
5743 tk_textCopy
$ui_comm
5744 $ui_comm tag remove sel
0.0 end
5751 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
5755 proc trace_current_diff_path
{varname args
} {
5756 global current_diff_path diff_actions file_states
5757 if {$current_diff_path eq
{}} {
5763 set p
$current_diff_path
5764 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
5766 set p
[escape_path
$p]
5770 .vpane.lower.
diff.header.status configure
-text $s
5771 .vpane.lower.
diff.header.
file configure
-text $f
5772 .vpane.lower.
diff.header.path configure
-text $p
5773 foreach w
$diff_actions {
5777 trace add variable current_diff_path
write trace_current_diff_path
5779 frame .vpane.lower.
diff.header
-background orange
5780 label .vpane.lower.
diff.header.status \
5781 -background orange \
5782 -width $max_status_desc \
5786 label .vpane.lower.
diff.header.
file \
5787 -background orange \
5791 label .vpane.lower.
diff.header.path \
5792 -background orange \
5796 pack .vpane.lower.
diff.header.status
-side left
5797 pack .vpane.lower.
diff.header.
file -side left
5798 pack .vpane.lower.
diff.header.path
-fill x
5799 set ctxm .vpane.lower.
diff.header.ctxm
5800 menu
$ctxm -tearoff 0
5809 -- $current_diff_path
5811 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5812 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
5816 frame .vpane.lower.
diff.body
5817 set ui_diff .vpane.lower.
diff.body.t
5818 text
$ui_diff -background white
-borderwidth 0 \
5819 -width 80 -height 15 -wrap none \
5821 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
5822 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
5824 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
5825 -command [list
$ui_diff xview
]
5826 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
5827 -command [list
$ui_diff yview
]
5828 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
5829 pack .vpane.lower.
diff.body.sby
-side right
-fill y
5830 pack
$ui_diff -side left
-fill both
-expand 1
5831 pack .vpane.lower.
diff.header
-side top
-fill x
5832 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
5834 $ui_diff tag conf d_cr
-elide true
5835 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
5836 $ui_diff tag conf d_
+ -foreground {#00a000}
5837 $ui_diff tag conf d_-
-foreground red
5839 $ui_diff tag conf d_
++ -foreground {#00a000}
5840 $ui_diff tag conf d_--
-foreground red
5841 $ui_diff tag conf d_
+s \
5842 -foreground {#00a000} \
5843 -background {#e2effa}
5844 $ui_diff tag conf d_-s \
5846 -background {#e2effa}
5847 $ui_diff tag conf d_s
+ \
5848 -foreground {#00a000} \
5850 $ui_diff tag conf d_s- \
5854 $ui_diff tag conf d
<<<<<<< \
5855 -foreground orange \
5857 $ui_diff tag conf d
======= \
5858 -foreground orange \
5860 $ui_diff tag conf d
>>>>>>> \
5861 -foreground orange \
5864 $ui_diff tag raise sel
5866 # -- Diff Body Context Menu
5868 set ctxm .vpane.lower.
diff.body.ctxm
5869 menu
$ctxm -tearoff 0
5873 -command reshow_diff
5874 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5878 -command {tk_textCopy
$ui_diff}
5879 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5881 -label {Select All
} \
5883 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
5884 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5889 $ui_diff tag add sel
0.0 end
5890 tk_textCopy
$ui_diff
5891 $ui_diff tag remove sel
0.0 end
5893 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5896 -label {Apply
/Reverse Hunk
} \
5898 -command {apply_hunk
$cursorX $cursorY}
5899 set ui_diff_applyhunk
[$ctxm index last
]
5900 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
5903 -label {Decrease Font Size
} \
5905 -command {incr_font_size font_diff
-1}
5906 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5908 -label {Increase Font Size
} \
5910 -command {incr_font_size font_diff
1}
5911 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5914 -label {Show Less Context
} \
5916 -command {if {$repo_config(gui.diffcontext
) >= 2} {
5917 incr repo_config
(gui.diffcontext
) -1
5920 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5922 -label {Show More Context
} \
5925 incr repo_config
(gui.diffcontext
)
5928 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5930 $ctxm add
command -label {Options...
} \
5933 bind_button3
$ui_diff "
5936 if {\$ui_index eq \$current_diff_side} {
5937 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5939 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5941 tk_popup $ctxm %X %Y
5943 unset ui_diff_applyhunk
5947 label .status
-textvariable ui_status_value \
5953 pack .status
-anchor w
-side bottom
-fill x
5958 set gm
$repo_config(gui.geometry
)
5959 wm geometry .
[lindex
$gm 0]
5960 .vpane sash place
0 \
5961 [lindex
[.vpane sash coord
0] 0] \
5963 .vpane.files sash place
0 \
5965 [lindex
[.vpane.files sash coord
0] 1]
5971 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
5972 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
5973 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
5974 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
5975 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
5976 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
5977 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
5978 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
5979 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
5980 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5981 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5983 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
5984 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
5985 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
5986 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
5987 bind $ui_diff <$M1B-Key-v> {break}
5988 bind $ui_diff <$M1B-Key-V> {break}
5989 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5990 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5991 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
5992 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
5993 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
5994 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
5995 bind $ui_diff <Button-1
> {focus
%W
}
5997 if {[is_enabled branch
]} {
5998 bind .
<$M1B-Key-n> do_create_branch
5999 bind .
<$M1B-Key-N> do_create_branch
6002 bind all
<Key-F5
> do_rescan
6003 bind all
<$M1B-Key-r> do_rescan
6004 bind all
<$M1B-Key-R> do_rescan
6005 bind .
<$M1B-Key-s> do_signoff
6006 bind .
<$M1B-Key-S> do_signoff
6007 bind .
<$M1B-Key-i> do_add_all
6008 bind .
<$M1B-Key-I> do_add_all
6009 bind .
<$M1B-Key-Return> do_commit
6010 foreach i
[list
$ui_index $ui_workdir] {
6011 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
6012 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
6013 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
6017 set file_lists
($ui_index) [list
]
6018 set file_lists
($ui_workdir) [list
]
6020 wm title .
"[appname] ([file normalize [file dirname [gitdir]]])"
6021 focus
-force $ui_comm
6023 # -- Warn the user about environmental problems. Cygwin's Tcl
6024 # does *not* pass its env array onto any processes it spawns.
6025 # This means that git processes get none of our environment.
6030 set msg
"Possible environment issues exist.
6032 The following environment variables are probably
6033 going to be ignored by any Git subprocess run
6037 foreach name
[array names env
] {
6038 switch
-regexp -- $name {
6039 {^GIT_INDEX_FILE$
} -
6040 {^GIT_OBJECT_DIRECTORY$
} -
6041 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
6043 {^GIT_EXTERNAL_DIFF$
} -
6047 {^GIT_CONFIG_LOCAL$
} -
6048 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
6049 append msg
" - $name\n"
6052 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
6053 append msg
" - $name\n"
6055 set suggest_user
$name
6059 if {$ignored_env > 0} {
6061 This is due to a known issue with the
6062 Tcl binary distributed by Cygwin."
6064 if {$suggest_user ne
{}} {
6067 A good replacement for $suggest_user
6068 is placing values for the user.name and
6069 user.email settings into your personal
6075 unset ignored_env msg suggest_user name
6078 # -- Only initialize complex UI if we are going to stay running.
6080 if {[is_enabled transport
]} {
6084 populate_branch_menu
6089 # -- Only suggest a gc run if we are going to stay running.
6091 if {[is_enabled multicommit
]} {
6092 set object_limit
2000
6093 if {[is_Windows
]} {set object_limit
200}
6094 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
6095 if {$objects_current >= $object_limit} {
6097 "This repository currently has $objects_current loose objects.
6099 To maintain optimal performance it is strongly
6100 recommended that you compress the database
6101 when more than $object_limit loose objects exist.
6103 Compress the database now?"] eq
yes} {
6107 unset object_limit _junk objects_current
6110 lock_index begin-read