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
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
43 return [eval [concat
[list
file join $_gitdir] $args]]
48 if {$_gitexec eq
{}} {
49 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
50 error
"Git not installed?\n\n$err"
56 return [eval [concat
[list
file join $_gitexec] $args]]
65 global tcl_platform tk_library
66 if {[tk windowingsystem
] eq
{aqua
}} {
74 if {$tcl_platform(platform
) eq
{windows
}} {
81 global tcl_platform _iscygwin
82 if {$_iscygwin eq
{}} {
83 if {$tcl_platform(platform
) eq
{windows
}} {
84 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
96 proc is_enabled
{option
} {
97 global enabled_options
98 if {[catch
{set on
$enabled_options($option)}]} {return 0}
102 proc enable_option
{option
} {
103 global enabled_options
104 set enabled_options
($option) 1
107 proc disable_option
{option
} {
108 global enabled_options
109 set enabled_options
($option) 0
112 ######################################################################
116 proc is_many_config
{name
} {
117 switch
-glob -- $name {
126 proc is_config_true
{name
} {
128 if {[catch
{set v
$repo_config($name)}]} {
130 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
137 proc load_config
{include_global
} {
138 global repo_config global_config default_config
140 array
unset global_config
141 if {$include_global} {
143 set fd_rc
[open
"| git config --global --list" r
]
144 while {[gets
$fd_rc line
] >= 0} {
145 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
146 if {[is_many_config
$name]} {
147 lappend global_config
($name) $value
149 set global_config
($name) $value
157 array
unset repo_config
159 set fd_rc
[open
"| git config --list" r
]
160 while {[gets
$fd_rc line
] >= 0} {
161 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
162 if {[is_many_config
$name]} {
163 lappend repo_config
($name) $value
165 set repo_config
($name) $value
172 foreach name
[array names default_config
] {
173 if {[catch
{set v
$global_config($name)}]} {
174 set global_config
($name) $default_config($name)
176 if {[catch
{set v
$repo_config($name)}]} {
177 set repo_config
($name) $default_config($name)
182 proc save_config
{} {
183 global default_config font_descs
184 global repo_config global_config
185 global repo_config_new global_config_new
187 foreach option
$font_descs {
188 set name
[lindex
$option 0]
189 set font
[lindex
$option 1]
190 font configure
$font \
191 -family $global_config_new(gui.
$font^^family
) \
192 -size $global_config_new(gui.
$font^^size
)
193 font configure
${font}bold \
194 -family $global_config_new(gui.
$font^^family
) \
195 -size $global_config_new(gui.
$font^^size
)
196 set global_config_new
(gui.
$name) [font configure
$font]
197 unset global_config_new
(gui.
$font^^family
)
198 unset global_config_new
(gui.
$font^^size
)
201 foreach name
[array names default_config
] {
202 set value
$global_config_new($name)
203 if {$value ne
$global_config($name)} {
204 if {$value eq
$default_config($name)} {
205 catch
{git config
--global --unset $name}
207 regsub
-all "\[{}\]" $value {"} value
208 git config --global $name $value
210 set global_config($name) $value
211 if {$value eq $repo_config($name)} {
212 catch {git config --unset $name}
213 set repo_config($name) $value
218 foreach name [array names default_config] {
219 set value $repo_config_new($name)
220 if {$value ne $repo_config($name)} {
221 if {$value eq $global_config($name)} {
222 catch {git config --unset $name}
224 regsub -all "\
[{}\
]" $value {"} value
225 git config
$name $value
227 set repo_config
($name) $value
232 ######################################################################
237 return [eval exec git
$args]
240 proc error_popup
{msg
} {
242 if {[reponame
] ne
{}} {
243 append title
" ([reponame])"
245 set cmd
[list tk_messageBox \
248 -title "$title: error" \
250 if {[winfo ismapped .
]} {
251 lappend cmd
-parent .
256 proc warn_popup
{msg
} {
258 if {[reponame
] ne
{}} {
259 append title
" ([reponame])"
261 set cmd
[list tk_messageBox \
264 -title "$title: warning" \
266 if {[winfo ismapped .
]} {
267 lappend cmd
-parent .
272 proc info_popup
{msg
{parent .
}} {
274 if {[reponame
] ne
{}} {
275 append title
" ([reponame])"
285 proc ask_popup
{msg
} {
287 if {[reponame
] ne
{}} {
288 append title
" ([reponame])"
290 return [tk_messageBox \
298 ######################################################################
305 if {[catch
{set v
[git
--version]} err
]} {
306 catch
{wm withdraw .
}
307 error_popup
"Cannot determine Git version:
311 [appname] requires Git $req_maj.$req_min or later."
314 if {[regexp
{^git version
(\d
+)\.
(\d
+)} $v _junk act_maj act_min
]} {
315 if {$act_maj < $req_maj
316 ||
($act_maj == $req_maj && $act_min < $req_min)} {
317 catch
{wm withdraw .
}
318 error_popup
"[appname] requires Git $req_maj.$req_min or later.
324 catch
{wm withdraw .
}
325 error_popup
"Cannot parse Git version string:\n\n$v"
328 unset -nocomplain v _junk act_maj act_min req_maj req_min
330 ######################################################################
334 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
335 && [catch
{set _gitdir
[git rev-parse
--git-dir]} err
]} {
336 catch
{wm withdraw .
}
337 error_popup
"Cannot find the git directory:\n\n$err"
340 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
341 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
343 if {![file isdirectory
$_gitdir]} {
344 catch
{wm withdraw .
}
345 error_popup
"Git directory not found:\n\n$_gitdir"
348 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
349 catch
{wm withdraw .
}
350 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
353 if {[catch
{cd [file dirname $_gitdir]} err
]} {
354 catch
{wm withdraw .
}
355 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
358 set _reponame
[lindex
[file split \
359 [file normalize
[file dirname $_gitdir]]] \
362 ######################################################################
366 set current_diff_path
{}
367 set current_diff_side
{}
368 set diff_actions
[list
]
369 set ui_status_value
{Initializing...
}
373 set MERGE_HEAD
[list
]
376 set current_branch
{}
377 set current_diff_path
{}
378 set selected_commit_type new
380 ######################################################################
388 set disable_on_lock
[list
]
389 set index_lock_type none
391 proc lock_index
{type} {
392 global index_lock_type disable_on_lock
394 if {$index_lock_type eq
{none
}} {
395 set index_lock_type
$type
396 foreach w
$disable_on_lock {
397 uplevel
#0 $w disabled
400 } elseif
{$index_lock_type eq
"begin-$type"} {
401 set index_lock_type
$type
407 proc unlock_index
{} {
408 global index_lock_type disable_on_lock
410 set index_lock_type none
411 foreach w
$disable_on_lock {
416 ######################################################################
420 proc repository_state
{ctvar hdvar mhvar
} {
421 global current_branch
422 upvar
$ctvar ct
$hdvar hd
$mhvar mh
426 if {[catch
{set current_branch
[git symbolic-ref HEAD
]}]} {
427 set current_branch
{}
429 regsub ^refs
/((heads|tags|remotes
)/)? \
435 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
441 set merge_head
[gitdir MERGE_HEAD
]
442 if {[file exists
$merge_head]} {
444 set fd_mh
[open
$merge_head r
]
445 while {[gets
$fd_mh line
] >= 0} {
456 global PARENT empty_tree
458 set p
[lindex
$PARENT 0]
462 if {$empty_tree eq
{}} {
463 set empty_tree
[git mktree
<< {}]
468 proc rescan
{after
{honor_trustmtime
1}} {
469 global HEAD PARENT MERGE_HEAD commit_type
470 global ui_index ui_workdir ui_status_value ui_comm
471 global rescan_active file_states
474 if {$rescan_active > 0 ||
![lock_index
read]} return
476 repository_state newType newHEAD newMERGE_HEAD
477 if {[string match amend
* $commit_type]
478 && $newType eq
{normal
}
479 && $newHEAD eq
$HEAD} {
483 set MERGE_HEAD
$newMERGE_HEAD
484 set commit_type
$newType
487 array
unset file_states
489 if {![$ui_comm edit modified
]
490 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
491 if {[load_message GITGUI_MSG
]} {
492 } elseif
{[load_message MERGE_MSG
]} {
493 } elseif
{[load_message SQUASH_MSG
]} {
496 $ui_comm edit modified false
499 if {[is_enabled branch
]} {
504 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
505 rescan_stage2
{} $after
508 set ui_status_value
{Refreshing
file status...
}
509 set cmd
[list git update-index
]
511 lappend cmd
--unmerged
512 lappend cmd
--ignore-missing
513 lappend cmd
--refresh
514 set fd_rf
[open
"| $cmd" r
]
515 fconfigure
$fd_rf -blocking 0 -translation binary
516 fileevent
$fd_rf readable \
517 [list rescan_stage2
$fd_rf $after]
521 proc rescan_stage2
{fd after
} {
522 global ui_status_value
523 global rescan_active buf_rdi buf_rdf buf_rlo
527 if {![eof
$fd]} return
531 set ls_others
[list | git ls-files
--others -z \
532 --exclude-per-directory=.gitignore
]
533 set info_exclude
[gitdir info exclude
]
534 if {[file readable
$info_exclude]} {
535 lappend ls_others
"--exclude-from=$info_exclude"
543 set ui_status_value
{Scanning
for modified files ...
}
544 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
545 set fd_df
[open
"| git diff-files -z" r
]
546 set fd_lo
[open
$ls_others r
]
548 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
549 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
550 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
551 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
552 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
553 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
556 proc load_message
{file} {
560 if {[file isfile
$f]} {
561 if {[catch
{set fd
[open
$f r
]}]} {
564 set content
[string trim
[read $fd]]
566 regsub
-all -line {[ \r\t]+$
} $content {} content
567 $ui_comm delete
0.0 end
568 $ui_comm insert end
$content
574 proc read_diff_index
{fd after
} {
577 append buf_rdi
[read $fd]
579 set n
[string length
$buf_rdi]
581 set z1
[string first
"\0" $buf_rdi $c]
584 set z2
[string first
"\0" $buf_rdi $z1]
588 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
589 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
591 [encoding convertfrom
$p] \
593 [list
[lindex
$i 0] [lindex
$i 2]] \
599 set buf_rdi
[string range
$buf_rdi $c end
]
604 rescan_done
$fd buf_rdi
$after
607 proc read_diff_files
{fd after
} {
610 append buf_rdf
[read $fd]
612 set n
[string length
$buf_rdf]
614 set z1
[string first
"\0" $buf_rdf $c]
617 set z2
[string first
"\0" $buf_rdf $z1]
621 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
622 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
624 [encoding convertfrom
$p] \
627 [list
[lindex
$i 0] [lindex
$i 2]]
632 set buf_rdf
[string range
$buf_rdf $c end
]
637 rescan_done
$fd buf_rdf
$after
640 proc read_ls_others
{fd after
} {
643 append buf_rlo
[read $fd]
644 set pck
[split $buf_rlo "\0"]
645 set buf_rlo
[lindex
$pck end
]
646 foreach p
[lrange
$pck 0 end-1
] {
647 merge_state
[encoding convertfrom
$p] ?O
649 rescan_done
$fd buf_rlo
$after
652 proc rescan_done
{fd buf after
} {
654 global file_states repo_config
657 if {![eof
$fd]} return
660 if {[incr rescan_active
-1] > 0} return
669 proc prune_selection
{} {
670 global file_states selected_paths
672 foreach path
[array names selected_paths
] {
673 if {[catch
{set still_here
$file_states($path)}]} {
674 unset selected_paths
($path)
679 ######################################################################
684 global ui_diff current_diff_path current_diff_header
685 global ui_index ui_workdir
687 $ui_diff conf
-state normal
688 $ui_diff delete
0.0 end
689 $ui_diff conf
-state disabled
691 set current_diff_path
{}
692 set current_diff_header
{}
694 $ui_index tag remove in_diff
0.0 end
695 $ui_workdir tag remove in_diff
0.0 end
698 proc reshow_diff
{} {
699 global ui_status_value file_states file_lists
700 global current_diff_path current_diff_side
702 set p
$current_diff_path
704 # No diff is being shown.
705 } elseif
{$current_diff_side eq
{}
706 ||
[catch
{set s
$file_states($p)}]
707 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
710 show_diff
$p $current_diff_side
714 proc handle_empty_diff
{} {
715 global current_diff_path file_states file_lists
717 set path
$current_diff_path
718 set s
$file_states($path)
719 if {[lindex
$s 0] ne
{_M
}} return
721 info_popup
"No differences detected.
723 [short_path $path] has no changes.
725 The modification date of this file was updated
726 by another application, but the content within
727 the file was not changed.
729 A rescan will be automatically started to find
730 other files which may have the same state."
733 display_file
$path __
734 rescan
{set ui_status_value
{Ready.
}} 0
737 proc show_diff
{path w
{lno
{}}} {
738 global file_states file_lists
739 global is_3way_diff diff_active repo_config
740 global ui_diff ui_status_value ui_index ui_workdir
741 global current_diff_path current_diff_side current_diff_header
743 if {$diff_active ||
![lock_index
read]} return
747 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
753 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
756 set s
$file_states($path)
760 set current_diff_path
$path
761 set current_diff_side
$w
762 set current_diff_header
{}
763 set ui_status_value
"Loading diff of [escape_path $path]..."
765 # - Git won't give us the diff, there's nothing to compare to!
768 set max_sz
[expr {128 * 1024}]
770 set fd
[open
$path r
]
771 set content
[read $fd $max_sz]
773 set sz
[file size
$path]
777 set ui_status_value
"Unable to display [escape_path $path]"
778 error_popup
"Error loading file:\n\n$err"
781 $ui_diff conf
-state normal
782 if {![catch
{set type [exec file $path]}]} {
783 set n
[string length
$path]
784 if {[string equal
-length $n $path $type]} {
785 set type [string range
$type $n end
]
786 regsub
{^
:?\s
*} $type {} type
788 $ui_diff insert end
"* $type\n" d_@
790 if {[string first
"\0" $content] != -1} {
791 $ui_diff insert end \
792 "* Binary file (not showing content)." \
796 $ui_diff insert end \
797 "* Untracked file is $sz bytes.
798 * Showing only first $max_sz bytes.
801 $ui_diff insert end
$content
803 $ui_diff insert end
"
804 * Untracked file clipped here by [appname].
805 * To see the entire file, use an external editor.
809 $ui_diff conf
-state disabled
812 set ui_status_value
{Ready.
}
817 if {$w eq
$ui_index} {
818 lappend cmd diff-index
820 } elseif
{$w eq
$ui_workdir} {
821 if {[string index
$m 0] eq
{U
}} {
824 lappend cmd diff-files
829 lappend cmd
--no-color
830 if {$repo_config(gui.diffcontext
) > 0} {
831 lappend cmd
"-U$repo_config(gui.diffcontext)"
833 if {$w eq
$ui_index} {
839 if {[catch
{set fd
[open
$cmd r
]} err
]} {
842 set ui_status_value
"Unable to display [escape_path $path]"
843 error_popup
"Error loading diff:\n\n$err"
851 fileevent
$fd readable
[list read_diff
$fd]
854 proc read_diff
{fd
} {
855 global ui_diff ui_status_value diff_active
856 global is_3way_diff current_diff_header
858 $ui_diff conf
-state normal
859 while {[gets
$fd line
] >= 0} {
860 # -- Cleanup uninteresting diff header lines.
862 if { [string match
{diff --git *} $line]
863 ||
[string match
{diff --cc *} $line]
864 ||
[string match
{diff --combined *} $line]
865 ||
[string match
{--- *} $line]
866 ||
[string match
{+++ *} $line]} {
867 append current_diff_header
$line "\n"
870 if {[string match
{index
*} $line]} continue
871 if {$line eq
{deleted
file mode
120000}} {
872 set line
"deleted symlink"
875 # -- Automatically detect if this is a 3 way diff.
877 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
879 if {[string match
{mode
*} $line]
880 ||
[string match
{new
file *} $line]
881 ||
[string match
{deleted
file *} $line]
882 ||
[string match
{Binary files
* and
* differ
} $line]
883 ||
$line eq
{\ No newline
at end of
file}
884 ||
[regexp
{^\
* Unmerged path
} $line]} {
886 } elseif
{$is_3way_diff} {
887 set op
[string range
$line 0 1]
897 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
898 set line
[string replace
$line 0 1 { }]
905 puts
"error: Unhandled 3 way diff marker: {$op}"
910 set op
[string index
$line 0]
916 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
917 set line
[string replace
$line 0 0 { }]
924 puts
"error: Unhandled 2 way diff marker: {$op}"
929 $ui_diff insert end
$line $tags
930 if {[string index
$line end
] eq
"\r"} {
931 $ui_diff tag add d_cr
{end
- 2c
}
933 $ui_diff insert end
"\n" $tags
935 $ui_diff conf
-state disabled
941 set ui_status_value
{Ready.
}
943 if {[$ui_diff index end
] eq
{2.0}} {
949 proc apply_hunk
{x y
} {
950 global current_diff_path current_diff_header current_diff_side
951 global ui_diff ui_index file_states
953 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
954 if {![lock_index apply_hunk
]} return
956 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
957 set mi
[lindex
$file_states($current_diff_path) 0]
958 if {$current_diff_side eq
$ui_index} {
960 lappend apply_cmd
--reverse
961 if {[string index
$mi 0] ne
{M
}} {
967 if {[string index
$mi 1] ne
{M
}} {
973 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
974 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
980 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
986 set p
[open
"| $apply_cmd" w
]
987 fconfigure
$p -translation binary
-encoding binary
988 puts
-nonewline $p $current_diff_header
989 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
991 error_popup
"Failed to $mode selected hunk.\n\n$err"
996 $ui_diff conf
-state normal
997 $ui_diff delete
$s_lno $e_lno
998 $ui_diff conf
-state disabled
1000 if {[$ui_diff get
1.0 end
] eq
"\n"} {
1006 if {$current_diff_side eq
$ui_index} {
1008 } elseif
{[string index
$mi 0] eq
{_
}} {
1014 display_file
$current_diff_path $mi
1020 ######################################################################
1024 proc load_last_commit
{} {
1025 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1028 if {[llength
$PARENT] == 0} {
1029 error_popup
{There is nothing to amend.
1031 You are about to create the initial commit.
1032 There is no commit before this to amend.
1037 repository_state curType curHEAD curMERGE_HEAD
1038 if {$curType eq
{merge
}} {
1039 error_popup
{Cannot amend
while merging.
1041 You are currently
in the middle of a merge that
1042 has not been fully completed. You cannot amend
1043 the prior commit unless you first abort the
1044 current merge activity.
1052 set fd
[open
"| git cat-file commit $curHEAD" r
]
1053 fconfigure
$fd -encoding binary
-translation lf
1054 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1057 while {[gets
$fd line
] > 0} {
1058 if {[string match
{parent
*} $line]} {
1059 lappend parents
[string range
$line 7 end
]
1060 } elseif
{[string match
{encoding
*} $line]} {
1061 set enc
[string tolower
[string range
$line 9 end
]]
1064 fconfigure
$fd -encoding $enc
1065 set msg
[string trim
[read $fd]]
1068 error_popup
"Error loading commit data for amend:\n\n$err"
1074 set MERGE_HEAD
[list
]
1075 switch
-- [llength
$parents] {
1076 0 {set commit_type amend-initial
}
1077 1 {set commit_type amend
}
1078 default
{set commit_type amend-merge
}
1081 $ui_comm delete
0.0 end
1082 $ui_comm insert end
$msg
1084 $ui_comm edit modified false
1085 rescan
{set ui_status_value
{Ready.
}}
1088 proc create_new_commit
{} {
1089 global commit_type ui_comm
1091 set commit_type normal
1092 $ui_comm delete
0.0 end
1094 $ui_comm edit modified false
1095 rescan
{set ui_status_value
{Ready.
}}
1098 set GIT_COMMITTER_IDENT
{}
1100 proc committer_ident
{} {
1101 global GIT_COMMITTER_IDENT
1103 if {$GIT_COMMITTER_IDENT eq
{}} {
1104 if {[catch
{set me
[git var GIT_COMMITTER_IDENT
]} err
]} {
1105 error_popup
"Unable to obtain your identity:\n\n$err"
1108 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1109 $me me GIT_COMMITTER_IDENT
]} {
1110 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1115 return $GIT_COMMITTER_IDENT
1118 proc commit_tree
{} {
1119 global HEAD commit_type file_states ui_comm repo_config
1120 global ui_status_value pch_error
1122 if {[committer_ident
] eq
{}} return
1123 if {![lock_index update
]} return
1125 # -- Our in memory state should match the repository.
1127 repository_state curType curHEAD curMERGE_HEAD
1128 if {[string match amend
* $commit_type]
1129 && $curType eq
{normal
}
1130 && $curHEAD eq
$HEAD} {
1131 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1132 info_popup
{Last scanned state does not match repository state.
1134 Another Git program has modified this repository
1135 since the last scan. A rescan must be performed
1136 before another commit can be created.
1138 The rescan will be automatically started now.
1141 rescan
{set ui_status_value
{Ready.
}}
1145 # -- At least one file should differ in the index.
1148 foreach path
[array names file_states
] {
1149 switch
-glob -- [lindex
$file_states($path) 0] {
1153 M?
{set files_ready
1}
1155 error_popup
"Unmerged files cannot be committed.
1157 File [short_path $path] has merge conflicts.
1158 You must resolve them and add the file before committing.
1164 error_popup
"Unknown file state [lindex $s 0] detected.
1166 File [short_path $path] cannot be committed by this program.
1171 if {!$files_ready && ![string match
*merge
$curType]} {
1172 info_popup
{No changes to commit.
1174 You must add
at least
1 file before you can commit.
1180 # -- A message is required.
1182 set msg
[string trim
[$ui_comm get
1.0 end
]]
1183 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1185 error_popup
{Please supply a commit message.
1187 A good commit message has the following format
:
1189 - First line
: Describe
in one sentance what you did.
1190 - Second line
: Blank
1191 - Remaining lines
: Describe why this change is good.
1197 # -- Run the pre-commit hook.
1199 set pchook
[gitdir hooks pre-commit
]
1201 # On Cygwin [file executable] might lie so we need to ask
1202 # the shell if the hook is executable. Yes that's annoying.
1204 if {[is_Cygwin
] && [file isfile
$pchook]} {
1205 set pchook
[list sh
-c [concat \
1206 "if test -x \"$pchook\";" \
1207 "then exec \"$pchook\" 2>&1;" \
1209 } elseif
{[file executable
$pchook]} {
1210 set pchook
[list
$pchook |
& cat]
1212 commit_writetree
$curHEAD $msg
1216 set ui_status_value
{Calling pre-commit hook...
}
1218 set fd_ph
[open
"| $pchook" r
]
1219 fconfigure
$fd_ph -blocking 0 -translation binary
1220 fileevent
$fd_ph readable \
1221 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1224 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1225 global pch_error ui_status_value
1227 append pch_error
[read $fd_ph]
1228 fconfigure
$fd_ph -blocking 1
1230 if {[catch
{close
$fd_ph}]} {
1231 set ui_status_value
{Commit declined by pre-commit hook.
}
1232 hook_failed_popup pre-commit
$pch_error
1235 commit_writetree
$curHEAD $msg
1240 fconfigure
$fd_ph -blocking 0
1243 proc commit_writetree
{curHEAD msg
} {
1244 global ui_status_value
1246 set ui_status_value
{Committing changes...
}
1247 set fd_wt
[open
"| git write-tree" r
]
1248 fileevent
$fd_wt readable \
1249 [list commit_committree
$fd_wt $curHEAD $msg]
1252 proc commit_committree
{fd_wt curHEAD msg
} {
1253 global HEAD PARENT MERGE_HEAD commit_type
1254 global all_heads current_branch
1255 global ui_status_value ui_comm selected_commit_type
1256 global file_states selected_paths rescan_active
1260 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1261 error_popup
"write-tree failed:\n\n$err"
1262 set ui_status_value
{Commit failed.
}
1267 # -- Verify this wasn't an empty change.
1269 if {$commit_type eq
{normal
}} {
1270 set old_tree
[git rev-parse
"$PARENT^{tree}"]
1271 if {$tree_id eq
$old_tree} {
1272 info_popup
{No changes to commit.
1274 No files were modified by this commit and it
1275 was not a merge commit.
1277 A rescan will be automatically started now.
1280 rescan
{set ui_status_value
{No changes to commit.
}}
1285 # -- Build the message.
1287 set msg_p
[gitdir COMMIT_EDITMSG
]
1288 set msg_wt
[open
$msg_p w
]
1289 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1292 fconfigure
$msg_wt -encoding $enc -translation binary
1293 puts
-nonewline $msg_wt $msg
1296 # -- Create the commit.
1298 set cmd
[list git commit-tree
$tree_id]
1299 foreach p
[concat
$PARENT $MERGE_HEAD] {
1303 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1304 error_popup
"commit-tree failed:\n\n$err"
1305 set ui_status_value
{Commit failed.
}
1310 # -- Update the HEAD ref.
1313 if {$commit_type ne
{normal
}} {
1314 append reflogm
" ($commit_type)"
1316 set i
[string first
"\n" $msg]
1318 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1320 append reflogm
{: } $msg
1322 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1323 if {[catch
{eval exec $cmd} err
]} {
1324 error_popup
"update-ref failed:\n\n$err"
1325 set ui_status_value
{Commit failed.
}
1330 # -- Cleanup after ourselves.
1332 catch
{file delete
$msg_p}
1333 catch
{file delete
[gitdir MERGE_HEAD
]}
1334 catch
{file delete
[gitdir MERGE_MSG
]}
1335 catch
{file delete
[gitdir SQUASH_MSG
]}
1336 catch
{file delete
[gitdir GITGUI_MSG
]}
1338 # -- Let rerere do its thing.
1340 if {[file isdirectory
[gitdir rr-cache
]]} {
1344 # -- Run the post-commit hook.
1346 set pchook
[gitdir hooks post-commit
]
1347 if {[is_Cygwin
] && [file isfile
$pchook]} {
1348 set pchook
[list sh
-c [concat \
1349 "if test -x \"$pchook\";" \
1350 "then exec \"$pchook\";" \
1352 } elseif
{![file executable
$pchook]} {
1355 if {$pchook ne
{}} {
1356 catch
{exec $pchook &}
1359 $ui_comm delete
0.0 end
1361 $ui_comm edit modified false
1363 if {[is_enabled singlecommit
]} do_quit
1365 # -- Make sure our current branch exists.
1367 if {$commit_type eq
{initial
}} {
1368 lappend all_heads
$current_branch
1369 set all_heads
[lsort
-unique $all_heads]
1370 populate_branch_menu
1373 # -- Update in memory status
1375 set selected_commit_type new
1376 set commit_type normal
1379 set MERGE_HEAD
[list
]
1381 foreach path
[array names file_states
] {
1382 set s
$file_states($path)
1384 switch
-glob -- $m {
1392 unset file_states
($path)
1393 catch
{unset selected_paths
($path)}
1396 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1402 set file_states
($path) [list \
1403 _
[string index
$m 1] \
1414 set ui_status_value \
1415 "Changes committed as [string range $cmt_id 0 7]."
1418 ######################################################################
1422 proc fetch_from
{remote
} {
1423 set w
[new_console \
1425 "Fetching new changes from $remote"]
1426 set cmd
[list git fetch
]
1428 console_exec
$w $cmd console_done
1431 proc push_to
{remote
} {
1432 set w
[new_console \
1434 "Pushing changes to $remote"]
1435 set cmd
[list git push
]
1438 console_exec
$w $cmd console_done
1441 ######################################################################
1445 proc mapicon
{w state path
} {
1448 if {[catch
{set r
$all_icons($state$w)}]} {
1449 puts
"error: no icon for $w state={$state} $path"
1455 proc mapdesc
{state path
} {
1458 if {[catch
{set r
$all_descs($state)}]} {
1459 puts
"error: no desc for state={$state} $path"
1465 proc escape_path
{path
} {
1466 regsub
-all {\\} $path "\\\\" path
1467 regsub
-all "\n" $path "\\n" path
1471 proc short_path
{path
} {
1472 return [escape_path
[lindex
[file split $path] end
]]
1476 set null_sha1
[string repeat
0 40]
1478 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1479 global file_states next_icon_id null_sha1
1481 set s0
[string index
$new_state 0]
1482 set s1
[string index
$new_state 1]
1484 if {[catch
{set info
$file_states($path)}]} {
1486 set icon n
[incr next_icon_id
]
1488 set state
[lindex
$info 0]
1489 set icon
[lindex
$info 1]
1490 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1491 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1494 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1495 elseif
{$s0 eq
{_
}} {set s0 _
}
1497 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1498 elseif
{$s1 eq
{_
}} {set s1 _
}
1500 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1501 set head_info
[list
0 $null_sha1]
1502 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1503 && $head_info eq
{}} {
1504 set head_info
$index_info
1507 set file_states
($path) [list
$s0$s1 $icon \
1508 $head_info $index_info \
1513 proc display_file_helper
{w path icon_name old_m new_m
} {
1516 if {$new_m eq
{_
}} {
1517 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1519 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1521 $w conf
-state normal
1522 $w delete
$lno.0 [expr {$lno + 1}].0
1523 $w conf
-state disabled
1525 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1526 lappend file_lists
($w) $path
1527 set file_lists
($w) [lsort
-unique $file_lists($w)]
1528 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1530 $w conf
-state normal
1531 $w image create
$lno.0 \
1532 -align center
-padx 5 -pady 1 \
1534 -image [mapicon
$w $new_m $path]
1535 $w insert
$lno.1 "[escape_path $path]\n"
1536 $w conf
-state disabled
1537 } elseif
{$old_m ne
$new_m} {
1538 $w conf
-state normal
1539 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1540 $w conf
-state disabled
1544 proc display_file
{path state
} {
1545 global file_states selected_paths
1546 global ui_index ui_workdir
1548 set old_m
[merge_state
$path $state]
1549 set s
$file_states($path)
1550 set new_m
[lindex
$s 0]
1551 set icon_name
[lindex
$s 1]
1553 set o
[string index
$old_m 0]
1554 set n
[string index
$new_m 0]
1561 display_file_helper
$ui_index $path $icon_name $o $n
1563 if {[string index
$old_m 0] eq
{U
}} {
1566 set o
[string index
$old_m 1]
1568 if {[string index
$new_m 0] eq
{U
}} {
1571 set n
[string index
$new_m 1]
1573 display_file_helper
$ui_workdir $path $icon_name $o $n
1575 if {$new_m eq
{__
}} {
1576 unset file_states
($path)
1577 catch
{unset selected_paths
($path)}
1581 proc display_all_files_helper
{w path icon_name m
} {
1584 lappend file_lists
($w) $path
1585 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1586 $w image create end \
1587 -align center
-padx 5 -pady 1 \
1589 -image [mapicon
$w $m $path]
1590 $w insert end
"[escape_path $path]\n"
1593 proc display_all_files
{} {
1594 global ui_index ui_workdir
1595 global file_states file_lists
1598 $ui_index conf
-state normal
1599 $ui_workdir conf
-state normal
1601 $ui_index delete
0.0 end
1602 $ui_workdir delete
0.0 end
1605 set file_lists
($ui_index) [list
]
1606 set file_lists
($ui_workdir) [list
]
1608 foreach path
[lsort
[array names file_states
]] {
1609 set s
$file_states($path)
1611 set icon_name
[lindex
$s 1]
1613 set s
[string index
$m 0]
1614 if {$s ne
{U
} && $s ne
{_
}} {
1615 display_all_files_helper
$ui_index $path \
1619 if {[string index
$m 0] eq
{U
}} {
1622 set s
[string index
$m 1]
1625 display_all_files_helper
$ui_workdir $path \
1630 $ui_index conf
-state disabled
1631 $ui_workdir conf
-state disabled
1634 proc update_indexinfo
{msg pathList after
} {
1635 global update_index_cp ui_status_value
1637 if {![lock_index update
]} return
1639 set update_index_cp
0
1640 set pathList
[lsort
$pathList]
1641 set totalCnt
[llength
$pathList]
1642 set batch [expr {int
($totalCnt * .01) + 1}]
1643 if {$batch > 25} {set batch 25}
1645 set ui_status_value
[format \
1646 "$msg... %i/%i files (%.2f%%)" \
1650 set fd
[open
"| git update-index -z --index-info" w
]
1657 fileevent
$fd writable
[list \
1658 write_update_indexinfo \
1668 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1669 global update_index_cp ui_status_value
1670 global file_states current_diff_path
1672 if {$update_index_cp >= $totalCnt} {
1679 for {set i
$batch} \
1680 {$update_index_cp < $totalCnt && $i > 0} \
1682 set path
[lindex
$pathList $update_index_cp]
1683 incr update_index_cp
1685 set s
$file_states($path)
1686 switch
-glob -- [lindex
$s 0] {
1693 set info
[lindex
$s 2]
1694 if {$info eq
{}} continue
1696 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1697 display_file
$path $new
1700 set ui_status_value
[format \
1701 "$msg... %i/%i files (%.2f%%)" \
1704 [expr {100.0 * $update_index_cp / $totalCnt}]]
1707 proc update_index
{msg pathList after
} {
1708 global update_index_cp ui_status_value
1710 if {![lock_index update
]} return
1712 set update_index_cp
0
1713 set pathList
[lsort
$pathList]
1714 set totalCnt
[llength
$pathList]
1715 set batch [expr {int
($totalCnt * .01) + 1}]
1716 if {$batch > 25} {set batch 25}
1718 set ui_status_value
[format \
1719 "$msg... %i/%i files (%.2f%%)" \
1723 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1730 fileevent
$fd writable
[list \
1731 write_update_index \
1741 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1742 global update_index_cp ui_status_value
1743 global file_states current_diff_path
1745 if {$update_index_cp >= $totalCnt} {
1752 for {set i
$batch} \
1753 {$update_index_cp < $totalCnt && $i > 0} \
1755 set path
[lindex
$pathList $update_index_cp]
1756 incr update_index_cp
1758 switch
-glob -- [lindex
$file_states($path) 0] {
1764 if {[file exists
$path]} {
1773 puts
-nonewline $fd "[encoding convertto $path]\0"
1774 display_file
$path $new
1777 set ui_status_value
[format \
1778 "$msg... %i/%i files (%.2f%%)" \
1781 [expr {100.0 * $update_index_cp / $totalCnt}]]
1784 proc checkout_index
{msg pathList after
} {
1785 global update_index_cp ui_status_value
1787 if {![lock_index update
]} return
1789 set update_index_cp
0
1790 set pathList
[lsort
$pathList]
1791 set totalCnt
[llength
$pathList]
1792 set batch [expr {int
($totalCnt * .01) + 1}]
1793 if {$batch > 25} {set batch 25}
1795 set ui_status_value
[format \
1796 "$msg... %i/%i files (%.2f%%)" \
1800 set cmd
[list git checkout-index
]
1806 set fd
[open
"| $cmd " w
]
1813 fileevent
$fd writable
[list \
1814 write_checkout_index \
1824 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1825 global update_index_cp ui_status_value
1826 global file_states current_diff_path
1828 if {$update_index_cp >= $totalCnt} {
1835 for {set i
$batch} \
1836 {$update_index_cp < $totalCnt && $i > 0} \
1838 set path
[lindex
$pathList $update_index_cp]
1839 incr update_index_cp
1840 switch
-glob -- [lindex
$file_states($path) 0] {
1844 puts
-nonewline $fd "[encoding convertto $path]\0"
1845 display_file
$path ?_
1850 set ui_status_value
[format \
1851 "$msg... %i/%i files (%.2f%%)" \
1854 [expr {100.0 * $update_index_cp / $totalCnt}]]
1857 ######################################################################
1859 ## branch management
1861 proc is_tracking_branch
{name
} {
1862 global tracking_branches
1864 if {![catch
{set info
$tracking_branches($name)}]} {
1867 foreach t
[array names tracking_branches
] {
1868 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1875 proc load_all_heads
{} {
1878 set all_heads
[list
]
1879 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1880 while {[gets
$fd line
] > 0} {
1881 if {[is_tracking_branch
$line]} continue
1882 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1883 lappend all_heads
$name
1887 set all_heads
[lsort
$all_heads]
1890 proc populate_branch_menu
{} {
1891 global all_heads disable_on_lock
1894 set last
[$m index last
]
1895 for {set i
0} {$i <= $last} {incr i
} {
1896 if {[$m type $i] eq
{separator
}} {
1899 foreach a
$disable_on_lock {
1900 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1904 set disable_on_lock
$new_dol
1909 if {$all_heads ne
{}} {
1912 foreach b
$all_heads {
1913 $m add radiobutton \
1915 -command [list switch_branch
$b] \
1916 -variable current_branch \
1919 lappend disable_on_lock \
1920 [list
$m entryconf
[$m index last
] -state]
1924 proc all_tracking_branches
{} {
1925 global tracking_branches
1927 set all_trackings
{}
1929 foreach name
[array names tracking_branches
] {
1930 if {[regsub
{/\
*$
} $name {} name
]} {
1933 regsub ^refs
/(heads|remotes
)/ $name {} name
1934 lappend all_trackings
$name
1939 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1940 while {[gets
$fd name
] > 0} {
1941 regsub ^refs
/(heads|remotes
)/ $name {} name
1942 lappend all_trackings
$name
1947 return [lsort
-unique $all_trackings]
1950 proc load_all_tags
{} {
1952 set fd
[open
"| git for-each-ref --format=%(refname) refs/tags" r
]
1953 while {[gets
$fd line
] > 0} {
1954 if {![regsub ^refs
/tags
/ $line {} name
]} continue
1955 lappend all_tags
$name
1959 return [lsort
$all_tags]
1962 proc do_create_branch_action
{w
} {
1963 global all_heads null_sha1 repo_config
1964 global create_branch_checkout create_branch_revtype
1965 global create_branch_head create_branch_trackinghead
1966 global create_branch_name create_branch_revexp
1967 global create_branch_tag
1969 set newbranch
$create_branch_name
1970 if {$newbranch eq
{}
1971 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1975 -title [wm title
$w] \
1977 -message "Please supply a branch name."
1978 focus
$w.desc.name_t
1981 if {![catch
{git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1985 -title [wm title
$w] \
1987 -message "Branch '$newbranch' already exists."
1988 focus
$w.desc.name_t
1991 if {[catch
{git check-ref-format
"heads/$newbranch"}]} {
1995 -title [wm title
$w] \
1997 -message "We do not like '$newbranch' as a branch name."
1998 focus
$w.desc.name_t
2003 switch
-- $create_branch_revtype {
2004 head {set rev $create_branch_head}
2005 tracking
{set rev $create_branch_trackinghead}
2006 tag
{set rev $create_branch_tag}
2007 expression
{set rev $create_branch_revexp}
2009 if {[catch
{set cmt
[git rev-parse
--verify "${rev}^0"]}]} {
2013 -title [wm title
$w] \
2015 -message "Invalid starting revision: $rev"
2018 set cmd
[list git update-ref
]
2020 lappend cmd
"branch: Created from $rev"
2021 lappend cmd
"refs/heads/$newbranch"
2023 lappend cmd
$null_sha1
2024 if {[catch
{eval exec $cmd} err
]} {
2028 -title [wm title
$w] \
2030 -message "Failed to create '$newbranch'.\n\n$err"
2034 lappend all_heads
$newbranch
2035 set all_heads
[lsort
$all_heads]
2036 populate_branch_menu
2038 if {$create_branch_checkout} {
2039 switch_branch
$newbranch
2043 proc radio_selector
{varname value args
} {
2044 upvar
#0 $varname var
2048 trace add variable create_branch_head
write \
2049 [list radio_selector create_branch_revtype
head]
2050 trace add variable create_branch_trackinghead
write \
2051 [list radio_selector create_branch_revtype tracking
]
2052 trace add variable create_branch_tag
write \
2053 [list radio_selector create_branch_revtype tag
]
2055 trace add variable delete_branch_head
write \
2056 [list radio_selector delete_branch_checktype
head]
2057 trace add variable delete_branch_trackinghead
write \
2058 [list radio_selector delete_branch_checktype tracking
]
2060 proc do_create_branch
{} {
2061 global all_heads current_branch repo_config
2062 global create_branch_checkout create_branch_revtype
2063 global create_branch_head create_branch_trackinghead
2064 global create_branch_name create_branch_revexp
2065 global create_branch_tag
2067 set w .branch_editor
2069 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2071 label
$w.header
-text {Create New Branch
} \
2073 pack
$w.header
-side top
-fill x
2076 button
$w.buttons.create
-text Create \
2079 -command [list do_create_branch_action
$w]
2080 pack
$w.buttons.create
-side right
2081 button
$w.buttons.cancel
-text {Cancel
} \
2083 -command [list destroy
$w]
2084 pack
$w.buttons.cancel
-side right
-padx 5
2085 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2087 labelframe
$w.desc \
2088 -text {Branch Description
} \
2090 label
$w.desc.name_l
-text {Name
:} -font font_ui
2091 entry
$w.desc.name_t \
2095 -textvariable create_branch_name \
2099 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2102 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2103 grid columnconfigure
$w.desc
1 -weight 1
2104 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2106 labelframe
$w.from \
2107 -text {Starting Revision
} \
2109 radiobutton
$w.from.head_r \
2110 -text {Local Branch
:} \
2112 -variable create_branch_revtype \
2114 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2115 grid
$w.from.head_r
$w.from.head_m
-sticky w
2116 set all_trackings
[all_tracking_branches
]
2117 if {$all_trackings ne
{}} {
2118 set create_branch_trackinghead
[lindex
$all_trackings 0]
2119 radiobutton
$w.from.tracking_r \
2120 -text {Tracking Branch
:} \
2122 -variable create_branch_revtype \
2124 eval tk_optionMenu
$w.from.tracking_m \
2125 create_branch_trackinghead \
2127 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2129 set all_tags
[load_all_tags
]
2130 if {$all_tags ne
{}} {
2131 set create_branch_tag
[lindex
$all_tags 0]
2132 radiobutton
$w.from.tag_r \
2135 -variable create_branch_revtype \
2137 eval tk_optionMenu
$w.from.tag_m \
2140 grid
$w.from.tag_r
$w.from.tag_m
-sticky w
2142 radiobutton
$w.from.exp_r \
2143 -text {Revision Expression
:} \
2145 -variable create_branch_revtype \
2147 entry
$w.from.exp_t \
2151 -textvariable create_branch_revexp \
2155 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2156 if {%d
== 1 && [string length
%S
] > 0} {
2157 set create_branch_revtype expression
2161 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2162 grid columnconfigure
$w.from
1 -weight 1
2163 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2165 labelframe
$w.postActions \
2166 -text {Post Creation Actions
} \
2168 checkbutton
$w.postActions.checkout \
2169 -text {Checkout after creation
} \
2170 -variable create_branch_checkout \
2172 pack
$w.postActions.checkout
-anchor nw
2173 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2175 set create_branch_checkout
1
2176 set create_branch_head
$current_branch
2177 set create_branch_revtype
head
2178 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2179 set create_branch_revexp
{}
2181 bind $w <Visibility
> "
2183 $w.desc.name_t icursor end
2184 focus $w.desc.name_t
2186 bind $w <Key-Escape
> "destroy $w"
2187 bind $w <Key-Return
> "do_create_branch_action $w;break"
2188 wm title
$w "[appname] ([reponame]): Create Branch"
2192 proc do_delete_branch_action
{w
} {
2194 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2197 switch
-- $delete_branch_checktype {
2198 head {set check_rev
$delete_branch_head}
2199 tracking
{set check_rev
$delete_branch_trackinghead}
2200 always
{set check_rev
{:none
}}
2202 if {$check_rev eq
{:none
}} {
2204 } elseif
{[catch
{set check_cmt
[git rev-parse
--verify "${check_rev}^0"]}]} {
2208 -title [wm title
$w] \
2210 -message "Invalid check revision: $check_rev"
2214 set to_delete
[list
]
2215 set not_merged
[list
]
2216 foreach i
[$w.list.l curselection
] {
2217 set b
[$w.list.l get
$i]
2218 if {[catch
{set o
[git rev-parse
--verify $b]}]} continue
2219 if {$check_cmt ne
{}} {
2220 if {$b eq
$check_rev} continue
2221 if {[catch
{set m
[git merge-base
$o $check_cmt]}]} continue
2223 lappend not_merged
$b
2227 lappend to_delete
[list
$b $o]
2229 if {$not_merged ne
{}} {
2230 set msg
"The following branches are not completely merged into $check_rev:
2232 - [join $not_merged "\n - "]"
2236 -title [wm title
$w] \
2240 if {$to_delete eq
{}} return
2241 if {$delete_branch_checktype eq
{always
}} {
2242 set msg
{Recovering deleted branches is difficult.
2244 Delete the selected branches?
}
2245 if {[tk_messageBox \
2248 -title [wm title
$w] \
2250 -message $msg] ne
yes} {
2256 foreach i
$to_delete {
2259 if {[catch
{git update-ref
-d "refs/heads/$b" $o} err
]} {
2260 append failed
" - $b: $err\n"
2262 set x
[lsearch
-sorted -exact $all_heads $b]
2264 set all_heads
[lreplace
$all_heads $x $x]
2269 if {$failed ne
{}} {
2273 -title [wm title
$w] \
2275 -message "Failed to delete branches:\n$failed"
2278 set all_heads
[lsort
$all_heads]
2279 populate_branch_menu
2283 proc do_delete_branch
{} {
2284 global all_heads tracking_branches current_branch
2285 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2287 set w .branch_editor
2289 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2291 label
$w.header
-text {Delete Local Branch
} \
2293 pack
$w.header
-side top
-fill x
2296 button
$w.buttons.create
-text Delete \
2298 -command [list do_delete_branch_action
$w]
2299 pack
$w.buttons.create
-side right
2300 button
$w.buttons.cancel
-text {Cancel
} \
2302 -command [list destroy
$w]
2303 pack
$w.buttons.cancel
-side right
-padx 5
2304 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2306 labelframe
$w.list \
2307 -text {Local Branches
} \
2312 -selectmode extended \
2313 -yscrollcommand [list
$w.list.sby
set] \
2315 foreach h
$all_heads {
2316 if {$h ne
$current_branch} {
2317 $w.list.l insert end
$h
2320 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2321 pack
$w.list.sby
-side right
-fill y
2322 pack
$w.list.l
-side left
-fill both
-expand 1
2323 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2325 labelframe
$w.validate \
2326 -text {Delete Only If
} \
2328 radiobutton
$w.validate.head_r \
2329 -text {Merged Into Local Branch
:} \
2331 -variable delete_branch_checktype \
2333 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2334 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2335 set all_trackings
[all_tracking_branches
]
2336 if {$all_trackings ne
{}} {
2337 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2338 radiobutton
$w.validate.tracking_r \
2339 -text {Merged Into Tracking Branch
:} \
2341 -variable delete_branch_checktype \
2343 eval tk_optionMenu
$w.validate.tracking_m \
2344 delete_branch_trackinghead \
2346 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2348 radiobutton
$w.validate.always_r \
2349 -text {Always
(Do not perform merge checks
)} \
2351 -variable delete_branch_checktype \
2353 grid
$w.validate.always_r
-columnspan 2 -sticky w
2354 grid columnconfigure
$w.validate
1 -weight 1
2355 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2357 set delete_branch_head
$current_branch
2358 set delete_branch_checktype
head
2360 bind $w <Visibility
> "grab $w; focus $w"
2361 bind $w <Key-Escape
> "destroy $w"
2362 wm title
$w "[appname] ([reponame]): Delete Branch"
2366 proc switch_branch
{new_branch
} {
2367 global HEAD commit_type current_branch repo_config
2369 if {![lock_index switch
]} return
2371 # -- Our in memory state should match the repository.
2373 repository_state curType curHEAD curMERGE_HEAD
2374 if {[string match amend
* $commit_type]
2375 && $curType eq
{normal
}
2376 && $curHEAD eq
$HEAD} {
2377 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2378 info_popup
{Last scanned state does not match repository state.
2380 Another Git program has modified this repository
2381 since the last scan. A rescan must be performed
2382 before the current branch can be changed.
2384 The rescan will be automatically started now.
2387 rescan
{set ui_status_value
{Ready.
}}
2391 # -- Don't do a pointless switch.
2393 if {$current_branch eq
$new_branch} {
2398 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2399 switch_branch_stage2
{} $new_branch
2401 set ui_status_value
{Refreshing
file status...
}
2402 set cmd
[list git update-index
]
2404 lappend cmd
--unmerged
2405 lappend cmd
--ignore-missing
2406 lappend cmd
--refresh
2407 set fd_rf
[open
"| $cmd" r
]
2408 fconfigure
$fd_rf -blocking 0 -translation binary
2409 fileevent
$fd_rf readable \
2410 [list switch_branch_stage2
$fd_rf $new_branch]
2414 proc switch_branch_stage2
{fd_rf new_branch
} {
2415 global ui_status_value HEAD
2419 if {![eof
$fd_rf]} return
2423 set ui_status_value
"Updating working directory to '$new_branch'..."
2424 set cmd
[list git read-tree
]
2427 lappend cmd
--exclude-per-directory=.gitignore
2429 lappend cmd
$new_branch
2430 set fd_rt
[open
"| $cmd" r
]
2431 fconfigure
$fd_rt -blocking 0 -translation binary
2432 fileevent
$fd_rt readable \
2433 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2436 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2437 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2438 global current_branch
2439 global ui_comm ui_status_value
2441 # -- We never get interesting output on stdout; only stderr.
2444 fconfigure
$fd_rt -blocking 1
2445 if {![eof
$fd_rt]} {
2446 fconfigure
$fd_rt -blocking 0
2450 # -- The working directory wasn't in sync with the index and
2451 # we'd have to overwrite something to make the switch. A
2452 # merge is required.
2454 if {[catch
{close
$fd_rt} err
]} {
2455 regsub
{^fatal
: } $err {} err
2456 warn_popup
"File level merge required.
2460 Staying on branch '$current_branch'."
2461 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2466 # -- Update the symbolic ref. Core git doesn't even check for failure
2467 # here, it Just Works(tm). If it doesn't we are in some really ugly
2468 # state that is difficult to recover from within git-gui.
2470 if {[catch
{git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2471 error_popup
"Failed to set current branch.
2473 This working directory is only partially switched.
2474 We successfully updated your files, but failed to
2475 update an internal Git file.
2477 This should not have occurred. [appname] will now
2485 # -- Update our repository state. If we were previously in amend mode
2486 # we need to toss the current buffer and do a full rescan to update
2487 # our file lists. If we weren't in amend mode our file lists are
2488 # accurate and we can avoid the rescan.
2491 set selected_commit_type new
2492 if {[string match amend
* $commit_type]} {
2493 $ui_comm delete
0.0 end
2495 $ui_comm edit modified false
2496 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2498 repository_state commit_type HEAD MERGE_HEAD
2500 set ui_status_value
"Checked out branch '$current_branch'."
2504 ######################################################################
2506 ## remote management
2508 proc load_all_remotes
{} {
2510 global all_remotes tracking_branches
2512 set all_remotes
[list
]
2513 array
unset tracking_branches
2515 set rm_dir
[gitdir remotes
]
2516 if {[file isdirectory
$rm_dir]} {
2517 set all_remotes
[glob \
2521 -directory $rm_dir *]
2523 foreach name
$all_remotes {
2525 set fd
[open
[file join $rm_dir $name] r
]
2526 while {[gets
$fd line
] >= 0} {
2527 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2528 $line line src dst
]} continue
2529 if {![regexp ^refs
/ $dst]} {
2530 set dst
"refs/heads/$dst"
2532 set tracking_branches
($dst) [list
$name $src]
2539 foreach line
[array names repo_config remote.
*.url
] {
2540 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2541 lappend all_remotes
$name
2543 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2547 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2548 if {![regexp ^refs
/ $dst]} {
2549 set dst
"refs/heads/$dst"
2551 set tracking_branches
($dst) [list
$name $src]
2555 set all_remotes
[lsort
-unique $all_remotes]
2558 proc populate_fetch_menu
{} {
2559 global all_remotes repo_config
2562 foreach r
$all_remotes {
2564 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2565 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2570 set fd
[open
[gitdir remotes
$r] r
]
2571 while {[gets
$fd n
] >= 0} {
2572 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2583 -label "Fetch from $r..." \
2584 -command [list fetch_from
$r] \
2590 proc populate_push_menu
{} {
2591 global all_remotes repo_config
2595 foreach r
$all_remotes {
2597 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2598 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2603 set fd
[open
[gitdir remotes
$r] r
]
2604 while {[gets
$fd n
] >= 0} {
2605 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2619 -label "Push to $r..." \
2620 -command [list push_to
$r] \
2627 proc start_push_anywhere_action
{w
} {
2628 global push_urltype push_remote push_url push_thin push_tags
2631 switch
-- $push_urltype {
2632 remote
{set r_url
$push_remote}
2633 url
{set r_url
$push_url}
2635 if {$r_url eq
{}} return
2637 set cmd
[list git push
]
2647 foreach i
[$w.
source.l curselection
] {
2648 set b
[$w.
source.l get
$i]
2649 lappend cmd
"refs/heads/$b:refs/heads/$b"
2654 } elseif
{$cnt == 1} {
2660 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2661 console_exec
$cons $cmd console_done
2665 trace add variable push_remote
write \
2666 [list radio_selector push_urltype remote
]
2668 proc do_push_anywhere
{} {
2669 global all_heads all_remotes current_branch
2670 global push_urltype push_remote push_url push_thin push_tags
2674 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2676 label
$w.header
-text {Push Branches
} -font font_uibold
2677 pack
$w.header
-side top
-fill x
2680 button
$w.buttons.create
-text Push \
2682 -command [list start_push_anywhere_action
$w]
2683 pack
$w.buttons.create
-side right
2684 button
$w.buttons.cancel
-text {Cancel
} \
2686 -command [list destroy
$w]
2687 pack
$w.buttons.cancel
-side right
-padx 5
2688 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2690 labelframe
$w.
source \
2691 -text {Source Branches
} \
2693 listbox
$w.
source.l \
2696 -selectmode extended \
2697 -yscrollcommand [list
$w.
source.sby
set] \
2699 foreach h
$all_heads {
2700 $w.
source.l insert end
$h
2701 if {$h eq
$current_branch} {
2702 $w.
source.l
select set end
2705 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2706 pack
$w.
source.sby
-side right
-fill y
2707 pack
$w.
source.l
-side left
-fill both
-expand 1
2708 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2710 labelframe
$w.dest \
2711 -text {Destination Repository
} \
2713 if {$all_remotes ne
{}} {
2714 radiobutton
$w.dest.remote_r \
2717 -variable push_urltype \
2719 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2720 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2721 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2722 set push_remote origin
2724 set push_remote
[lindex
$all_remotes 0]
2726 set push_urltype remote
2728 set push_urltype url
2730 radiobutton
$w.dest.url_r \
2731 -text {Arbitrary URL
:} \
2733 -variable push_urltype \
2735 entry
$w.dest.url_t \
2739 -textvariable push_url \
2743 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2744 if {%d
== 1 && [string length
%S
] > 0} {
2745 set push_urltype url
2749 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2750 grid columnconfigure
$w.dest
1 -weight 1
2751 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2753 labelframe
$w.options \
2754 -text {Transfer Options
} \
2756 checkbutton
$w.options.thin \
2757 -text {Use thin pack
(for slow network connections
)} \
2758 -variable push_thin \
2760 grid
$w.options.thin
-columnspan 2 -sticky w
2761 checkbutton
$w.options.tags \
2762 -text {Include tags
} \
2763 -variable push_tags \
2765 grid
$w.options.tags
-columnspan 2 -sticky w
2766 grid columnconfigure
$w.options
1 -weight 1
2767 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2773 bind $w <Visibility
> "grab $w"
2774 bind $w <Key-Escape
> "destroy $w"
2775 wm title
$w "[appname] ([reponame]): Push"
2779 ######################################################################
2784 global HEAD commit_type file_states
2786 if {[string match amend
* $commit_type]} {
2787 info_popup
{Cannot merge
while amending.
2789 You must finish amending this commit before
2790 starting any
type of merge.
2795 if {[committer_ident
] eq
{}} {return 0}
2796 if {![lock_index merge
]} {return 0}
2798 # -- Our in memory state should match the repository.
2800 repository_state curType curHEAD curMERGE_HEAD
2801 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2802 info_popup
{Last scanned state does not match repository state.
2804 Another Git program has modified this repository
2805 since the last scan. A rescan must be performed
2806 before a merge can be performed.
2808 The rescan will be automatically started now.
2811 rescan
{set ui_status_value
{Ready.
}}
2815 foreach path
[array names file_states
] {
2816 switch
-glob -- [lindex
$file_states($path) 0] {
2818 continue; # and pray it works!
2821 error_popup
"You are in the middle of a conflicted merge.
2823 File [short_path $path] has merge conflicts.
2825 You must resolve them, add the file, and commit to
2826 complete the current merge. Only then can you
2827 begin another merge.
2833 error_popup
"You are in the middle of a change.
2835 File [short_path $path] is modified.
2837 You should complete the current commit before
2838 starting a merge. Doing so will help you abort
2839 a failed merge, should the need arise.
2850 proc visualize_local_merge
{w
} {
2852 foreach i
[$w.
source.l curselection
] {
2853 lappend revs
[$w.
source.l get
$i]
2855 if {$revs eq
{}} return
2856 lappend revs
--not HEAD
2860 proc start_local_merge_action
{w
} {
2861 global HEAD ui_status_value current_branch
2863 set cmd
[list git merge
]
2866 foreach i
[$w.
source.l curselection
] {
2867 set b
[$w.
source.l get
$i]
2875 } elseif
{$revcnt == 1} {
2877 } elseif
{$revcnt <= 15} {
2883 -title [wm title
$w] \
2885 -message "Too many branches selected.
2887 You have requested to merge $revcnt branches
2888 in an octopus merge. This exceeds Git's
2889 internal limit of 15 branches per merge.
2891 Please select fewer branches. To merge more
2892 than 15 branches, merge the branches in batches.
2897 set msg
"Merging $current_branch, [join $names {, }]"
2898 set ui_status_value
"$msg..."
2899 set cons
[new_console
"Merge" $msg]
2900 console_exec
$cons $cmd [list finish_merge
$revcnt]
2901 bind $w <Destroy
> {}
2905 proc finish_merge
{revcnt w ok
} {
2908 set msg
{Merge completed successfully.
}
2911 info_popup
"Octopus merge failed.
2913 Your merge of $revcnt branches has failed.
2915 There are file-level conflicts between the
2916 branches which must be resolved manually.
2918 The working directory will now be reset.
2920 You can attempt this merge again
2921 by merging only one branch at a time." $w
2923 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2924 fconfigure
$fd -blocking 0 -translation binary
2925 fileevent
$fd readable
[list reset_hard_wait
$fd]
2926 set ui_status_value
{Aborting... please
wait...
}
2930 set msg
{Merge failed. Conflict resolution is required.
}
2933 rescan
[list
set ui_status_value
$msg]
2936 proc do_local_merge
{} {
2937 global current_branch
2939 if {![can_merge
]} return
2943 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2946 -text "Merge Into $current_branch" \
2948 pack
$w.header
-side top
-fill x
2951 button
$w.buttons.visualize
-text Visualize \
2953 -command [list visualize_local_merge
$w]
2954 pack
$w.buttons.visualize
-side left
2955 button
$w.buttons.create
-text Merge \
2957 -command [list start_local_merge_action
$w]
2958 pack
$w.buttons.create
-side right
2959 button
$w.buttons.cancel
-text {Cancel
} \
2961 -command [list destroy
$w]
2962 pack
$w.buttons.cancel
-side right
-padx 5
2963 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2965 labelframe
$w.
source \
2966 -text {Source Branches
} \
2968 listbox
$w.
source.l \
2971 -selectmode extended \
2972 -yscrollcommand [list
$w.
source.sby
set] \
2974 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2975 pack
$w.
source.sby
-side right
-fill y
2976 pack
$w.
source.l
-side left
-fill both
-expand 1
2977 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2979 set cmd
[list git for-each-ref
]
2980 lappend cmd
{--format=%(objectname
) %(*objectname
) %(refname
)}
2981 lappend cmd refs
/heads
2982 lappend cmd refs
/remotes
2983 lappend cmd refs
/tags
2984 set fr_fd
[open
"| $cmd" r
]
2985 fconfigure
$fr_fd -translation binary
2986 while {[gets
$fr_fd line
] > 0} {
2987 set line
[split $line { }]
2988 set sha1
([lindex
$line 0]) [lindex
$line 2]
2989 set sha1
([lindex
$line 1]) [lindex
$line 2]
2994 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2995 while {[gets
$fr_fd line
] > 0} {
2996 if {[catch
{set ref
$sha1($line)}]} continue
2997 regsub ^refs
/(heads|remotes|tags
)/ $ref {} ref
2998 lappend to_show
$ref
3002 foreach ref
[lsort
-unique $to_show] {
3003 $w.
source.l insert end
$ref
3006 bind $w <Visibility
> "grab $w"
3007 bind $w <Key-Escape
> "unlock_index;destroy $w"
3008 bind $w <Destroy
> unlock_index
3009 wm title
$w "[appname] ([reponame]): Merge"
3013 proc do_reset_hard
{} {
3014 global HEAD commit_type file_states
3016 if {[string match amend
* $commit_type]} {
3017 info_popup
{Cannot abort
while amending.
3019 You must finish amending this commit.
3024 if {![lock_index abort
]} return
3026 if {[string match
*merge
* $commit_type]} {
3032 if {[ask_popup
"Abort $op?
3034 Aborting the current $op will cause
3035 *ALL* uncommitted changes to be lost.
3037 Continue with aborting the current $op?"] eq
{yes}} {
3038 set fd
[open
"| git read-tree --reset -u HEAD" r
]
3039 fconfigure
$fd -blocking 0 -translation binary
3040 fileevent
$fd readable
[list reset_hard_wait
$fd]
3041 set ui_status_value
{Aborting... please
wait...
}
3047 proc reset_hard_wait
{fd
} {
3055 $ui_comm delete
0.0 end
3056 $ui_comm edit modified false
3058 catch
{file delete
[gitdir MERGE_HEAD
]}
3059 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
3060 catch
{file delete
[gitdir SQUASH_MSG
]}
3061 catch
{file delete
[gitdir MERGE_MSG
]}
3062 catch
{file delete
[gitdir GITGUI_MSG
]}
3064 rescan
{set ui_status_value
{Abort completed. Ready.
}}
3068 ######################################################################
3072 set next_browser_id
0
3074 proc new_browser
{commit
} {
3075 global next_browser_id cursor_ptr M1B
3076 global browser_commit browser_status browser_stack browser_path browser_busy
3078 if {[winfo ismapped .
]} {
3079 set w .browser
[incr next_browser_id
]
3086 set w_list
$w.list.l
3087 set browser_commit
($w_list) $commit
3088 set browser_status
($w_list) {Starting...
}
3089 set browser_stack
($w_list) {}
3090 set browser_path
($w_list) $browser_commit($w_list):
3091 set browser_busy
($w_list) 1
3093 label
$w.path
-textvariable browser_path
($w_list) \
3099 pack
$w.path
-anchor w
-side top
-fill x
3102 text
$w_list -background white
-borderwidth 0 \
3103 -cursor $cursor_ptr \
3108 -xscrollcommand [list
$w.list.sbx
set] \
3109 -yscrollcommand [list
$w.list.sby
set] \
3111 $w_list tag conf in_sel \
3112 -background [$w_list cget
-foreground] \
3113 -foreground [$w_list cget
-background]
3114 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
3115 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
3116 pack
$w.list.sbx
-side bottom
-fill x
3117 pack
$w.list.sby
-side right
-fill y
3118 pack
$w_list -side left
-fill both
-expand 1
3119 pack
$w.list
-side top
-fill both
-expand 1
3121 label
$w.status
-textvariable browser_status
($w_list) \
3127 pack
$w.status
-anchor w
-side bottom
-fill x
3129 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3130 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3131 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3132 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3133 bind $w_list <Up
> "browser_move -1 $w_list;break"
3134 bind $w_list <Down
> "browser_move 1 $w_list;break"
3135 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3136 bind $w_list <Return
> "browser_enter $w_list;break"
3137 bind $w_list <Prior
> "browser_page -1 $w_list;break"
3138 bind $w_list <Next
> "browser_page 1 $w_list;break"
3139 bind $w_list <Left
> break
3140 bind $w_list <Right
> break
3142 bind $tl <Visibility
> "focus $w"
3143 bind $tl <Destroy
> "
3144 array unset browser_buffer $w_list
3145 array unset browser_files $w_list
3146 array unset browser_status $w_list
3147 array unset browser_stack $w_list
3148 array unset browser_path $w_list
3149 array unset browser_commit $w_list
3150 array unset browser_busy $w_list
3152 wm title
$tl "[appname] ([reponame]): File Browser"
3153 ls_tree
$w_list $browser_commit($w_list) {}
3156 proc browser_move
{dir w
} {
3157 global browser_files browser_busy
3159 if {$browser_busy($w)} return
3160 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3162 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3163 $w tag remove in_sel
0.0 end
3164 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3169 proc browser_page
{dir w
} {
3170 global browser_files browser_busy
3172 if {$browser_busy($w)} return
3173 $w yview scroll
$dir pages
3175 [lindex
[$w yview
] 0]
3176 * [llength
$browser_files($w)]
3178 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3179 $w tag remove in_sel
0.0 end
3180 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3185 proc browser_parent
{w
} {
3186 global browser_files browser_status browser_path
3187 global browser_stack browser_busy
3189 if {$browser_busy($w)} return
3190 set info
[lindex
$browser_files($w) 0]
3191 if {[lindex
$info 0] eq
{parent
}} {
3192 set parent
[lindex
$browser_stack($w) end-1
]
3193 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3194 if {$browser_stack($w) eq
{}} {
3195 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3197 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3199 set browser_status
($w) "Loading $browser_path($w)..."
3200 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3204 proc browser_enter
{w
} {
3205 global browser_files browser_status browser_path
3206 global browser_commit browser_stack browser_busy
3208 if {$browser_busy($w)} return
3209 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3210 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3212 switch
-- [lindex
$info 0] {
3217 set name
[lindex
$info 2]
3218 set escn
[escape_path
$name]
3219 set browser_status
($w) "Loading $escn..."
3220 append browser_path
($w) $escn
3221 ls_tree
$w [lindex
$info 1] $name
3224 set name
[lindex
$info 2]
3226 foreach n
$browser_stack($w) {
3227 append p
[lindex
$n 1]
3230 show_blame
$browser_commit($w) $p
3236 proc browser_click
{was_double_click w pos
} {
3237 global browser_files browser_busy
3239 if {$browser_busy($w)} return
3240 set lno
[lindex
[split [$w index
$pos] .
] 0]
3243 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3244 $w tag remove in_sel
0.0 end
3245 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3246 if {$was_double_click} {
3252 proc ls_tree
{w tree_id name
} {
3253 global browser_buffer browser_files browser_stack browser_busy
3255 set browser_buffer
($w) {}
3256 set browser_files
($w) {}
3257 set browser_busy
($w) 1
3259 $w conf
-state normal
3260 $w tag remove in_sel
0.0 end
3262 if {$browser_stack($w) ne
{}} {
3263 $w image create end \
3264 -align center
-padx 5 -pady 1 \
3267 $w insert end
{[Up To Parent
]}
3268 lappend browser_files
($w) parent
3270 lappend browser_stack
($w) [list
$tree_id $name]
3271 $w conf
-state disabled
3273 set cmd
[list git ls-tree
-z $tree_id]
3274 set fd
[open
"| $cmd" r
]
3275 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3276 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3279 proc read_ls_tree
{fd w
} {
3280 global browser_buffer browser_files browser_status browser_busy
3282 if {![winfo exists
$w]} {
3287 append browser_buffer
($w) [read $fd]
3288 set pck
[split $browser_buffer($w) "\0"]
3289 set browser_buffer
($w) [lindex
$pck end
]
3291 set n
[llength
$browser_files($w)]
3292 $w conf
-state normal
3293 foreach p
[lrange
$pck 0 end-1
] {
3294 set info
[split $p "\t"]
3295 set path
[lindex
$info 1]
3296 set info
[split [lindex
$info 0] { }]
3297 set type [lindex
$info 1]
3298 set object
[lindex
$info 2]
3309 set image file_question
3313 if {$n > 0} {$w insert end
"\n"}
3314 $w image create end \
3315 -align center
-padx 5 -pady 1 \
3316 -name icon
[incr n
] \
3318 $w insert end
[escape_path
$path]
3319 lappend browser_files
($w) [list
$type $object $path]
3321 $w conf
-state disabled
3325 set browser_status
($w) Ready.
3326 set browser_busy
($w) 0
3327 array
unset browser_buffer
$w
3329 $w tag add in_sel
1.0 2.0
3335 proc show_blame
{commit path
} {
3336 global next_browser_id blame_status blame_data
3338 if {[winfo ismapped .
]} {
3339 set w .browser
[incr next_browser_id
]
3346 set blame_status
($w) {Loading current
file content...
}
3348 label
$w.path
-text "$commit:$path" \
3354 pack
$w.path
-side top
-fill x
3357 text
$w.out.loaded_t \
3358 -background white
-borderwidth 0 \
3364 $w.out.loaded_t tag conf annotated
-background grey
3366 text
$w.out.linenumber_t \
3367 -background white
-borderwidth 0 \
3373 $w.out.linenumber_t tag conf linenumber
-justify right
3375 text
$w.out.file_t \
3376 -background white
-borderwidth 0 \
3381 -xscrollcommand [list
$w.out.sbx
set] \
3384 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3385 scrollbar
$w.out.sby
-orient v \
3386 -command [list scrollbar2many
[list \
3388 $w.out.linenumber_t \
3392 $w.out.linenumber_t \
3397 grid conf
$w.out.sbx
-column 2 -sticky we
3398 grid columnconfigure
$w.out
2 -weight 1
3399 grid rowconfigure
$w.out
0 -weight 1
3400 pack
$w.out
-fill both
-expand 1
3402 label
$w.status
-textvariable blame_status
($w) \
3408 pack
$w.status
-side bottom
-fill x
3412 -background white
-borderwidth 0 \
3417 -xscrollcommand [list
$w.cm.sbx
set] \
3418 -yscrollcommand [list
$w.cm.sby
set] \
3420 scrollbar
$w.cm.sbx
-orient h
-command [list
$w.cm.t xview
]
3421 scrollbar
$w.cm.sby
-orient v
-command [list
$w.cm.t yview
]
3422 pack
$w.cm.sby
-side right
-fill y
3423 pack
$w.cm.sbx
-side bottom
-fill x
3424 pack
$w.cm.t
-expand 1 -fill both
3425 pack
$w.cm
-side bottom
-fill x
3427 menu
$w.ctxm
-tearoff 0
3428 $w.ctxm add
command -label "Copy Commit" \
3430 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3434 $w.out.linenumber_t \
3436 $i tag conf in_sel \
3437 -background [$i cget
-foreground] \
3438 -foreground [$i cget
-background]
3439 $i conf
-yscrollcommand \
3440 [list many2scrollbar
[list \
3442 $w.out.linenumber_t \
3445 bind $i <Button-1
> "
3448 $w.out.linenumber_t \\
3457 tk_popup $w.ctxm %X %Y
3461 bind $w.cm.t
<Button-1
> "focus $w.cm.t"
3462 bind $tl <Visibility
> "focus $tl"
3463 bind $tl <Destroy
> "
3464 array unset blame_status {$w}
3465 array unset blame_data $w,*
3467 wm title
$tl "[appname] ([reponame]): File Viewer"
3469 set blame_data
($w,commit_count
) 0
3470 set blame_data
($w,commit_list
) {}
3471 set blame_data
($w,total_lines
) 0
3472 set blame_data
($w,blame_lines
) 0
3473 set blame_data
($w,highlight_commit
) {}
3474 set blame_data
($w,highlight_line
) -1
3476 set cmd
[list git cat-file blob
"$commit:$path"]
3477 set fd
[open
"| $cmd" r
]
3478 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3479 fileevent
$fd readable
[list read_blame_catfile \
3480 $fd $w $commit $path \
3481 $w.cm.t
$w.out.loaded_t
$w.out.linenumber_t
$w.out.file_t
]
3484 proc read_blame_catfile
{fd w commit path w_cmit w_load w_line w_file
} {
3485 global blame_status blame_data
3487 if {![winfo exists
$w_file]} {
3492 set n
$blame_data($w,total_lines
)
3493 $w_load conf
-state normal
3494 $w_line conf
-state normal
3495 $w_file conf
-state normal
3496 while {[gets
$fd line
] >= 0} {
3497 regsub
"\r\$" $line {} line
3499 $w_load insert end
"\n"
3500 $w_line insert end
"$n\n" linenumber
3501 $w_file insert end
"$line\n"
3503 $w_load conf
-state disabled
3504 $w_line conf
-state disabled
3505 $w_file conf
-state disabled
3506 set blame_data
($w,total_lines
) $n
3510 blame_incremental_status
$w
3511 set cmd
[list git blame
-M -C --incremental]
3512 lappend cmd
$commit -- $path
3513 set fd
[open
"| $cmd" r
]
3514 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3515 fileevent
$fd readable
[list read_blame_incremental
$fd $w \
3516 $w_load $w_cmit $w_line $w_file]
3520 proc read_blame_incremental
{fd w w_load w_cmit w_line w_file
} {
3521 global blame_status blame_data
3523 if {![winfo exists
$w_file]} {
3528 while {[gets
$fd line
] >= 0} {
3529 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3530 cmit original_line final_line line_count
]} {
3531 set blame_data
($w,commit
) $cmit
3532 set blame_data
($w,original_line
) $original_line
3533 set blame_data
($w,final_line
) $final_line
3534 set blame_data
($w,line_count
) $line_count
3536 if {[catch
{set g
$blame_data($w,$cmit,order
)}]} {
3537 $w_line tag conf g
$cmit
3538 $w_file tag conf g
$cmit
3539 $w_line tag raise in_sel
3540 $w_file tag raise in_sel
3541 $w_file tag raise sel
3542 set blame_data
($w,$cmit,order
) $blame_data($w,commit_count
)
3543 incr blame_data
($w,commit_count
)
3544 lappend blame_data
($w,commit_list
) $cmit
3546 } elseif
{[string match
{filename
*} $line]} {
3547 set file [string range
$line 9 end
]
3548 set n
$blame_data($w,line_count
)
3549 set lno
$blame_data($w,final_line
)
3550 set cmit
$blame_data($w,commit
)
3553 if {[catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3554 $w_load tag add annotated
$lno.0 "$lno.0 lineend + 1c"
3556 $w_line tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3557 $w_file tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3560 set blame_data
($w,line
$lno,commit
) $cmit
3561 set blame_data
($w,line
$lno,file) $file
3562 $w_line tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3563 $w_file tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3565 if {$blame_data($w,highlight_line
) == -1} {
3566 if {[lindex
[$w_file yview
] 0] == 0} {
3568 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3570 } elseif
{$blame_data($w,highlight_line
) == $lno} {
3571 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3576 incr blame_data
($w,blame_lines
)
3579 set hc
$blame_data($w,highlight_commit
)
3581 && [expr {$blame_data($w,$hc,order
) + 1}]
3582 == $blame_data($w,$cmit,order
)} {
3583 blame_showcommit
$w $w_cmit $w_line $w_file \
3584 $blame_data($w,highlight_line
)
3586 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3587 set blame_data
($w,$blame_data($w,commit
),$header) $data
3593 set blame_status
($w) {Annotation complete.
}
3595 blame_incremental_status
$w
3599 proc blame_incremental_status
{w
} {
3600 global blame_status blame_data
3602 set blame_status
($w) [format \
3603 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3604 $blame_data($w,blame_lines
) \
3605 $blame_data($w,total_lines
) \
3606 [expr {100 * $blame_data($w,blame_lines
)
3607 / $blame_data($w,total_lines
)}]]
3610 proc blame_click
{w w_cmit w_line w_file cur_w pos
} {
3611 set lno
[lindex
[split [$cur_w index
$pos] .
] 0]
3612 if {$lno eq
{}} return
3614 $w_line tag remove in_sel
0.0 end
3615 $w_file tag remove in_sel
0.0 end
3616 $w_line tag add in_sel
$lno.0 "$lno.0 + 1 line"
3617 $w_file tag add in_sel
$lno.0 "$lno.0 + 1 line"
3619 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3628 proc blame_showcommit
{w w_cmit w_line w_file lno
} {
3629 global blame_colors blame_data repo_config
3631 set cmit
$blame_data($w,highlight_commit
)
3633 set idx
$blame_data($w,$cmit,order
)
3635 foreach c
$blame_colors {
3636 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3637 $w_line tag conf g
$h -background white
3638 $w_file tag conf g
$h -background white
3643 $w_cmit conf
-state normal
3644 $w_cmit delete
0.0 end
3645 if {[catch
{set cmit
$blame_data($w,line
$lno,commit
)}]} {
3647 $w_cmit insert end
"Loading annotation..."
3649 set idx
$blame_data($w,$cmit,order
)
3651 foreach c
$blame_colors {
3652 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3653 $w_line tag conf g
$h -background $c
3654 $w_file tag conf g
$h -background $c
3658 if {[catch
{set msg
$blame_data($w,$cmit,message
)}]} {
3661 set fd
[open
"| git cat-file commit $cmit" r
]
3662 fconfigure
$fd -encoding binary
-translation lf
3663 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
3666 while {[gets
$fd line
] > 0} {
3667 if {[string match
{encoding
*} $line]} {
3668 set enc
[string tolower
[string range
$line 9 end
]]
3671 fconfigure
$fd -encoding $enc
3672 set msg
[string trim
[read $fd]]
3675 set blame_data
($w,$cmit,message
) $msg
3681 catch
{set author_name
$blame_data($w,$cmit,author
)}
3682 catch
{set author_email
$blame_data($w,$cmit,author-mail
)}
3683 catch
{set author_time
[clock format
$blame_data($w,$cmit,author-time
)]}
3685 set committer_name
{}
3686 set committer_email
{}
3687 set committer_time
{}
3688 catch
{set committer_name
$blame_data($w,$cmit,committer
)}
3689 catch
{set committer_email
$blame_data($w,$cmit,committer-mail
)}
3690 catch
{set committer_time
[clock format
$blame_data($w,$cmit,committer-time
)]}
3692 $w_cmit insert end
"commit $cmit\n"
3693 $w_cmit insert end
"Author: $author_name $author_email $author_time\n"
3694 $w_cmit insert end
"Committer: $committer_name $committer_email $committer_time\n"
3695 $w_cmit insert end
"Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3696 $w_cmit insert end
"\n"
3697 $w_cmit insert end
$msg
3699 $w_cmit conf
-state disabled
3701 set blame_data
($w,highlight_line
) $lno
3702 set blame_data
($w,highlight_commit
) $cmit
3705 proc blame_copycommit
{w i pos
} {
3707 set lno
[lindex
[split [$i index
$pos] .
] 0]
3708 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3717 ######################################################################
3722 #define mask_width 14
3723 #define mask_height 15
3724 static unsigned char mask_bits
[] = {
3725 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3726 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3727 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3730 image create bitmap file_plain
-background white
-foreground black
-data {
3731 #define plain_width 14
3732 #define plain_height 15
3733 static unsigned char plain_bits
[] = {
3734 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3735 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3736 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3737 } -maskdata $filemask
3739 image create bitmap file_mod
-background white
-foreground blue
-data {
3740 #define mod_width 14
3741 #define mod_height 15
3742 static unsigned char mod_bits
[] = {
3743 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3744 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3745 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3749 #define file_fulltick_width 14
3750 #define file_fulltick_height 15
3751 static unsigned char file_fulltick_bits
[] = {
3752 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3753 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3754 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3758 #define parttick_width 14
3759 #define parttick_height 15
3760 static unsigned char parttick_bits
[] = {
3761 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3762 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3763 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_question
-background white
-foreground black
-data {
3767 #define file_question_width 14
3768 #define file_question_height 15
3769 static unsigned char file_question_bits
[] = {
3770 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3771 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3772 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_removed
-background white
-foreground red
-data {
3776 #define file_removed_width 14
3777 #define file_removed_height 15
3778 static unsigned char file_removed_bits
[] = {
3779 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3780 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3781 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3784 image create bitmap file_merge
-background white
-foreground blue
-data {
3785 #define file_merge_width 14
3786 #define file_merge_height 15
3787 static unsigned char file_merge_bits
[] = {
3788 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3789 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3790 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3791 } -maskdata $filemask
3794 #define file_width 18
3795 #define file_height 18
3796 static unsigned char file_bits
[] = {
3797 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3798 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3799 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3800 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3801 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3803 image create bitmap file_dir
-background white
-foreground blue \
3804 -data $file_dir_data -maskdata $file_dir_data
3807 set file_uplevel_data
{
3809 #define up_height 15
3810 static unsigned char up_bits
[] = {
3811 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3812 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3813 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3815 image create bitmap file_uplevel
-background white
-foreground red \
3816 -data $file_uplevel_data -maskdata $file_uplevel_data
3817 unset file_uplevel_data
3819 set ui_index .vpane.files.index.list
3820 set ui_workdir .vpane.files.workdir.list
3822 set all_icons
(_
$ui_index) file_plain
3823 set all_icons
(A
$ui_index) file_fulltick
3824 set all_icons
(M
$ui_index) file_fulltick
3825 set all_icons
(D
$ui_index) file_removed
3826 set all_icons
(U
$ui_index) file_merge
3828 set all_icons
(_
$ui_workdir) file_plain
3829 set all_icons
(M
$ui_workdir) file_mod
3830 set all_icons
(D
$ui_workdir) file_question
3831 set all_icons
(U
$ui_workdir) file_merge
3832 set all_icons
(O
$ui_workdir) file_plain
3834 set max_status_desc
0
3838 {_M
"Modified, not staged"}
3839 {M_
"Staged for commit"}
3840 {MM
"Portions staged for commit"}
3841 {MD
"Staged for commit, missing"}
3843 {_O
"Untracked, not staged"}
3844 {A_
"Staged for commit"}
3845 {AM
"Portions staged for commit"}
3846 {AD
"Staged for commit, missing"}
3849 {D_
"Staged for removal"}
3850 {DO
"Staged for removal, still present"}
3852 {U_
"Requires merge resolution"}
3853 {UU
"Requires merge resolution"}
3854 {UM
"Requires merge resolution"}
3855 {UD
"Requires merge resolution"}
3857 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3858 set max_status_desc
[string length
[lindex
$i 1]]
3860 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3864 ######################################################################
3868 proc bind_button3
{w cmd
} {
3869 bind $w <Any-Button-3
> $cmd
3871 bind $w <Control-Button-1
> $cmd
3875 proc scrollbar2many
{list mode args
} {
3876 foreach w
$list {eval $w $mode $args}
3879 proc many2scrollbar
{list mode sb top bottom
} {
3880 $sb set $top $bottom
3881 foreach w
$list {$w $mode moveto
$top}
3884 proc incr_font_size
{font
{amt
1}} {
3885 set sz
[font configure
$font -size]
3887 font configure
$font -size $sz
3888 font configure
${font}bold
-size $sz
3891 proc hook_failed_popup
{hook msg
} {
3896 label
$w.m.l1
-text "$hook hook failed:" \
3901 -background white
-borderwidth 1 \
3903 -width 80 -height 10 \
3905 -yscrollcommand [list
$w.m.sby
set]
3907 -text {You must correct the above errors before committing.
} \
3911 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3912 pack
$w.m.l1
-side top
-fill x
3913 pack
$w.m.l2
-side bottom
-fill x
3914 pack
$w.m.sby
-side right
-fill y
3915 pack
$w.m.t
-side left
-fill both
-expand 1
3916 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3918 $w.m.t insert
1.0 $msg
3919 $w.m.t conf
-state disabled
3921 button
$w.ok
-text OK \
3924 -command "destroy $w"
3925 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3927 bind $w <Visibility
> "grab $w; focus $w"
3928 bind $w <Key-Return
> "destroy $w"
3929 wm title
$w "[appname] ([reponame]): error"
3933 set next_console_id
0
3935 proc new_console
{short_title long_title
} {
3936 global next_console_id console_data
3937 set w .console
[incr next_console_id
]
3938 set console_data
($w) [list
$short_title $long_title]
3939 return [console_init
$w]
3942 proc console_init
{w
} {
3943 global console_cr console_data M1B
3945 set console_cr
($w) 1.0
3948 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3953 -background white
-borderwidth 1 \
3955 -width 80 -height 10 \
3958 -yscrollcommand [list
$w.m.sby
set]
3959 label
$w.m.s
-text {Working... please
wait...
} \
3963 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3964 pack
$w.m.l1
-side top
-fill x
3965 pack
$w.m.s
-side bottom
-fill x
3966 pack
$w.m.sby
-side right
-fill y
3967 pack
$w.m.t
-side left
-fill both
-expand 1
3968 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3970 menu
$w.ctxm
-tearoff 0
3971 $w.ctxm add
command -label "Copy" \
3973 -command "tk_textCopy $w.m.t"
3974 $w.ctxm add
command -label "Select All" \
3976 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3977 $w.ctxm add
command -label "Copy All" \
3980 $w.m.t tag add sel 0.0 end
3982 $w.m.t tag remove sel 0.0 end
3985 button
$w.ok
-text {Close
} \
3988 -command "destroy $w"
3989 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3991 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3992 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3993 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3994 bind $w <Visibility
> "focus $w"
3995 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3999 proc console_exec
{w cmd after
} {
4000 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4001 # But most users need that so we have to relogin. :-(
4004 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
4007 # -- Tcl won't let us redirect both stdout and stderr to
4008 # the same pipe. So pass it through cat...
4010 set cmd
[concat |
$cmd |
& cat]
4012 set fd_f
[open
$cmd r
]
4013 fconfigure
$fd_f -blocking 0 -translation binary
4014 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
4017 proc console_read
{w fd after
} {
4022 if {![winfo exists
$w]} {console_init
$w}
4023 $w.m.t conf
-state normal
4025 set n
[string length
$buf]
4027 set cr
[string first
"\r" $buf $c]
4028 set lf
[string first
"\n" $buf $c]
4029 if {$cr < 0} {set cr
[expr {$n + 1}]}
4030 if {$lf < 0} {set lf
[expr {$n + 1}]}
4033 $w.m.t insert end
[string range
$buf $c $lf]
4034 set console_cr
($w) [$w.m.t index
{end
-1c}]
4038 $w.m.t delete
$console_cr($w) end
4039 $w.m.t insert end
"\n"
4040 $w.m.t insert end
[string range
$buf $c $cr]
4045 $w.m.t conf
-state disabled
4049 fconfigure
$fd -blocking 1
4051 if {[catch
{close
$fd}]} {
4056 uplevel
#0 $after $w $ok
4059 fconfigure
$fd -blocking 0
4062 proc console_chain
{cmdlist w
{ok
1}} {
4064 if {[llength
$cmdlist] == 0} {
4069 set cmd
[lindex
$cmdlist 0]
4070 set cmdlist
[lrange
$cmdlist 1 end
]
4072 if {[lindex
$cmd 0] eq
{console_exec
}} {
4075 [list console_chain
$cmdlist]
4077 uplevel
#0 $cmd $cmdlist $w $ok
4084 proc console_done
{args
} {
4085 global console_cr console_data
4087 switch
-- [llength
$args] {
4089 set w
[lindex
$args 0]
4090 set ok
[lindex
$args 1]
4093 set w
[lindex
$args 1]
4094 set ok
[lindex
$args 2]
4097 error
"wrong number of args: console_done ?ignored? w ok"
4102 if {[winfo exists
$w]} {
4103 $w.m.s conf
-background green
-text {Success
}
4104 $w.ok conf
-state normal
4107 if {![winfo exists
$w]} {
4110 $w.m.s conf
-background red
-text {Error
: Command Failed
}
4111 $w.ok conf
-state normal
4114 array
unset console_cr
$w
4115 array
unset console_data
$w
4118 ######################################################################
4122 set starting_gitk_msg
{Starting gitk... please
wait...
}
4124 proc do_gitk
{revs
} {
4125 global env ui_status_value starting_gitk_msg
4127 # -- Always start gitk through whatever we were loaded with. This
4128 # lets us bypass using shell process on Windows systems.
4130 set cmd
[info nameofexecutable
]
4131 lappend cmd
[gitexec gitk
]
4137 if {[catch
{eval exec $cmd &} err
]} {
4138 error_popup
"Failed to start gitk:\n\n$err"
4140 set ui_status_value
$starting_gitk_msg
4142 if {$ui_status_value eq
$starting_gitk_msg} {
4143 set ui_status_value
{Ready.
}
4150 set fd
[open
"| git count-objects -v" r
]
4151 while {[gets
$fd line
] > 0} {
4152 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
4153 set stats
($name) $value
4159 foreach p
[glob
-directory [gitdir objects pack
] \
4162 incr packed_sz
[file size
$p]
4164 if {$packed_sz > 0} {
4165 set stats
(size-pack
) [expr {$packed_sz / 1024}]
4170 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4172 label
$w.header
-text {Database Statistics
} \
4174 pack
$w.header
-side top
-fill x
4176 frame
$w.buttons
-border 1
4177 button
$w.buttons.close
-text Close \
4179 -command [list destroy
$w]
4180 button
$w.buttons.gc
-text {Compress Database
} \
4182 -command "destroy $w;do_gc"
4183 pack
$w.buttons.close
-side right
4184 pack
$w.buttons.gc
-side left
4185 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4187 frame
$w.stat
-borderwidth 1 -relief solid
4189 {count
{Number of loose objects
}}
4190 {size
{Disk space used by loose objects
} { KiB
}}
4191 {in-pack
{Number of packed objects
}}
4192 {packs
{Number of packs
}}
4193 {size-pack
{Disk space used by packed objects
} { KiB
}}
4194 {prune-packable
{Packed objects waiting
for pruning
}}
4195 {garbage
{Garbage files
}}
4197 set name
[lindex
$s 0]
4198 set label
[lindex
$s 1]
4199 if {[catch
{set value
$stats($name)}]} continue
4200 if {[llength
$s] > 2} {
4201 set value
"$value[lindex $s 2]"
4204 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4205 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4206 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4208 pack
$w.stat
-pady 10 -padx 10
4210 bind $w <Visibility
> "grab $w; focus $w"
4211 bind $w <Key-Escape
> [list destroy
$w]
4212 bind $w <Key-Return
> [list destroy
$w]
4213 wm title
$w "[appname] ([reponame]): Database Statistics"
4218 set w
[new_console
{gc
} {Compressing the object database
}]
4220 {console_exec
{git pack-refs
--prune}}
4221 {console_exec
{git reflog expire
--all}}
4222 {console_exec
{git repack
-a -d -l}}
4223 {console_exec
{git rerere gc
}}
4227 proc do_fsck_objects
{} {
4228 set w
[new_console
{fsck-objects
} \
4229 {Verifying the object database with fsck-objects
}]
4230 set cmd
[list git fsck-objects
]
4233 lappend cmd
--strict
4234 console_exec
$w $cmd console_done
4240 global ui_comm is_quitting repo_config commit_type
4242 if {$is_quitting} return
4245 if {[winfo exists
$ui_comm]} {
4246 # -- Stash our current commit buffer.
4248 set save
[gitdir GITGUI_MSG
]
4249 set msg
[string trim
[$ui_comm get
0.0 end
]]
4250 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4251 if {(![string match amend
* $commit_type]
4252 ||
[$ui_comm edit modified
])
4255 set fd
[open
$save w
]
4256 puts
-nonewline $fd $msg
4260 catch
{file delete
$save}
4263 # -- Stash our current window geometry into this repository.
4265 set cfg_geometry
[list
]
4266 lappend cfg_geometry
[wm geometry .
]
4267 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4268 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4269 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4272 if {$cfg_geometry ne
$rc_geometry} {
4273 catch
{git config gui.geometry
$cfg_geometry}
4281 rescan
{set ui_status_value
{Ready.
}}
4284 proc unstage_helper
{txt paths
} {
4285 global file_states current_diff_path
4287 if {![lock_index begin-update
]} return
4291 foreach path
$paths {
4292 switch
-glob -- [lindex
$file_states($path) 0] {
4296 lappend pathList
$path
4297 if {$path eq
$current_diff_path} {
4298 set after
{reshow_diff
;}
4303 if {$pathList eq
{}} {
4309 [concat
$after {set ui_status_value
{Ready.
}}]
4313 proc do_unstage_selection
{} {
4314 global current_diff_path selected_paths
4316 if {[array size selected_paths
] > 0} {
4318 {Unstaging selected files from commit
} \
4319 [array names selected_paths
]
4320 } elseif
{$current_diff_path ne
{}} {
4322 "Unstaging [short_path $current_diff_path] from commit" \
4323 [list
$current_diff_path]
4327 proc add_helper
{txt paths
} {
4328 global file_states current_diff_path
4330 if {![lock_index begin-update
]} return
4334 foreach path
$paths {
4335 switch
-glob -- [lindex
$file_states($path) 0] {
4340 lappend pathList
$path
4341 if {$path eq
$current_diff_path} {
4342 set after
{reshow_diff
;}
4347 if {$pathList eq
{}} {
4353 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4357 proc do_add_selection
{} {
4358 global current_diff_path selected_paths
4360 if {[array size selected_paths
] > 0} {
4362 {Adding selected files
} \
4363 [array names selected_paths
]
4364 } elseif
{$current_diff_path ne
{}} {
4366 "Adding [short_path $current_diff_path]" \
4367 [list
$current_diff_path]
4371 proc do_add_all
{} {
4375 foreach path
[array names file_states
] {
4376 switch
-glob -- [lindex
$file_states($path) 0] {
4379 ?D
{lappend paths
$path}
4382 add_helper
{Adding all changed files
} $paths
4385 proc revert_helper
{txt paths
} {
4386 global file_states current_diff_path
4388 if {![lock_index begin-update
]} return
4392 foreach path
$paths {
4393 switch
-glob -- [lindex
$file_states($path) 0] {
4397 lappend pathList
$path
4398 if {$path eq
$current_diff_path} {
4399 set after
{reshow_diff
;}
4405 set n
[llength
$pathList]
4409 } elseif
{$n == 1} {
4410 set s
"[short_path [lindex $pathList]]"
4412 set s
"these $n files"
4415 set reply
[tk_dialog \
4417 "[appname] ([reponame])" \
4418 "Revert changes in $s?
4420 Any unadded changes will be permanently lost by the revert." \
4430 [concat
$after {set ui_status_value
{Ready.
}}]
4436 proc do_revert_selection
{} {
4437 global current_diff_path selected_paths
4439 if {[array size selected_paths
] > 0} {
4441 {Reverting selected files
} \
4442 [array names selected_paths
]
4443 } elseif
{$current_diff_path ne
{}} {
4445 "Reverting [short_path $current_diff_path]" \
4446 [list
$current_diff_path]
4450 proc do_signoff
{} {
4453 set me
[committer_ident
]
4454 if {$me eq
{}} return
4456 set sob
"Signed-off-by: $me"
4457 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4458 if {$last ne
$sob} {
4459 $ui_comm edit separator
4461 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4462 $ui_comm insert end
"\n"
4464 $ui_comm insert end
"\n$sob"
4465 $ui_comm edit separator
4470 proc do_select_commit_type
{} {
4471 global commit_type selected_commit_type
4473 if {$selected_commit_type eq
{new
}
4474 && [string match amend
* $commit_type]} {
4476 } elseif
{$selected_commit_type eq
{amend
}
4477 && ![string match amend
* $commit_type]} {
4480 # The amend request was rejected...
4482 if {![string match amend
* $commit_type]} {
4483 set selected_commit_type new
4493 global appvers copyright
4494 global tcl_patchLevel tk_patchLevel
4498 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4500 label
$w.header
-text "About [appname]" \
4502 pack
$w.header
-side top
-fill x
4505 button
$w.buttons.close
-text {Close
} \
4507 -command [list destroy
$w]
4508 pack
$w.buttons.close
-side right
4509 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4512 -text "git-gui - a graphical user interface for Git.
4520 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4523 append v
"git-gui version $appvers\n"
4524 append v
"[git version]\n"
4526 if {$tcl_patchLevel eq
$tk_patchLevel} {
4527 append v
"Tcl/Tk version $tcl_patchLevel"
4529 append v
"Tcl version $tcl_patchLevel"
4530 append v
", Tk version $tk_patchLevel"
4541 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4543 menu
$w.ctxm
-tearoff 0
4544 $w.ctxm add
command \
4549 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4552 bind $w <Visibility
> "grab $w; focus $w"
4553 bind $w <Key-Escape
> "destroy $w"
4554 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4555 wm title
$w "About [appname]"
4559 proc do_options
{} {
4560 global repo_config global_config font_descs
4561 global repo_config_new global_config_new
4563 array
unset repo_config_new
4564 array
unset global_config_new
4565 foreach name
[array names repo_config
] {
4566 set repo_config_new
($name) $repo_config($name)
4569 foreach name
[array names repo_config
] {
4571 gui.diffcontext
{continue}
4573 set repo_config_new
($name) $repo_config($name)
4575 foreach name
[array names global_config
] {
4576 set global_config_new
($name) $global_config($name)
4579 set w .options_editor
4581 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4583 label
$w.header
-text "Options" \
4585 pack
$w.header
-side top
-fill x
4588 button
$w.buttons.restore
-text {Restore Defaults
} \
4590 -command do_restore_defaults
4591 pack
$w.buttons.restore
-side left
4592 button
$w.buttons.save
-text Save \
4594 -command [list do_save_config
$w]
4595 pack
$w.buttons.save
-side right
4596 button
$w.buttons.cancel
-text {Cancel
} \
4598 -command [list destroy
$w]
4599 pack
$w.buttons.cancel
-side right
-padx 5
4600 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4602 labelframe
$w.repo
-text "[reponame] Repository" \
4604 labelframe
$w.global
-text {Global
(All Repositories
)} \
4606 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4607 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4611 {t user.name
{User Name
}}
4612 {t user.email
{Email Address
}}
4614 {b merge.summary
{Summarize Merge Commits
}}
4615 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4617 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4618 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4619 {t gui.newbranchtemplate
{New Branch Name Template
}}
4621 set type [lindex
$option 0]
4622 set name
[lindex
$option 1]
4623 set text
[lindex
$option 2]
4625 foreach f
{repo global
} {
4626 switch
-glob -- $type {
4628 checkbutton
$w.
$f.
$optid -text $text \
4629 -variable ${f}_config_new
($name) \
4633 pack
$w.
$f.
$optid -side top
-anchor w
4636 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4638 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4639 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4640 spinbox
$w.
$f.
$optid.v \
4641 -textvariable ${f}_config_new
($name) \
4645 -width [expr {1 + [string length
$max]}] \
4647 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4648 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4649 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4653 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4654 entry
$w.
$f.
$optid.v \
4658 -textvariable ${f}_config_new
($name) \
4660 pack
$w.
$f.
$optid.l
-side left
-anchor w
4661 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4664 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4670 set all_fonts
[lsort
[font families
]]
4671 foreach option
$font_descs {
4672 set name
[lindex
$option 0]
4673 set font
[lindex
$option 1]
4674 set text
[lindex
$option 2]
4676 set global_config_new
(gui.
$font^^family
) \
4677 [font configure
$font -family]
4678 set global_config_new
(gui.
$font^^size
) \
4679 [font configure
$font -size]
4681 frame
$w.global.
$name
4682 label
$w.global.
$name.l
-text "$text:" -font font_ui
4683 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4684 eval tk_optionMenu
$w.global.
$name.family \
4685 global_config_new
(gui.
$font^^family
) \
4687 spinbox
$w.global.
$name.size \
4688 -textvariable global_config_new
(gui.
$font^^size
) \
4689 -from 2 -to 80 -increment 1 \
4692 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4693 pack
$w.global.
$name.size
-side right
-anchor e
4694 pack
$w.global.
$name.family
-side right
-anchor e
4695 pack
$w.global.
$name -side top
-anchor w
-fill x
4698 bind $w <Visibility
> "grab $w; focus $w"
4699 bind $w <Key-Escape
> "destroy $w"
4700 wm title
$w "[appname] ([reponame]): Options"
4704 proc do_restore_defaults
{} {
4705 global font_descs default_config repo_config
4706 global repo_config_new global_config_new
4708 foreach name
[array names default_config
] {
4709 set repo_config_new
($name) $default_config($name)
4710 set global_config_new
($name) $default_config($name)
4713 foreach option
$font_descs {
4714 set name
[lindex
$option 0]
4715 set repo_config
(gui.
$name) $default_config(gui.
$name)
4719 foreach option
$font_descs {
4720 set name
[lindex
$option 0]
4721 set font
[lindex
$option 1]
4722 set global_config_new
(gui.
$font^^family
) \
4723 [font configure
$font -family]
4724 set global_config_new
(gui.
$font^^size
) \
4725 [font configure
$font -size]
4729 proc do_save_config
{w
} {
4730 if {[catch
{save_config
} err
]} {
4731 error_popup
"Failed to completely save options:\n\n$err"
4737 proc do_windows_shortcut
{} {
4740 set fn
[tk_getSaveFile \
4742 -title "[appname] ([reponame]): Create Desktop Icon" \
4743 -initialfile "Git [reponame].bat"]
4747 puts
$fd "@ECHO Entering [reponame]"
4748 puts
$fd "@ECHO Starting git-gui... please wait..."
4749 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4750 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4751 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4752 puts
$fd " \"[file normalize $argv0]\""
4755 error_popup
"Cannot write script:\n\n$err"
4760 proc do_cygwin_shortcut
{} {
4764 set desktop
[exec cygpath \
4772 set fn
[tk_getSaveFile \
4774 -title "[appname] ([reponame]): Create Desktop Icon" \
4775 -initialdir $desktop \
4776 -initialfile "Git [reponame].bat"]
4780 set sh
[exec cygpath \
4784 set me
[exec cygpath \
4788 set gd
[exec cygpath \
4792 set gw
[exec cygpath \
4795 [file dirname [gitdir
]]]
4796 regsub
-all ' $me "'\\''" me
4797 regsub -all ' $gd "'\\''" gd
4798 puts $fd "@ECHO Entering $gw"
4799 puts $fd "@ECHO Starting git-gui... please wait..."
4800 puts -nonewline $fd "@\"$sh\" --login -c \""
4801 puts -nonewline $fd "GIT_DIR='$gd'"
4802 puts -nonewline $fd " '$me'"
4806 error_popup "Cannot write script:\n\n$err"
4811 proc do_macosx_app {} {
4814 set fn [tk_getSaveFile \
4816 -title "[appname] ([reponame]): Create Desktop Icon" \
4817 -initialdir [file join $env(HOME) Desktop] \
4818 -initialfile "Git [reponame].app"]
4821 set Contents [file join $fn Contents]
4822 set MacOS [file join $Contents MacOS]
4823 set exe [file join $MacOS git-gui]
4827 set fd [open [file join $Contents Info.plist] w]
4828 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4829 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4830 <plist version="1.0">
4832 <key>CFBundleDevelopmentRegion</key>
4833 <string>English</string>
4834 <key>CFBundleExecutable</key>
4835 <string>git-gui</string>
4836 <key>CFBundleIdentifier</key>
4837 <string>org.spearce.git-gui</string>
4838 <key>CFBundleInfoDictionaryVersion</key>
4839 <string>6.0</string>
4840 <key>CFBundlePackageType</key>
4841 <string>APPL</string>
4842 <key>CFBundleSignature</key>
4843 <string>????</string>
4844 <key>CFBundleVersion</key>
4845 <string>1.0</string>
4846 <key>NSPrincipalClass</key>
4847 <string>NSApplication</string>
4852 set fd [open $exe w]
4853 set gd [file normalize [gitdir]]
4854 set ep [file normalize [gitexec]]
4855 regsub -all ' $gd "'\\''" gd
4856 regsub
-all ' $ep "'\\''" ep
4857 puts $fd "#!/bin/sh"
4858 foreach name
[array names env
] {
4859 if {[string match GIT_
* $name]} {
4860 regsub
-all ' $env($name) "'\\''" v
4861 puts $fd "export $name='$v'"
4864 puts $fd "export PATH
='$ep':\
$PATH"
4865 puts $fd "export GIT_DIR
='$gd'"
4866 puts $fd "exec [file normalize
$argv0]"
4869 file attributes $exe -permissions u+x,g+x,o+x
4871 error_popup "Cannot
write icon
:\n\n$err"
4876 proc toggle_or_diff {w x y} {
4877 global file_states file_lists current_diff_path ui_index ui_workdir
4878 global last_clicked selected_paths
4880 set pos [split [$w index @$x,$y] .]
4881 set lno [lindex $pos 0]
4882 set col [lindex $pos 1]
4883 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4889 set last_clicked [list $w $lno]
4890 array unset selected_paths
4891 $ui_index tag remove in_sel 0.0 end
4892 $ui_workdir tag remove in_sel 0.0 end
4895 if {$current_diff_path eq $path} {
4896 set after {reshow_diff;}
4900 if {$w eq $ui_index} {
4902 "Unstaging
[short_path
$path] from commit
" \
4904 [concat $after {set ui_status_value {Ready.}}]
4905 } elseif {$w eq $ui_workdir} {
4907 "Adding
[short_path
$path]" \
4909 [concat $after {set ui_status_value {Ready.}}]
4912 show_diff $path $w $lno
4916 proc add_one_to_selection {w x y} {
4917 global file_lists last_clicked selected_paths
4919 set lno [lindex [split [$w index @$x,$y] .] 0]
4920 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4926 if {$last_clicked ne {}
4927 && [lindex $last_clicked 0] ne $w} {
4928 array unset selected_paths
4929 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4932 set last_clicked [list $w $lno]
4933 if {[catch {set in_sel $selected_paths($path)}]} {
4937 unset selected_paths($path)
4938 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4940 set selected_paths($path) 1
4941 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4945 proc add_range_to_selection {w x y} {
4946 global file_lists last_clicked selected_paths
4948 if {[lindex $last_clicked 0] ne $w} {
4949 toggle_or_diff $w $x $y
4953 set lno [lindex [split [$w index @$x,$y] .] 0]
4954 set lc [lindex $last_clicked 1]
4963 foreach path [lrange $file_lists($w) \
4964 [expr {$begin - 1}] \
4965 [expr {$end - 1}]] {
4966 set selected_paths($path) 1
4968 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4971 ######################################################################
4975 set cursor_ptr arrow
4976 font create font_diff -family Courier -size 10
4980 eval font configure font_ui [font actual [.dummy cget -font]]
4984 font create font_uibold
4985 font create font_diffbold
4990 } elseif {[is_MacOSX]} {
4998 proc apply_config {} {
4999 global repo_config font_descs
5001 foreach option $font_descs {
5002 set name [lindex $option 0]
5003 set font [lindex $option 1]
5005 foreach {cn cv} $repo_config(gui.$name) {
5006 font configure $font $cn $cv
5009 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
5011 foreach {cn cv} [font configure $font] {
5012 font configure ${font}bold $cn $cv
5014 font configure ${font}bold -weight bold
5018 set default_config(merge.summary) false
5019 set default_config(merge.verbosity) 2
5020 set default_config(user.name) {}
5021 set default_config(user.email) {}
5023 set default_config(gui.trustmtime) false
5024 set default_config(gui.diffcontext) 5
5025 set default_config(gui.newbranchtemplate) {}
5026 set default_config(gui.fontui) [font configure font_ui]
5027 set default_config(gui.fontdiff) [font configure font_diff]
5029 {fontui font_ui {Main Font}}
5030 {fontdiff font_diff {Diff/Console Font}}
5035 ######################################################################
5037 ## feature option selection
5039 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5044 if {$subcommand eq {gui.sh}} {
5047 if {$subcommand eq {gui} && [llength $argv] > 0} {
5048 set subcommand [lindex $argv 0]
5049 set argv [lrange $argv 1 end]
5052 enable_option multicommit
5053 enable_option branch
5054 enable_option transport
5056 switch -- $subcommand {
5061 disable_option multicommit
5062 disable_option branch
5063 disable_option transport
5066 enable_option singlecommit
5068 disable_option multicommit
5069 disable_option branch
5070 disable_option transport
5074 ######################################################################
5082 menu .mbar -tearoff 0
5083 .mbar add cascade -label Repository -menu .mbar.repository
5084 .mbar add cascade -label Edit -menu .mbar.edit
5085 if {[is_enabled branch]} {
5086 .mbar add cascade -label Branch -menu .mbar.branch
5088 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5089 .mbar add cascade -label Commit -menu .mbar.commit
5091 if {[is_enabled transport]} {
5092 .mbar add cascade -label Merge -menu .mbar.merge
5093 .mbar add cascade -label Fetch -menu .mbar.fetch
5094 .mbar add cascade -label Push -menu .mbar.push
5096 . configure -menu .mbar
5098 # -- Repository Menu
5100 menu .mbar.repository
5102 .mbar.repository add command \
5103 -label {Browse Current Branch} \
5104 -command {new_browser $current_branch} \
5106 trace add variable current_branch write ".mbar.repository entryconf
[.mbar.repository index last
] -label \"Browse \
$current_branch\" ;#"
5107 .mbar.repository add separator
5109 .mbar.repository add
command \
5110 -label {Visualize Current Branch
} \
5111 -command {do_gitk
$current_branch} \
5113 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5114 .mbar.repository add
command \
5115 -label {Visualize All Branches
} \
5116 -command {do_gitk
--all} \
5118 .mbar.repository add separator
5120 if {[is_enabled multicommit
]} {
5121 .mbar.repository add
command -label {Database Statistics
} \
5125 .mbar.repository add
command -label {Compress Database
} \
5129 .mbar.repository add
command -label {Verify Database
} \
5130 -command do_fsck_objects \
5133 .mbar.repository add separator
5136 .mbar.repository add
command \
5137 -label {Create Desktop Icon
} \
5138 -command do_cygwin_shortcut \
5140 } elseif
{[is_Windows
]} {
5141 .mbar.repository add
command \
5142 -label {Create Desktop Icon
} \
5143 -command do_windows_shortcut \
5145 } elseif
{[is_MacOSX
]} {
5146 .mbar.repository add
command \
5147 -label {Create Desktop Icon
} \
5148 -command do_macosx_app \
5153 .mbar.repository add
command -label Quit \
5155 -accelerator $M1T-Q \
5161 .mbar.edit add
command -label Undo \
5162 -command {catch
{[focus
] edit undo
}} \
5163 -accelerator $M1T-Z \
5165 .mbar.edit add
command -label Redo \
5166 -command {catch
{[focus
] edit redo
}} \
5167 -accelerator $M1T-Y \
5169 .mbar.edit add separator
5170 .mbar.edit add
command -label Cut \
5171 -command {catch
{tk_textCut
[focus
]}} \
5172 -accelerator $M1T-X \
5174 .mbar.edit add
command -label Copy \
5175 -command {catch
{tk_textCopy
[focus
]}} \
5176 -accelerator $M1T-C \
5178 .mbar.edit add
command -label Paste \
5179 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
5180 -accelerator $M1T-V \
5182 .mbar.edit add
command -label Delete \
5183 -command {catch
{[focus
] delete sel.first sel.last
}} \
5186 .mbar.edit add separator
5187 .mbar.edit add
command -label {Select All
} \
5188 -command {catch
{[focus
] tag add sel
0.0 end
}} \
5189 -accelerator $M1T-A \
5194 if {[is_enabled branch
]} {
5197 .mbar.branch add
command -label {Create...
} \
5198 -command do_create_branch \
5199 -accelerator $M1T-N \
5201 lappend disable_on_lock
[list .mbar.branch entryconf \
5202 [.mbar.branch index last
] -state]
5204 .mbar.branch add
command -label {Delete...
} \
5205 -command do_delete_branch \
5207 lappend disable_on_lock
[list .mbar.branch entryconf \
5208 [.mbar.branch index last
] -state]
5210 .mbar.branch add
command -label {Reset...
} \
5211 -command do_reset_hard \
5213 lappend disable_on_lock
[list .mbar.branch entryconf \
5214 [.mbar.branch index last
] -state]
5219 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
5222 .mbar.commit add radiobutton \
5223 -label {New Commit
} \
5224 -command do_select_commit_type \
5225 -variable selected_commit_type \
5228 lappend disable_on_lock \
5229 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5231 .mbar.commit add radiobutton \
5232 -label {Amend Last Commit
} \
5233 -command do_select_commit_type \
5234 -variable selected_commit_type \
5237 lappend disable_on_lock \
5238 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5240 .mbar.commit add separator
5242 .mbar.commit add
command -label Rescan \
5243 -command do_rescan \
5246 lappend disable_on_lock \
5247 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5249 .mbar.commit add
command -label {Add To Commit
} \
5250 -command do_add_selection \
5252 lappend disable_on_lock \
5253 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5255 .mbar.commit add
command -label {Add Existing To Commit
} \
5256 -command do_add_all \
5257 -accelerator $M1T-I \
5259 lappend disable_on_lock \
5260 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5262 .mbar.commit add
command -label {Unstage From Commit
} \
5263 -command do_unstage_selection \
5265 lappend disable_on_lock \
5266 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5268 .mbar.commit add
command -label {Revert Changes
} \
5269 -command do_revert_selection \
5271 lappend disable_on_lock \
5272 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5274 .mbar.commit add separator
5276 .mbar.commit add
command -label {Sign Off
} \
5277 -command do_signoff \
5278 -accelerator $M1T-S \
5281 .mbar.commit add
command -label Commit \
5282 -command do_commit \
5283 -accelerator $M1T-Return \
5285 lappend disable_on_lock \
5286 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5291 if {[is_enabled branch
]} {
5293 .mbar.merge add
command -label {Local Merge...
} \
5294 -command do_local_merge \
5296 lappend disable_on_lock \
5297 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5298 .mbar.merge add
command -label {Abort Merge...
} \
5299 -command do_reset_hard \
5301 lappend disable_on_lock \
5302 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5308 if {[is_enabled transport
]} {
5312 .mbar.push add
command -label {Push...
} \
5313 -command do_push_anywhere \
5318 # -- Apple Menu (Mac OS X only)
5320 .mbar add cascade
-label Apple
-menu .mbar.apple
5323 .mbar.apple add
command -label "About [appname]" \
5326 .mbar.apple add
command -label "Options..." \
5327 -command do_options \
5332 .mbar.edit add separator
5333 .mbar.edit add
command -label {Options...
} \
5334 -command do_options \
5339 if {[file exists
/usr
/local
/miga
/lib
/gui-miga
]
5340 && [file exists .pvcsrc
]} {
5342 global ui_status_value
5343 if {![lock_index update
]} return
5344 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5345 set miga_fd
[open
"|$cmd" r
]
5346 fconfigure
$miga_fd -blocking 0
5347 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
5348 set ui_status_value
{Running miga...
}
5350 proc miga_done
{fd
} {
5355 rescan
[list
set ui_status_value
{Ready.
}]
5358 .mbar add cascade
-label Tools
-menu .mbar.tools
5360 .mbar.tools add
command -label "Migrate" \
5363 lappend disable_on_lock \
5364 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
5370 .mbar add cascade
-label Help
-menu .mbar.
help
5374 .mbar.
help add
command -label "About [appname]" \
5380 catch
{set browser
$repo_config(instaweb.browser
)}
5381 set doc_path
[file dirname [gitexec
]]
5382 set doc_path
[file join $doc_path Documentation index.html
]
5385 set doc_path
[exec cygpath
--mixed $doc_path]
5388 if {$browser eq
{}} {
5391 } elseif
{[is_Cygwin
]} {
5392 set program_files
[file dirname [exec cygpath
--windir]]
5393 set program_files
[file join $program_files {Program Files
}]
5394 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
5395 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
5396 if {[file exists
$firefox]} {
5397 set browser
$firefox
5398 } elseif
{[file exists
$ie]} {
5401 unset program_files firefox ie
5405 if {[file isfile
$doc_path]} {
5406 set doc_url
"file:$doc_path"
5408 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
5411 if {$browser ne
{}} {
5412 .mbar.
help add
command -label {Online Documentation
} \
5413 -command [list
exec $browser $doc_url &] \
5416 unset browser doc_path doc_url
5418 # -- Standard bindings
5420 bind .
<Destroy
> do_quit
5421 bind all
<$M1B-Key-q> do_quit
5422 bind all
<$M1B-Key-Q> do_quit
5423 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
5424 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
5426 # -- Not a normal commit type invocation? Do that instead!
5428 switch
-- $subcommand {
5431 puts
"git-gui version $appvers"
5435 if {[llength
$argv] != 1} {
5436 puts stderr
"usage: $argv0 browser commit"
5439 set current_branch
[lindex
$argv 0]
5440 new_browser
$current_branch
5444 if {[llength
$argv] != 2} {
5445 puts stderr
"usage: $argv0 blame commit path"
5448 set current_branch
[lindex
$argv 0]
5449 show_blame
$current_branch [lindex
$argv 1]
5454 if {[llength
$argv] != 0} {
5455 puts
-nonewline stderr
"usage: $argv0"
5456 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
5457 puts
-nonewline stderr
" $subcommand"
5462 # fall through to setup UI for commits
5465 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
5476 -text {Current Branch
:} \
5481 -textvariable current_branch \
5485 pack .branch.l1
-side left
5486 pack .branch.cb
-side left
-fill x
5487 pack .branch
-side top
-fill x
5489 # -- Main Window Layout
5491 panedwindow .vpane
-orient vertical
5492 panedwindow .vpane.files
-orient horizontal
5493 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
5494 pack .vpane
-anchor n
-side top
-fill both
-expand 1
5496 # -- Index File List
5498 frame .vpane.files.index
-height 100 -width 200
5499 label .vpane.files.index.title
-text {Changes To Be Committed
} \
5502 text
$ui_index -background white
-borderwidth 0 \
5503 -width 20 -height 10 \
5506 -cursor $cursor_ptr \
5507 -xscrollcommand {.vpane.files.index.sx
set} \
5508 -yscrollcommand {.vpane.files.index.sy
set} \
5510 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
5511 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
5512 pack .vpane.files.index.title
-side top
-fill x
5513 pack .vpane.files.index.sx
-side bottom
-fill x
5514 pack .vpane.files.index.sy
-side right
-fill y
5515 pack
$ui_index -side left
-fill both
-expand 1
5516 .vpane.files add .vpane.files.index
-sticky nsew
5518 # -- Working Directory File List
5520 frame .vpane.files.workdir
-height 100 -width 200
5521 label .vpane.files.workdir.title
-text {Changed But Not Updated
} \
5524 text
$ui_workdir -background white
-borderwidth 0 \
5525 -width 20 -height 10 \
5528 -cursor $cursor_ptr \
5529 -xscrollcommand {.vpane.files.workdir.sx
set} \
5530 -yscrollcommand {.vpane.files.workdir.sy
set} \
5532 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
5533 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
5534 pack .vpane.files.workdir.title
-side top
-fill x
5535 pack .vpane.files.workdir.sx
-side bottom
-fill x
5536 pack .vpane.files.workdir.sy
-side right
-fill y
5537 pack
$ui_workdir -side left
-fill both
-expand 1
5538 .vpane.files add .vpane.files.workdir
-sticky nsew
5540 foreach i
[list
$ui_index $ui_workdir] {
5541 $i tag conf in_diff
-font font_uibold
5542 $i tag conf in_sel \
5543 -background [$i cget
-foreground] \
5544 -foreground [$i cget
-background]
5548 # -- Diff and Commit Area
5550 frame .vpane.lower
-height 300 -width 400
5551 frame .vpane.lower.commarea
5552 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
5553 pack .vpane.lower.commarea
-side top
-fill x
5554 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
5555 .vpane add .vpane.lower
-sticky nsew
5557 # -- Commit Area Buttons
5559 frame .vpane.lower.commarea.buttons
5560 label .vpane.lower.commarea.buttons.l
-text {} \
5564 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
5565 pack .vpane.lower.commarea.buttons
-side left
-fill y
5567 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
5568 -command do_rescan \
5570 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
5571 lappend disable_on_lock \
5572 {.vpane.lower.commarea.buttons.rescan conf
-state}
5574 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
5575 -command do_add_all \
5577 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
5578 lappend disable_on_lock \
5579 {.vpane.lower.commarea.buttons.incall conf
-state}
5581 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
5582 -command do_signoff \
5584 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
5586 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
5587 -command do_commit \
5589 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
5590 lappend disable_on_lock \
5591 {.vpane.lower.commarea.buttons.commit conf
-state}
5593 # -- Commit Message Buffer
5595 frame .vpane.lower.commarea.buffer
5596 frame .vpane.lower.commarea.buffer.header
5597 set ui_comm .vpane.lower.commarea.buffer.t
5598 set ui_coml .vpane.lower.commarea.buffer.header.l
5599 radiobutton .vpane.lower.commarea.buffer.header.new \
5600 -text {New Commit
} \
5601 -command do_select_commit_type \
5602 -variable selected_commit_type \
5605 lappend disable_on_lock \
5606 [list .vpane.lower.commarea.buffer.header.new conf
-state]
5607 radiobutton .vpane.lower.commarea.buffer.header.amend \
5608 -text {Amend Last Commit
} \
5609 -command do_select_commit_type \
5610 -variable selected_commit_type \
5613 lappend disable_on_lock \
5614 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
5619 proc trace_commit_type
{varname args
} {
5620 global ui_coml commit_type
5621 switch
-glob -- $commit_type {
5622 initial
{set txt
{Initial Commit Message
:}}
5623 amend
{set txt
{Amended Commit Message
:}}
5624 amend-initial
{set txt
{Amended Initial Commit Message
:}}
5625 amend-merge
{set txt
{Amended Merge Commit Message
:}}
5626 merge
{set txt
{Merge Commit Message
:}}
5627 * {set txt
{Commit Message
:}}
5629 $ui_coml conf
-text $txt
5631 trace add variable commit_type
write trace_commit_type
5632 pack
$ui_coml -side left
-fill x
5633 pack .vpane.lower.commarea.buffer.header.amend
-side right
5634 pack .vpane.lower.commarea.buffer.header.new
-side right
5636 text
$ui_comm -background white
-borderwidth 1 \
5639 -autoseparators true \
5641 -width 75 -height 9 -wrap none \
5643 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
5644 scrollbar .vpane.lower.commarea.buffer.sby \
5645 -command [list
$ui_comm yview
]
5646 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
5647 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
5648 pack
$ui_comm -side left
-fill y
5649 pack .vpane.lower.commarea.buffer
-side left
-fill y
5651 # -- Commit Message Buffer Context Menu
5653 set ctxm .vpane.lower.commarea.buffer.ctxm
5654 menu
$ctxm -tearoff 0
5658 -command {tk_textCut
$ui_comm}
5662 -command {tk_textCopy
$ui_comm}
5666 -command {tk_textPaste
$ui_comm}
5670 -command {$ui_comm delete sel.first sel.last
}
5673 -label {Select All
} \
5675 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
5680 $ui_comm tag add sel
0.0 end
5681 tk_textCopy
$ui_comm
5682 $ui_comm tag remove sel
0.0 end
5689 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
5693 proc trace_current_diff_path
{varname args
} {
5694 global current_diff_path diff_actions file_states
5695 if {$current_diff_path eq
{}} {
5701 set p
$current_diff_path
5702 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
5704 set p
[escape_path
$p]
5708 .vpane.lower.
diff.header.status configure
-text $s
5709 .vpane.lower.
diff.header.
file configure
-text $f
5710 .vpane.lower.
diff.header.path configure
-text $p
5711 foreach w
$diff_actions {
5715 trace add variable current_diff_path
write trace_current_diff_path
5717 frame .vpane.lower.
diff.header
-background orange
5718 label .vpane.lower.
diff.header.status \
5719 -background orange \
5720 -width $max_status_desc \
5724 label .vpane.lower.
diff.header.
file \
5725 -background orange \
5729 label .vpane.lower.
diff.header.path \
5730 -background orange \
5734 pack .vpane.lower.
diff.header.status
-side left
5735 pack .vpane.lower.
diff.header.
file -side left
5736 pack .vpane.lower.
diff.header.path
-fill x
5737 set ctxm .vpane.lower.
diff.header.ctxm
5738 menu
$ctxm -tearoff 0
5747 -- $current_diff_path
5749 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5750 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
5754 frame .vpane.lower.
diff.body
5755 set ui_diff .vpane.lower.
diff.body.t
5756 text
$ui_diff -background white
-borderwidth 0 \
5757 -width 80 -height 15 -wrap none \
5759 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
5760 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
5762 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
5763 -command [list
$ui_diff xview
]
5764 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
5765 -command [list
$ui_diff yview
]
5766 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
5767 pack .vpane.lower.
diff.body.sby
-side right
-fill y
5768 pack
$ui_diff -side left
-fill both
-expand 1
5769 pack .vpane.lower.
diff.header
-side top
-fill x
5770 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
5772 $ui_diff tag conf d_cr
-elide true
5773 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
5774 $ui_diff tag conf d_
+ -foreground {#00a000}
5775 $ui_diff tag conf d_-
-foreground red
5777 $ui_diff tag conf d_
++ -foreground {#00a000}
5778 $ui_diff tag conf d_--
-foreground red
5779 $ui_diff tag conf d_
+s \
5780 -foreground {#00a000} \
5781 -background {#e2effa}
5782 $ui_diff tag conf d_-s \
5784 -background {#e2effa}
5785 $ui_diff tag conf d_s
+ \
5786 -foreground {#00a000} \
5788 $ui_diff tag conf d_s- \
5792 $ui_diff tag conf d
<<<<<<< \
5793 -foreground orange \
5795 $ui_diff tag conf d
======= \
5796 -foreground orange \
5798 $ui_diff tag conf d
>>>>>>> \
5799 -foreground orange \
5802 $ui_diff tag raise sel
5804 # -- Diff Body Context Menu
5806 set ctxm .vpane.lower.
diff.body.ctxm
5807 menu
$ctxm -tearoff 0
5811 -command reshow_diff
5812 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5816 -command {tk_textCopy
$ui_diff}
5817 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5819 -label {Select All
} \
5821 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
5822 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5827 $ui_diff tag add sel
0.0 end
5828 tk_textCopy
$ui_diff
5829 $ui_diff tag remove sel
0.0 end
5831 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5834 -label {Apply
/Reverse Hunk
} \
5836 -command {apply_hunk
$cursorX $cursorY}
5837 set ui_diff_applyhunk
[$ctxm index last
]
5838 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
5841 -label {Decrease Font Size
} \
5843 -command {incr_font_size font_diff
-1}
5844 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5846 -label {Increase Font Size
} \
5848 -command {incr_font_size font_diff
1}
5849 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5852 -label {Show Less Context
} \
5854 -command {if {$repo_config(gui.diffcontext
) >= 2} {
5855 incr repo_config
(gui.diffcontext
) -1
5858 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5860 -label {Show More Context
} \
5863 incr repo_config
(gui.diffcontext
)
5866 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5868 $ctxm add
command -label {Options...
} \
5871 bind_button3
$ui_diff "
5874 if {\$ui_index eq \$current_diff_side} {
5875 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5877 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5879 tk_popup $ctxm %X %Y
5881 unset ui_diff_applyhunk
5885 label .status
-textvariable ui_status_value \
5891 pack .status
-anchor w
-side bottom
-fill x
5896 set gm
$repo_config(gui.geometry
)
5897 wm geometry .
[lindex
$gm 0]
5898 .vpane sash place
0 \
5899 [lindex
[.vpane sash coord
0] 0] \
5901 .vpane.files sash place
0 \
5903 [lindex
[.vpane.files sash coord
0] 1]
5909 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
5910 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
5911 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
5912 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
5913 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
5914 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
5915 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
5916 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
5917 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
5918 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5919 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5921 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
5922 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
5923 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
5924 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
5925 bind $ui_diff <$M1B-Key-v> {break}
5926 bind $ui_diff <$M1B-Key-V> {break}
5927 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5928 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5929 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
5930 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
5931 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
5932 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
5933 bind $ui_diff <Button-1
> {focus
%W
}
5935 if {[is_enabled branch
]} {
5936 bind .
<$M1B-Key-n> do_create_branch
5937 bind .
<$M1B-Key-N> do_create_branch
5940 bind all
<Key-F5
> do_rescan
5941 bind all
<$M1B-Key-r> do_rescan
5942 bind all
<$M1B-Key-R> do_rescan
5943 bind .
<$M1B-Key-s> do_signoff
5944 bind .
<$M1B-Key-S> do_signoff
5945 bind .
<$M1B-Key-i> do_add_all
5946 bind .
<$M1B-Key-I> do_add_all
5947 bind .
<$M1B-Key-Return> do_commit
5948 foreach i
[list
$ui_index $ui_workdir] {
5949 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
5950 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5951 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
5955 set file_lists
($ui_index) [list
]
5956 set file_lists
($ui_workdir) [list
]
5958 wm title .
"[appname] ([file normalize [file dirname [gitdir]]])"
5959 focus
-force $ui_comm
5961 # -- Warn the user about environmental problems. Cygwin's Tcl
5962 # does *not* pass its env array onto any processes it spawns.
5963 # This means that git processes get none of our environment.
5968 set msg
"Possible environment issues exist.
5970 The following environment variables are probably
5971 going to be ignored by any Git subprocess run
5975 foreach name
[array names env
] {
5976 switch
-regexp -- $name {
5977 {^GIT_INDEX_FILE$
} -
5978 {^GIT_OBJECT_DIRECTORY$
} -
5979 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
5981 {^GIT_EXTERNAL_DIFF$
} -
5985 {^GIT_CONFIG_LOCAL$
} -
5986 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
5987 append msg
" - $name\n"
5990 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
5991 append msg
" - $name\n"
5993 set suggest_user
$name
5997 if {$ignored_env > 0} {
5999 This is due to a known issue with the
6000 Tcl binary distributed by Cygwin."
6002 if {$suggest_user ne
{}} {
6005 A good replacement for $suggest_user
6006 is placing values for the user.name and
6007 user.email settings into your personal
6013 unset ignored_env msg suggest_user name
6016 # -- Only initialize complex UI if we are going to stay running.
6018 if {[is_enabled transport
]} {
6022 populate_branch_menu
6027 # -- Only suggest a gc run if we are going to stay running.
6029 if {[is_enabled multicommit
]} {
6030 set object_limit
2000
6031 if {[is_Windows
]} {set object_limit
200}
6032 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
6033 if {$objects_current >= $object_limit} {
6035 "This repository currently has $objects_current loose objects.
6037 To maintain optimal performance it is strongly
6038 recommended that you compress the database
6039 when more than $object_limit loose objects exist.
6041 Compress the database now?"] eq
yes} {
6045 unset object_limit _junk objects_current
6048 lock_index begin-read