2 # Tcl ignores the next line -*- tcl -*- \
6 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
8 This program is free software
; you can redistribute it and
/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation
; either version
2 of the License
, or
11 (at your option
) any later version.
13 This program is distributed
in the hope that it will be useful
,
14 but WITHOUT ANY WARRANTY
; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License
for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program
; if not
, write to the Free Software
20 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
22 set appvers
{@@GIT_VERSION@@
}
23 set appname
[lindex
[file split $argv0] end
]
26 ######################################################################
30 proc is_many_config
{name
} {
31 switch
-glob -- $name {
40 proc load_config
{include_global
} {
41 global repo_config global_config default_config
43 array
unset global_config
44 if {$include_global} {
46 set fd_rc
[open
"| git repo-config --global --list" r
]
47 while {[gets
$fd_rc line
] >= 0} {
48 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
49 if {[is_many_config
$name]} {
50 lappend global_config
($name) $value
52 set global_config
($name) $value
60 array
unset repo_config
62 set fd_rc
[open
"| git repo-config --list" r
]
63 while {[gets
$fd_rc line
] >= 0} {
64 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
65 if {[is_many_config
$name]} {
66 lappend repo_config
($name) $value
68 set repo_config
($name) $value
75 foreach name
[array names default_config
] {
76 if {[catch
{set v
$global_config($name)}]} {
77 set global_config
($name) $default_config($name)
79 if {[catch
{set v
$repo_config($name)}]} {
80 set repo_config
($name) $default_config($name)
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
90 foreach option
$font_descs {
91 set name
[lindex
$option 0]
92 set font
[lindex
$option 1]
93 font configure
$font \
94 -family $global_config_new(gui.
$font^^family
) \
95 -size $global_config_new(gui.
$font^^size
)
96 font configure
${font}bold \
97 -family $global_config_new(gui.
$font^^family
) \
98 -size $global_config_new(gui.
$font^^size
)
99 set global_config_new
(gui.
$name) [font configure
$font]
100 unset global_config_new
(gui.
$font^^family
)
101 unset global_config_new
(gui.
$font^^size
)
104 foreach name
[array names default_config
] {
105 set value
$global_config_new($name)
106 if {$value ne
$global_config($name)} {
107 if {$value eq
$default_config($name)} {
108 catch
{exec git repo-config
--global --unset $name}
110 regsub
-all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
121 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
127 regsub -all "\
[{}\
]" $value {"} value
128 exec git repo-config
$name $value
130 set repo_config
($name) $value
135 proc error_popup
{msg
} {
136 global gitdir appname
141 append title
[lindex \
142 [file split [file normalize
[file dirname $gitdir]]] \
146 set cmd
[list tk_messageBox \
149 -title "$title: error" \
151 if {[winfo ismapped .
]} {
152 lappend cmd
-parent .
157 proc warn_popup
{msg
} {
158 global gitdir appname
163 append title
[lindex \
164 [file split [file normalize
[file dirname $gitdir]]] \
168 set cmd
[list tk_messageBox \
171 -title "$title: warning" \
173 if {[winfo ismapped .
]} {
174 lappend cmd
-parent .
179 proc info_popup
{msg
} {
180 global gitdir appname
185 append title
[lindex \
186 [file split [file normalize
[file dirname $gitdir]]] \
198 proc ask_popup
{msg
} {
199 global gitdir appname
204 append title
[lindex \
205 [file split [file normalize
[file dirname $gitdir]]] \
209 return [tk_messageBox \
217 ######################################################################
221 if { [catch
{set gitdir
$env(GIT_DIR
)}]
222 && [catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
223 catch
{wm withdraw .
}
224 error_popup
"Cannot find the git directory:\n\n$err"
227 if {![file isdirectory
$gitdir]} {
228 catch
{wm withdraw .
}
229 error_popup
"Git directory not found:\n\n$gitdir"
232 if {[lindex
[file split $gitdir] end
] ne
{.git
}} {
233 catch
{wm withdraw .
}
234 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
237 if {[catch
{cd [file dirname $gitdir]} err
]} {
238 catch
{wm withdraw .
}
239 error_popup
"No working directory [file dirname $gitdir]:\n\n$err"
242 set reponame
[lindex
[file split \
243 [file normalize
[file dirname $gitdir]]] \
247 if {$appname eq
{git-citool
}} {
251 ######################################################################
259 set disable_on_lock
[list
]
260 set index_lock_type none
262 proc lock_index
{type} {
263 global index_lock_type disable_on_lock
265 if {$index_lock_type eq
{none
}} {
266 set index_lock_type
$type
267 foreach w
$disable_on_lock {
268 uplevel
#0 $w disabled
271 } elseif
{$index_lock_type eq
"begin-$type"} {
272 set index_lock_type
$type
278 proc unlock_index
{} {
279 global index_lock_type disable_on_lock
281 set index_lock_type none
282 foreach w
$disable_on_lock {
287 ######################################################################
291 proc repository_state
{ctvar hdvar mhvar
} {
292 global gitdir current_branch
293 upvar
$ctvar ct
$hdvar hd
$mhvar mh
297 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
298 set current_branch
{}
300 regsub ^refs
/((heads|tags|remotes
)/)? \
306 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
312 set merge_head
[file join $gitdir MERGE_HEAD
]
313 if {[file exists
$merge_head]} {
315 set fd_mh
[open
$merge_head r
]
316 while {[gets
$fd_mh line
] >= 0} {
327 global PARENT empty_tree
329 set p
[lindex
$PARENT 0]
333 if {$empty_tree eq
{}} {
334 set empty_tree
[exec git mktree
<< {}]
339 proc rescan
{after
} {
340 global HEAD PARENT MERGE_HEAD commit_type
341 global ui_index ui_other ui_status_value ui_comm
342 global rescan_active file_states
345 if {$rescan_active > 0 ||
![lock_index
read]} return
347 repository_state newType newHEAD newMERGE_HEAD
348 if {[string match amend
* $commit_type]
349 && $newType eq
{normal
}
350 && $newHEAD eq
$HEAD} {
354 set MERGE_HEAD
$newMERGE_HEAD
355 set commit_type
$newType
358 array
unset file_states
360 if {![$ui_comm edit modified
]
361 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
362 if {[load_message GITGUI_MSG
]} {
363 } elseif
{[load_message MERGE_MSG
]} {
364 } elseif
{[load_message SQUASH_MSG
]} {
367 $ui_comm edit modified false
370 if {$repo_config(gui.trustmtime
) eq
{true
}} {
371 rescan_stage2
{} $after
374 set ui_status_value
{Refreshing
file status...
}
375 set cmd
[list git update-index
]
377 lappend cmd
--unmerged
378 lappend cmd
--ignore-missing
379 lappend cmd
--refresh
380 set fd_rf
[open
"| $cmd" r
]
381 fconfigure
$fd_rf -blocking 0 -translation binary
382 fileevent
$fd_rf readable \
383 [list rescan_stage2
$fd_rf $after]
387 proc rescan_stage2
{fd after
} {
388 global gitdir ui_status_value
389 global rescan_active buf_rdi buf_rdf buf_rlo
393 if {![eof
$fd]} return
397 set ls_others
[list | git ls-files
--others -z \
398 --exclude-per-directory=.gitignore
]
399 set info_exclude
[file join $gitdir info exclude
]
400 if {[file readable
$info_exclude]} {
401 lappend ls_others
"--exclude-from=$info_exclude"
409 set ui_status_value
{Scanning
for modified files ...
}
410 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
411 set fd_df
[open
"| git diff-files -z" r
]
412 set fd_lo
[open
$ls_others r
]
414 fconfigure
$fd_di -blocking 0 -translation binary
415 fconfigure
$fd_df -blocking 0 -translation binary
416 fconfigure
$fd_lo -blocking 0 -translation binary
417 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
418 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
419 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
422 proc load_message
{file} {
423 global gitdir ui_comm
425 set f
[file join $gitdir $file]
426 if {[file isfile
$f]} {
427 if {[catch
{set fd
[open
$f r
]}]} {
430 set content
[string trim
[read $fd]]
432 $ui_comm delete
0.0 end
433 $ui_comm insert end
$content
439 proc read_diff_index
{fd after
} {
442 append buf_rdi
[read $fd]
444 set n
[string length
$buf_rdi]
446 set z1
[string first
"\0" $buf_rdi $c]
449 set z2
[string first
"\0" $buf_rdi $z1]
453 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
455 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
457 [list
[lindex
$i 0] [lindex
$i 2]] \
463 set buf_rdi
[string range
$buf_rdi $c end
]
468 rescan_done
$fd buf_rdi
$after
471 proc read_diff_files
{fd after
} {
474 append buf_rdf
[read $fd]
476 set n
[string length
$buf_rdf]
478 set z1
[string first
"\0" $buf_rdf $c]
481 set z2
[string first
"\0" $buf_rdf $z1]
485 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
487 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
490 [list
[lindex
$i 0] [lindex
$i 2]]
495 set buf_rdf
[string range
$buf_rdf $c end
]
500 rescan_done
$fd buf_rdf
$after
503 proc read_ls_others
{fd after
} {
506 append buf_rlo
[read $fd]
507 set pck
[split $buf_rlo "\0"]
508 set buf_rlo
[lindex
$pck end
]
509 foreach p
[lrange
$pck 0 end-1
] {
512 rescan_done
$fd buf_rlo
$after
515 proc rescan_done
{fd buf after
} {
517 global file_states repo_config
520 if {![eof
$fd]} return
523 if {[incr rescan_active
-1] > 0} return
529 if {$repo_config(gui.partialinclude
) ne
{true
}} {
531 foreach path
[array names file_states
] {
532 switch
-- [lindex
$file_states($path) 0] {
534 M?
{lappend pathList
$path}
537 if {$pathList ne
{}} {
539 "Updating included files" \
541 [concat
{reshow_diff
;} $after]
550 proc prune_selection
{} {
551 global file_states selected_paths
553 foreach path
[array names selected_paths
] {
554 if {[catch
{set still_here
$file_states($path)}]} {
555 unset selected_paths
($path)
560 ######################################################################
565 global ui_diff current_diff ui_index ui_other
567 $ui_diff conf
-state normal
568 $ui_diff delete
0.0 end
569 $ui_diff conf
-state disabled
573 $ui_index tag remove in_diff
0.0 end
574 $ui_other tag remove in_diff
0.0 end
577 proc reshow_diff
{} {
578 global current_diff ui_status_value file_states
580 if {$current_diff eq
{}
581 ||
[catch
{set s
$file_states($current_diff)}]} {
584 show_diff
$current_diff
588 proc handle_empty_diff
{} {
589 global current_diff file_states file_lists
591 set path
$current_diff
592 set s
$file_states($path)
593 if {[lindex
$s 0] ne
{_M
}} return
595 info_popup
"No differences detected.
597 [short_path $path] has no changes.
599 The modification date of this file was updated
600 by another application and you currently have
601 the Trust File Modification Timestamps option
602 enabled, so Git did not automatically detect
603 that there are no content differences in this
606 This file will now be removed from the modified
607 files list, to prevent possible confusion.
609 if {[catch
{exec git update-index
-- $path} err
]} {
610 error_popup
"Failed to refresh index:\n\n$err"
614 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
615 set lno
[lsearch
-sorted $file_lists($old_w) $path]
617 set file_lists
($old_w) \
618 [lreplace
$file_lists($old_w) $lno $lno]
620 $old_w conf
-state normal
621 $old_w delete
$lno.0 [expr {$lno + 1}].0
622 $old_w conf
-state disabled
626 proc show_diff
{path
{w
{}} {lno
{}}} {
627 global file_states file_lists
628 global is_3way_diff diff_active repo_config
629 global ui_diff current_diff ui_status_value
631 if {$diff_active ||
![lock_index
read]} return
634 if {$w eq
{} ||
$lno == {}} {
635 foreach w
[array names file_lists
] {
636 set lno
[lsearch
-sorted $file_lists($w) $path]
643 if {$w ne
{} && $lno >= 1} {
644 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
647 set s
$file_states($path)
651 set current_diff
$path
652 set ui_status_value
"Loading diff of [escape_path $path]..."
654 set cmd
[list | git diff-index
]
655 lappend cmd
--no-color
656 if {$repo_config(gui.diffcontext
) > 0} {
657 lappend cmd
"-U$repo_config(gui.diffcontext)"
667 set fd
[open
$path r
]
668 set content
[read $fd]
673 set ui_status_value
"Unable to display [escape_path $path]"
674 error_popup
"Error loading file:\n\n$err"
677 $ui_diff conf
-state normal
678 $ui_diff insert end
$content
679 $ui_diff conf
-state disabled
682 set ui_status_value
{Ready.
}
691 if {[catch
{set fd
[open
$cmd r
]} err
]} {
694 set ui_status_value
"Unable to display [escape_path $path]"
695 error_popup
"Error loading diff:\n\n$err"
699 fconfigure
$fd -blocking 0 -translation auto
700 fileevent
$fd readable
[list read_diff
$fd]
703 proc read_diff
{fd
} {
704 global ui_diff ui_status_value is_3way_diff diff_active
707 $ui_diff conf
-state normal
708 while {[gets
$fd line
] >= 0} {
709 # -- Cleanup uninteresting diff header lines.
711 if {[string match
{diff --git *} $line]} continue
712 if {[string match
{diff --combined *} $line]} continue
713 if {[string match
{--- *} $line]} continue
714 if {[string match
{+++ *} $line]} continue
715 if {$line eq
{deleted
file mode
120000}} {
716 set line
"deleted symlink"
719 # -- Automatically detect if this is a 3 way diff.
721 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
723 # -- Reformat a 3 way diff, 'cause its too weird.
726 set op
[string range
$line 0 1]
729 {++} {set tags d_
+ ; set op
{ +}}
730 {--} {set tags d_-
; set op
{ -}}
731 { +} {set tags d_
++; set op
{++}}
732 { -} {set tags d_--
; set op
{--}}
733 {+ } {set tags d_-
+; set op
{-+}}
734 {- } {set tags d_
+-; set op
{+-}}
735 default
{set tags
{}}
737 set line
[string replace
$line 0 1 $op]
739 switch
-- [string index
$line 0] {
743 default
{set tags
{}}
746 $ui_diff insert end
$line $tags
747 $ui_diff insert end
"\n" $tags
749 $ui_diff conf
-state disabled
755 set ui_status_value
{Ready.
}
757 if {$repo_config(gui.trustmtime
) eq
{true
}
758 && [$ui_diff index end
] eq
{2.0}} {
764 ######################################################################
768 proc load_last_commit
{} {
769 global HEAD PARENT MERGE_HEAD commit_type ui_comm
771 if {[llength
$PARENT] == 0} {
772 error_popup
{There is nothing to amend.
774 You are about to create the initial commit.
775 There is no commit before this to amend.
780 repository_state curType curHEAD curMERGE_HEAD
781 if {$curType eq
{merge
}} {
782 error_popup
{Cannot amend
while merging.
784 You are currently
in the middle of a merge that
785 has not been fully completed. You cannot amend
786 the prior commit unless you first abort the
787 current merge activity.
795 set fd
[open
"| git cat-file commit $curHEAD" r
]
796 while {[gets
$fd line
] > 0} {
797 if {[string match
{parent
*} $line]} {
798 lappend parents
[string range
$line 7 end
]
801 set msg
[string trim
[read $fd]]
804 error_popup
"Error loading commit data for amend:\n\n$err"
810 set MERGE_HEAD
[list
]
811 switch
-- [llength
$parents] {
812 0 {set commit_type amend-initial
}
813 1 {set commit_type amend
}
814 default
{set commit_type amend-merge
}
817 $ui_comm delete
0.0 end
818 $ui_comm insert end
$msg
820 $ui_comm edit modified false
821 rescan
{set ui_status_value
{Ready.
}}
824 proc create_new_commit
{} {
825 global commit_type ui_comm
827 set commit_type normal
828 $ui_comm delete
0.0 end
830 $ui_comm edit modified false
831 rescan
{set ui_status_value
{Ready.
}}
834 set GIT_COMMITTER_IDENT
{}
836 proc committer_ident
{} {
837 global GIT_COMMITTER_IDENT
839 if {$GIT_COMMITTER_IDENT eq
{}} {
840 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
841 error_popup
"Unable to obtain your identity:\n\n$err"
844 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
845 $me me GIT_COMMITTER_IDENT
]} {
846 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
851 return $GIT_COMMITTER_IDENT
854 proc commit_tree
{} {
855 global HEAD commit_type file_states ui_comm repo_config
857 if {![lock_index update
]} return
858 if {[committer_ident
] eq
{}} return
860 # -- Our in memory state should match the repository.
862 repository_state curType curHEAD curMERGE_HEAD
863 if {[string match amend
* $commit_type]
864 && $curType eq
{normal
}
865 && $curHEAD eq
$HEAD} {
866 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
867 info_popup
{Last scanned state does not match repository state.
869 Another Git program has modified this repository
870 since the last scan. A rescan must be performed
871 before another commit can be created.
873 The rescan will be automatically started now.
876 rescan
{set ui_status_value
{Ready.
}}
880 # -- At least one file should differ in the index.
883 foreach path
[array names file_states
] {
884 switch
-glob -- [lindex
$file_states($path) 0] {
888 M?
{set files_ready
1; break}
890 error_popup
"Unmerged files cannot be committed.
892 File [short_path $path] has merge conflicts.
893 You must resolve them and include the file before committing.
899 error_popup
"Unknown file state [lindex $s 0] detected.
901 File [short_path $path] cannot be committed by this program.
907 error_popup
{No included files to commit.
909 You must include
at least
1 file before you can commit.
915 # -- A message is required.
917 set msg
[string trim
[$ui_comm get
1.0 end
]]
919 error_popup
{Please supply a commit message.
921 A good commit message has the following format
:
923 - First line
: Describe
in one sentance what you did.
925 - Remaining lines
: Describe why this change is good.
931 # -- Update included files if partialincludes are off.
933 if {$repo_config(gui.partialinclude
) ne
{true
}} {
935 foreach path
[array names file_states
] {
936 switch
-glob -- [lindex
$file_states($path) 0] {
938 M?
{lappend pathList
$path}
941 if {$pathList ne
{}} {
944 "Updating included files" \
946 [concat
{lock_index update
;} \
947 [list commit_prehook
$curHEAD $msg]]
952 commit_prehook
$curHEAD $msg
955 proc commit_prehook
{curHEAD msg
} {
956 global gitdir ui_status_value pch_error
958 set pchook
[file join $gitdir hooks pre-commit
]
960 # On Cygwin [file executable] might lie so we need to ask
961 # the shell if the hook is executable. Yes that's annoying.
963 if {[is_Windows
] && [file isfile
$pchook]} {
964 set pchook
[list sh
-c [concat \
965 "if test -x \"$pchook\";" \
966 "then exec \"$pchook\" 2>&1;" \
968 } elseif
{[file executable
$pchook]} {
969 set pchook
[list
$pchook |
& cat]
971 commit_writetree
$curHEAD $msg
975 set ui_status_value
{Calling pre-commit hook...
}
977 set fd_ph
[open
"| $pchook" r
]
978 fconfigure
$fd_ph -blocking 0 -translation binary
979 fileevent
$fd_ph readable \
980 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
983 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
984 global pch_error ui_status_value
986 append pch_error
[read $fd_ph]
987 fconfigure
$fd_ph -blocking 1
989 if {[catch
{close
$fd_ph}]} {
990 set ui_status_value
{Commit declined by pre-commit hook.
}
991 hook_failed_popup pre-commit
$pch_error
994 commit_writetree
$curHEAD $msg
999 fconfigure
$fd_ph -blocking 0
1002 proc commit_writetree
{curHEAD msg
} {
1003 global ui_status_value
1005 set ui_status_value
{Committing changes...
}
1006 set fd_wt
[open
"| git write-tree" r
]
1007 fileevent
$fd_wt readable \
1008 [list commit_committree
$fd_wt $curHEAD $msg]
1011 proc commit_committree
{fd_wt curHEAD msg
} {
1012 global HEAD PARENT MERGE_HEAD commit_type
1013 global single_commit gitdir
1014 global ui_status_value ui_comm selected_commit_type
1015 global file_states selected_paths rescan_active
1018 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1019 error_popup
"write-tree failed:\n\n$err"
1020 set ui_status_value
{Commit failed.
}
1025 # -- Create the commit.
1027 set cmd
[list git commit-tree
$tree_id]
1028 set parents
[concat
$PARENT $MERGE_HEAD]
1029 if {[llength
$parents] > 0} {
1030 foreach p
$parents {
1034 # git commit-tree writes to stderr during initial commit.
1035 lappend cmd
2>/dev
/null
1038 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1039 error_popup
"commit-tree failed:\n\n$err"
1040 set ui_status_value
{Commit failed.
}
1045 # -- Update the HEAD ref.
1048 if {$commit_type ne
{normal
}} {
1049 append reflogm
" ($commit_type)"
1051 set i
[string first
"\n" $msg]
1053 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1055 append reflogm
{: } $msg
1057 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1058 if {[catch
{eval exec $cmd} err
]} {
1059 error_popup
"update-ref failed:\n\n$err"
1060 set ui_status_value
{Commit failed.
}
1065 # -- Cleanup after ourselves.
1067 catch
{file delete
[file join $gitdir MERGE_HEAD
]}
1068 catch
{file delete
[file join $gitdir MERGE_MSG
]}
1069 catch
{file delete
[file join $gitdir SQUASH_MSG
]}
1070 catch
{file delete
[file join $gitdir GITGUI_MSG
]}
1072 # -- Let rerere do its thing.
1074 if {[file isdirectory
[file join $gitdir rr-cache
]]} {
1075 catch
{exec git rerere
}
1078 # -- Run the post-commit hook.
1080 set pchook
[file join $gitdir hooks post-commit
]
1081 if {[is_Windows
] && [file isfile
$pchook]} {
1082 set pchook
[list sh
-c [concat \
1083 "if test -x \"$pchook\";" \
1084 "then exec \"$pchook\";" \
1086 } elseif
{![file executable
$pchook]} {
1089 if {$pchook ne
{}} {
1090 catch
{exec $pchook &}
1093 $ui_comm delete
0.0 end
1095 $ui_comm edit modified false
1097 if {$single_commit} do_quit
1099 # -- Update in memory status
1101 set selected_commit_type new
1102 set commit_type normal
1105 set MERGE_HEAD
[list
]
1107 foreach path
[array names file_states
] {
1108 set s
$file_states($path)
1110 switch
-glob -- $m {
1118 unset file_states
($path)
1119 catch
{unset selected_paths
($path)}
1122 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1129 set file_states
($path) [list \
1130 _
[string index
$m 1] \
1141 set ui_status_value \
1142 "Changes committed as [string range $cmt_id 0 7]."
1145 ######################################################################
1149 proc fetch_from
{remote
} {
1150 set w
[new_console
"fetch $remote" \
1151 "Fetching new changes from $remote"]
1152 set cmd
[list git fetch
]
1154 console_exec
$w $cmd
1157 proc pull_remote
{remote branch
} {
1158 global HEAD commit_type file_states repo_config
1160 if {![lock_index update
]} return
1162 # -- Our in memory state should match the repository.
1164 repository_state curType curHEAD curMERGE_HEAD
1165 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1166 info_popup
{Last scanned state does not match repository state.
1168 Another Git program has modified this repository
1169 since the last scan. A rescan must be performed
1170 before a pull operation can be started.
1172 The rescan will be automatically started now.
1175 rescan
{set ui_status_value
{Ready.
}}
1179 # -- No differences should exist before a pull.
1181 if {[array size file_states
] != 0} {
1182 error_popup
{Uncommitted but modified files are present.
1184 You should not perform a pull with unmodified
1185 files
in your working directory as Git will be
1186 unable to recover from an incorrect merge.
1188 You should commit or revert all changes before
1189 starting a pull operation.
1195 set w
[new_console
"pull $remote $branch" \
1196 "Pulling new changes from branch $branch in $remote"]
1197 set cmd
[list git pull
]
1198 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1199 lappend cmd
--no-summary
1203 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1206 proc post_pull_remote
{remote branch success
} {
1207 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1208 global ui_status_value
1212 repository_state commit_type HEAD MERGE_HEAD
1214 set selected_commit_type new
1215 set ui_status_value
"Pulling $branch from $remote complete."
1217 rescan
[list
set ui_status_value \
1218 "Conflicts detected while pulling $branch from $remote."]
1222 proc push_to
{remote
} {
1223 set w
[new_console
"push $remote" \
1224 "Pushing changes to $remote"]
1225 set cmd
[list git push
]
1227 console_exec
$w $cmd
1230 ######################################################################
1234 proc mapcol
{state path
} {
1235 global all_cols ui_other
1237 if {[catch
{set r
$all_cols($state)}]} {
1238 puts
"error: no column for state={$state} $path"
1244 proc mapicon
{state path
} {
1247 if {[catch
{set r
$all_icons($state)}]} {
1248 puts
"error: no icon for state={$state} $path"
1254 proc mapdesc
{state path
} {
1257 if {[catch
{set r
$all_descs($state)}]} {
1258 puts
"error: no desc for state={$state} $path"
1264 proc escape_path
{path
} {
1265 regsub
-all "\n" $path "\\n" path
1269 proc short_path
{path
} {
1270 return [escape_path
[lindex
[file split $path] end
]]
1274 set null_sha1
[string repeat
0 40]
1276 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1277 global file_states next_icon_id null_sha1
1279 set s0
[string index
$new_state 0]
1280 set s1
[string index
$new_state 1]
1282 if {[catch
{set info
$file_states($path)}]} {
1284 set icon n
[incr next_icon_id
]
1286 set state
[lindex
$info 0]
1287 set icon
[lindex
$info 1]
1288 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1289 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1292 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1293 elseif
{$s0 eq
{_
}} {set s0 _
}
1295 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1296 elseif
{$s1 eq
{_
}} {set s1 _
}
1298 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1299 set head_info
[list
0 $null_sha1]
1300 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1301 && $head_info eq
{}} {
1302 set head_info
$index_info
1305 set file_states
($path) [list
$s0$s1 $icon \
1306 $head_info $index_info \
1311 proc display_file
{path state
} {
1312 global file_states file_lists selected_paths
1314 set old_m
[merge_state
$path $state]
1315 set s
$file_states($path)
1316 set new_m
[lindex
$s 0]
1317 set new_w
[mapcol
$new_m $path]
1318 set old_w
[mapcol
$old_m $path]
1319 set new_icon
[mapicon
$new_m $path]
1321 if {$new_m eq
{__
}} {
1322 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1324 set file_lists
($old_w) \
1325 [lreplace
$file_lists($old_w) $lno $lno]
1327 $old_w conf
-state normal
1328 $old_w delete
$lno.0 [expr {$lno + 1}].0
1329 $old_w conf
-state disabled
1331 unset file_states
($path)
1332 catch
{unset selected_paths
($path)}
1336 if {$new_w ne
$old_w} {
1337 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1339 set file_lists
($old_w) \
1340 [lreplace
$file_lists($old_w) $lno $lno]
1342 $old_w conf
-state normal
1343 $old_w delete
$lno.0 [expr {$lno + 1}].0
1344 $old_w conf
-state disabled
1347 lappend file_lists
($new_w) $path
1348 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1349 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1351 $new_w conf
-state normal
1352 $new_w image create
$lno.0 \
1353 -align center
-padx 5 -pady 1 \
1354 -name [lindex
$s 1] \
1356 $new_w insert
$lno.1 "[escape_path $path]\n"
1357 if {[catch
{set in_sel
$selected_paths($path)}]} {
1361 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1363 $new_w conf
-state disabled
1364 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1365 $new_w conf
-state normal
1366 $new_w image conf
[lindex
$s 1] -image $new_icon
1367 $new_w conf
-state disabled
1371 proc display_all_files
{} {
1372 global ui_index ui_other
1373 global file_states file_lists
1374 global last_clicked selected_paths
1376 $ui_index conf
-state normal
1377 $ui_other conf
-state normal
1379 $ui_index delete
0.0 end
1380 $ui_other delete
0.0 end
1383 set file_lists
($ui_index) [list
]
1384 set file_lists
($ui_other) [list
]
1386 foreach path
[lsort
[array names file_states
]] {
1387 set s
$file_states($path)
1389 set w
[mapcol
$m $path]
1390 lappend file_lists
($w) $path
1391 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1392 $w image create end \
1393 -align center
-padx 5 -pady 1 \
1394 -name [lindex
$s 1] \
1395 -image [mapicon
$m $path]
1396 $w insert end
"[escape_path $path]\n"
1397 if {[catch
{set in_sel
$selected_paths($path)}]} {
1401 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1405 $ui_index conf
-state disabled
1406 $ui_other conf
-state disabled
1409 proc update_indexinfo
{msg pathList after
} {
1410 global update_index_cp ui_status_value
1412 if {![lock_index update
]} return
1414 set update_index_cp
0
1415 set pathList
[lsort
$pathList]
1416 set totalCnt
[llength
$pathList]
1417 set batch [expr {int
($totalCnt * .01) + 1}]
1418 if {$batch > 25} {set batch 25}
1420 set ui_status_value
[format \
1421 "$msg... %i/%i files (%.2f%%)" \
1425 set fd
[open
"| git update-index -z --index-info" w
]
1431 fileevent
$fd writable
[list \
1432 write_update_indexinfo \
1442 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1443 global update_index_cp ui_status_value
1444 global file_states current_diff
1446 if {$update_index_cp >= $totalCnt} {
1453 for {set i
$batch} \
1454 {$update_index_cp < $totalCnt && $i > 0} \
1456 set path
[lindex
$pathList $update_index_cp]
1457 incr update_index_cp
1459 set s
$file_states($path)
1460 switch
-glob -- [lindex
$s 0] {
1467 set info
[lindex
$s 2]
1468 if {$info eq
{}} continue
1470 puts
-nonewline $fd $info
1471 puts
-nonewline $fd "\t"
1472 puts
-nonewline $fd $path
1473 puts
-nonewline $fd "\0"
1474 display_file
$path $new
1477 set ui_status_value
[format \
1478 "$msg... %i/%i files (%.2f%%)" \
1481 [expr {100.0 * $update_index_cp / $totalCnt}]]
1484 proc update_index
{msg pathList after
} {
1485 global update_index_cp ui_status_value
1487 if {![lock_index update
]} return
1489 set update_index_cp
0
1490 set pathList
[lsort
$pathList]
1491 set totalCnt
[llength
$pathList]
1492 set batch [expr {int
($totalCnt * .01) + 1}]
1493 if {$batch > 25} {set batch 25}
1495 set ui_status_value
[format \
1496 "$msg... %i/%i files (%.2f%%)" \
1500 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1506 fileevent
$fd writable
[list \
1507 write_update_index \
1517 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1518 global update_index_cp ui_status_value
1519 global file_states current_diff
1521 if {$update_index_cp >= $totalCnt} {
1528 for {set i
$batch} \
1529 {$update_index_cp < $totalCnt && $i > 0} \
1531 set path
[lindex
$pathList $update_index_cp]
1532 incr update_index_cp
1534 switch
-glob -- [lindex
$file_states($path) 0] {
1553 puts
-nonewline $fd $path
1554 puts
-nonewline $fd "\0"
1555 display_file
$path $new
1558 set ui_status_value
[format \
1559 "$msg... %i/%i files (%.2f%%)" \
1562 [expr {100.0 * $update_index_cp / $totalCnt}]]
1565 proc checkout_index
{msg pathList after
} {
1566 global update_index_cp ui_status_value
1568 if {![lock_index update
]} return
1570 set update_index_cp
0
1571 set pathList
[lsort
$pathList]
1572 set totalCnt
[llength
$pathList]
1573 set batch [expr {int
($totalCnt * .01) + 1}]
1574 if {$batch > 25} {set batch 25}
1576 set ui_status_value
[format \
1577 "$msg... %i/%i files (%.2f%%)" \
1581 set cmd
[list git checkout-index
]
1587 set fd
[open
"| $cmd " w
]
1593 fileevent
$fd writable
[list \
1594 write_checkout_index \
1604 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1605 global update_index_cp ui_status_value
1606 global file_states current_diff
1608 if {$update_index_cp >= $totalCnt} {
1615 for {set i
$batch} \
1616 {$update_index_cp < $totalCnt && $i > 0} \
1618 set path
[lindex
$pathList $update_index_cp]
1619 incr update_index_cp
1621 switch
-glob -- [lindex
$file_states($path) 0] {
1631 puts
-nonewline $fd $path
1632 puts
-nonewline $fd "\0"
1633 display_file
$path $new
1636 set ui_status_value
[format \
1637 "$msg... %i/%i files (%.2f%%)" \
1640 [expr {100.0 * $update_index_cp / $totalCnt}]]
1643 ######################################################################
1645 ## branch management
1647 proc load_all_heads
{} {
1648 global all_heads tracking_branches
1650 set all_heads
[list
]
1651 set cmd
[list git for-each-ref
]
1652 lappend cmd
--format=%(refname
)
1653 lappend cmd refs
/heads
1654 set fd
[open
"| $cmd" r
]
1655 while {[gets
$fd line
] > 0} {
1656 if {![catch
{set info
$tracking_branches($line)}]} continue
1657 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1658 lappend all_heads
$name
1662 set all_heads
[lsort
$all_heads]
1665 proc populate_branch_menu
{m
} {
1666 global all_heads disable_on_lock
1669 foreach b
$all_heads {
1670 $m add radiobutton \
1672 -command [list switch_branch
$b] \
1673 -variable current_branch \
1676 lappend disable_on_lock \
1677 [list
$m entryconf
[$m index last
] -state]
1681 proc do_create_branch
{} {
1682 error
"NOT IMPLEMENTED"
1685 proc do_delete_branch
{} {
1686 error
"NOT IMPLEMENTED"
1689 proc switch_branch
{b
} {
1690 global HEAD commit_type file_states current_branch
1691 global selected_commit_type ui_comm
1693 if {![lock_index switch
]} return
1695 # -- Backup the selected branch (repository_state resets it)
1697 set new_branch
$current_branch
1699 # -- Our in memory state should match the repository.
1701 repository_state curType curHEAD curMERGE_HEAD
1702 if {[string match amend
* $commit_type]
1703 && $curType eq
{normal
}
1704 && $curHEAD eq
$HEAD} {
1705 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1706 info_popup
{Last scanned state does not match repository state.
1708 Another Git program has modified this repository
1709 since the last scan. A rescan must be performed
1710 before the current branch can be changed.
1712 The rescan will be automatically started now.
1715 rescan
{set ui_status_value
{Ready.
}}
1719 # -- Toss the message buffer if we are in amend mode.
1721 if {[string match amend
* $curType]} {
1722 $ui_comm delete
0.0 end
1724 $ui_comm edit modified false
1727 set selected_commit_type new
1728 set current_branch
$new_branch
1731 error
"NOT FINISHED"
1734 ######################################################################
1736 ## remote management
1738 proc load_all_remotes
{} {
1739 global gitdir repo_config
1740 global all_remotes tracking_branches
1742 set all_remotes
[list
]
1743 array
unset tracking_branches
1745 set rm_dir
[file join $gitdir remotes
]
1746 if {[file isdirectory
$rm_dir]} {
1747 set all_remotes
[glob \
1751 -directory $rm_dir *]
1753 foreach name
$all_remotes {
1755 set fd
[open
[file join $rm_dir $name] r
]
1756 while {[gets
$fd line
] >= 0} {
1757 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
1758 $line line src dst
]} continue
1759 if {![regexp ^refs
/ $dst]} {
1760 set dst
"refs/heads/$dst"
1762 set tracking_branches
($dst) [list
$name $src]
1769 foreach line
[array names repo_config remote.
*.url
] {
1770 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
1771 lappend all_remotes
$name
1773 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
1777 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
1778 if {![regexp ^refs
/ $dst]} {
1779 set dst
"refs/heads/$dst"
1781 set tracking_branches
($dst) [list
$name $src]
1785 set all_remotes
[lsort
-unique $all_remotes]
1788 proc populate_fetch_menu
{m
} {
1789 global gitdir all_remotes repo_config
1791 foreach r
$all_remotes {
1793 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1794 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1799 set fd
[open
[file join $gitdir remotes
$r] r
]
1800 while {[gets
$fd n
] >= 0} {
1801 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1812 -label "Fetch from $r..." \
1813 -command [list fetch_from
$r] \
1819 proc populate_push_menu
{m
} {
1820 global gitdir all_remotes repo_config
1822 foreach r
$all_remotes {
1824 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1825 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1830 set fd
[open
[file join $gitdir remotes
$r] r
]
1831 while {[gets
$fd n
] >= 0} {
1832 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1843 -label "Push to $r..." \
1844 -command [list push_to
$r] \
1850 proc populate_pull_menu
{m
} {
1851 global gitdir repo_config all_remotes disable_on_lock
1853 foreach remote
$all_remotes {
1855 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1856 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1857 foreach line
$repo_config(remote.
$remote.fetch
) {
1858 if {[regexp
{^
([^
:]+):} $line line rb
]} {
1865 set fd
[open
[file join $gitdir remotes
$remote] r
]
1866 while {[gets
$fd line
] >= 0} {
1867 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1875 foreach rb
$rb_list {
1876 regsub ^refs
/heads
/ $rb {} rb_short
1878 -label "Branch $rb_short from $remote..." \
1879 -command [list pull_remote
$remote $rb] \
1881 lappend disable_on_lock \
1882 [list
$m entryconf
[$m index last
] -state]
1887 ######################################################################
1892 #define mask_width 14
1893 #define mask_height 15
1894 static unsigned char mask_bits
[] = {
1895 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1896 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1897 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1900 image create bitmap file_plain
-background white
-foreground black
-data {
1901 #define plain_width 14
1902 #define plain_height 15
1903 static unsigned char plain_bits
[] = {
1904 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1905 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1906 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1907 } -maskdata $filemask
1909 image create bitmap file_mod
-background white
-foreground blue
-data {
1910 #define mod_width 14
1911 #define mod_height 15
1912 static unsigned char mod_bits
[] = {
1913 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1914 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1915 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1916 } -maskdata $filemask
1918 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1919 #define file_fulltick_width 14
1920 #define file_fulltick_height 15
1921 static unsigned char file_fulltick_bits
[] = {
1922 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1923 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1924 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1925 } -maskdata $filemask
1927 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1928 #define parttick_width 14
1929 #define parttick_height 15
1930 static unsigned char parttick_bits
[] = {
1931 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1932 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1933 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1934 } -maskdata $filemask
1936 image create bitmap file_question
-background white
-foreground black
-data {
1937 #define file_question_width 14
1938 #define file_question_height 15
1939 static unsigned char file_question_bits
[] = {
1940 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1941 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1942 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1943 } -maskdata $filemask
1945 image create bitmap file_removed
-background white
-foreground red
-data {
1946 #define file_removed_width 14
1947 #define file_removed_height 15
1948 static unsigned char file_removed_bits
[] = {
1949 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1950 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1951 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1952 } -maskdata $filemask
1954 image create bitmap file_merge
-background white
-foreground blue
-data {
1955 #define file_merge_width 14
1956 #define file_merge_height 15
1957 static unsigned char file_merge_bits
[] = {
1958 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1959 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1960 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1961 } -maskdata $filemask
1963 set ui_index .vpane.files.index.list
1964 set ui_other .vpane.files.other.list
1965 set max_status_desc
0
1967 {__ i plain
"Unmodified"}
1968 {_M i mod
"Modified"}
1969 {M_ i fulltick
"Added to commit"}
1970 {MM i parttick
"Partially included"}
1971 {MD i question
"Added (but gone)"}
1973 {_O o plain
"Untracked"}
1974 {A_ o fulltick
"Added by commit"}
1975 {AM o parttick
"Partially added"}
1976 {AD o question
"Added (but gone)"}
1978 {_D i question
"Missing"}
1979 {DD i removed
"Removed by commit"}
1980 {D_ i removed
"Removed by commit"}
1981 {DO i removed
"Removed (still exists)"}
1982 {DM i removed
"Removed (but modified)"}
1984 {UD i merge
"Merge conflicts"}
1985 {UM i merge
"Merge conflicts"}
1986 {U_ i merge
"Merge conflicts"}
1988 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1989 set max_status_desc
[string length
[lindex
$i 3]]
1991 if {[lindex
$i 1] eq
{i
}} {
1992 set all_cols
([lindex
$i 0]) $ui_index
1994 set all_cols
([lindex
$i 0]) $ui_other
1996 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1997 set all_descs
([lindex
$i 0]) [lindex
$i 3]
2001 ######################################################################
2006 global tcl_platform tk_library
2007 if {[tk windowingsystem
] eq
{aqua
}} {
2013 proc is_Windows
{} {
2015 if {$tcl_platform(platform
) eq
{windows
}} {
2021 proc bind_button3
{w cmd
} {
2022 bind $w <Any-Button-3
> $cmd
2024 bind $w <Control-Button-1
> $cmd
2028 proc incr_font_size
{font
{amt
1}} {
2029 set sz
[font configure
$font -size]
2031 font configure
$font -size $sz
2032 font configure
${font}bold
-size $sz
2035 proc hook_failed_popup
{hook msg
} {
2036 global gitdir appname
2042 label
$w.m.l1
-text "$hook hook failed:" \
2047 -background white
-borderwidth 1 \
2049 -width 80 -height 10 \
2051 -yscrollcommand [list
$w.m.sby
set]
2053 -text {You must correct the above errors before committing.
} \
2057 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2058 pack
$w.m.l1
-side top
-fill x
2059 pack
$w.m.l2
-side bottom
-fill x
2060 pack
$w.m.sby
-side right
-fill y
2061 pack
$w.m.t
-side left
-fill both
-expand 1
2062 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2064 $w.m.t insert
1.0 $msg
2065 $w.m.t conf
-state disabled
2067 button
$w.ok
-text OK \
2070 -command "destroy $w"
2071 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2073 bind $w <Visibility
> "grab $w; focus $w"
2074 bind $w <Key-Return
> "destroy $w"
2075 wm title
$w "$appname ([lindex [file split \
2076 [file normalize [file dirname $gitdir]]] \
2081 set next_console_id
0
2083 proc new_console
{short_title long_title
} {
2084 global next_console_id console_data
2085 set w .console
[incr next_console_id
]
2086 set console_data
($w) [list
$short_title $long_title]
2087 return [console_init
$w]
2090 proc console_init
{w
} {
2091 global console_cr console_data
2092 global gitdir appname M1B
2094 set console_cr
($w) 1.0
2097 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2102 -background white
-borderwidth 1 \
2104 -width 80 -height 10 \
2107 -yscrollcommand [list
$w.m.sby
set]
2108 label
$w.m.s
-text {Working... please
wait...
} \
2112 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2113 pack
$w.m.l1
-side top
-fill x
2114 pack
$w.m.s
-side bottom
-fill x
2115 pack
$w.m.sby
-side right
-fill y
2116 pack
$w.m.t
-side left
-fill both
-expand 1
2117 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2119 menu
$w.ctxm
-tearoff 0
2120 $w.ctxm add
command -label "Copy" \
2122 -command "tk_textCopy $w.m.t"
2123 $w.ctxm add
command -label "Select All" \
2125 -command "$w.m.t tag add sel 0.0 end"
2126 $w.ctxm add
command -label "Copy All" \
2129 $w.m.t tag add sel 0.0 end
2131 $w.m.t tag remove sel 0.0 end
2134 button
$w.ok
-text {Close
} \
2137 -command "destroy $w"
2138 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2140 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2141 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2142 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2143 bind $w <Visibility
> "focus $w"
2144 wm title
$w "$appname ([lindex [file split \
2145 [file normalize [file dirname $gitdir]]] \
2146 end]): [lindex $console_data($w) 0]"
2150 proc console_exec
{w cmd
{after
{}}} {
2151 # -- Windows tosses the enviroment when we exec our child.
2152 # But most users need that so we have to relogin. :-(
2155 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2158 # -- Tcl won't let us redirect both stdout and stderr to
2159 # the same pipe. So pass it through cat...
2161 set cmd
[concat |
$cmd |
& cat]
2163 set fd_f
[open
$cmd r
]
2164 fconfigure
$fd_f -blocking 0 -translation binary
2165 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2168 proc console_read
{w fd after
} {
2169 global console_cr console_data
2173 if {![winfo exists
$w]} {console_init
$w}
2174 $w.m.t conf
-state normal
2176 set n
[string length
$buf]
2178 set cr
[string first
"\r" $buf $c]
2179 set lf
[string first
"\n" $buf $c]
2180 if {$cr < 0} {set cr
[expr {$n + 1}]}
2181 if {$lf < 0} {set lf
[expr {$n + 1}]}
2184 $w.m.t insert end
[string range
$buf $c $lf]
2185 set console_cr
($w) [$w.m.t index
{end
-1c}]
2189 $w.m.t delete
$console_cr($w) end
2190 $w.m.t insert end
"\n"
2191 $w.m.t insert end
[string range
$buf $c $cr]
2196 $w.m.t conf
-state disabled
2200 fconfigure
$fd -blocking 1
2202 if {[catch
{close
$fd}]} {
2203 if {![winfo exists
$w]} {console_init
$w}
2204 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2205 $w.ok conf
-state normal
2207 } elseif
{[winfo exists
$w]} {
2208 $w.m.s conf
-background green
-text {Success
}
2209 $w.ok conf
-state normal
2212 array
unset console_cr
$w
2213 array
unset console_data
$w
2215 uplevel
#0 $after $ok
2219 fconfigure
$fd -blocking 0
2222 ######################################################################
2226 set starting_gitk_msg
{Please
wait... Starting gitk...
}
2228 proc do_gitk
{revs
} {
2229 global ui_status_value starting_gitk_msg
2237 set cmd
"sh -c \"exec $cmd\""
2241 if {[catch
{eval exec $cmd} err
]} {
2242 error_popup
"Failed to start gitk:\n\n$err"
2244 set ui_status_value
$starting_gitk_msg
2246 if {$ui_status_value eq
$starting_gitk_msg} {
2247 set ui_status_value
{Ready.
}
2254 set w
[new_console
{gc
} {Compressing the object database
}]
2255 console_exec
$w {git gc
}
2258 proc do_fsck_objects
{} {
2259 set w
[new_console
{fsck-objects
} \
2260 {Verifying the object database with fsck-objects
}]
2261 set cmd
[list git fsck-objects
]
2264 lappend cmd
--strict
2265 console_exec
$w $cmd
2271 global gitdir ui_comm is_quitting repo_config commit_type
2273 if {$is_quitting} return
2276 # -- Stash our current commit buffer.
2278 set save
[file join $gitdir GITGUI_MSG
]
2279 set msg
[string trim
[$ui_comm get
0.0 end
]]
2280 if {![string match amend
* $commit_type]
2281 && [$ui_comm edit modified
]
2284 set fd
[open
$save w
]
2285 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2289 catch
{file delete
$save}
2292 # -- Stash our current window geometry into this repository.
2294 set cfg_geometry
[list
]
2295 lappend cfg_geometry
[wm geometry .
]
2296 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
2297 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
2298 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2301 if {$cfg_geometry ne
$rc_geometry} {
2302 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2309 rescan
{set ui_status_value
{Ready.
}}
2312 proc remove_helper
{txt paths
} {
2313 global file_states current_diff
2315 if {![lock_index begin-update
]} return
2319 foreach path
$paths {
2320 switch
-glob -- [lindex
$file_states($path) 0] {
2324 lappend pathList
$path
2325 if {$path eq
$current_diff} {
2326 set after
{reshow_diff
;}
2331 if {$pathList eq
{}} {
2337 [concat
$after {set ui_status_value
{Ready.
}}]
2341 proc do_remove_selection
{} {
2342 global current_diff selected_paths
2344 if {[array size selected_paths
] > 0} {
2346 {Removing selected files from commit
} \
2347 [array names selected_paths
]
2348 } elseif
{$current_diff ne
{}} {
2350 "Removing [short_path $current_diff] from commit" \
2351 [list
$current_diff]
2355 proc include_helper
{txt paths
} {
2356 global file_states current_diff
2358 if {![lock_index begin-update
]} return
2362 foreach path
$paths {
2363 switch
-glob -- [lindex
$file_states($path) 0] {
2372 lappend pathList
$path
2373 if {$path eq
$current_diff} {
2374 set after
{reshow_diff
;}
2379 if {$pathList eq
{}} {
2385 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2389 proc do_include_selection
{} {
2390 global current_diff selected_paths
2392 if {[array size selected_paths
] > 0} {
2394 {Adding selected files
} \
2395 [array names selected_paths
]
2396 } elseif
{$current_diff ne
{}} {
2398 "Adding [short_path $current_diff]" \
2399 [list
$current_diff]
2403 proc do_include_all
{} {
2407 foreach path
[array names file_states
] {
2408 switch
-- [lindex
$file_states($path) 0] {
2414 _D
{lappend paths
$path}
2418 {Adding all modified files
} \
2422 proc revert_helper
{txt paths
} {
2423 global gitdir appname reponame
2424 global file_states current_diff
2426 if {![lock_index begin-update
]} return
2430 foreach path
$paths {
2431 switch
-glob -- [lindex
$file_states($path) 0] {
2438 lappend pathList
$path
2439 if {$path eq
$current_diff} {
2440 set after
{reshow_diff
;}
2446 set n
[llength
$pathList]
2450 } elseif
{$n == 1} {
2451 set s
"[short_path [lindex $pathList]]"
2453 set s
"these $n files"
2456 set reply
[tk_dialog \
2458 "$appname ($reponame)" \
2459 "Revert changes in $s?
2461 Any unadded changes will be permanently lost by the revert." \
2471 [concat
$after {set ui_status_value
{Ready.
}}]
2477 proc do_revert_selection
{} {
2478 global current_diff selected_paths
2480 if {[array size selected_paths
] > 0} {
2482 {Reverting selected files
} \
2483 [array names selected_paths
]
2484 } elseif
{$current_diff ne
{}} {
2486 "Reverting [short_path $current_diff]" \
2487 [list
$current_diff]
2491 proc do_signoff
{} {
2494 set me
[committer_ident
]
2495 if {$me eq
{}} return
2497 set sob
"Signed-off-by: $me"
2498 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2499 if {$last ne
$sob} {
2500 $ui_comm edit separator
2502 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2503 $ui_comm insert end
"\n"
2505 $ui_comm insert end
"\n$sob"
2506 $ui_comm edit separator
2511 proc do_select_commit_type
{} {
2512 global commit_type selected_commit_type
2514 if {$selected_commit_type eq
{new
}
2515 && [string match amend
* $commit_type]} {
2517 } elseif
{$selected_commit_type eq
{amend
}
2518 && ![string match amend
* $commit_type]} {
2521 # The amend request was rejected...
2523 if {![string match amend
* $commit_type]} {
2524 set selected_commit_type new
2534 global appname appvers copyright
2535 global tcl_patchLevel tk_patchLevel
2539 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2541 label
$w.header
-text "About $appname" \
2543 pack
$w.header
-side top
-fill x
2546 button
$w.buttons.close
-text {Close
} \
2548 -command [list destroy
$w]
2549 pack
$w.buttons.close
-side right
2550 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2553 -text "$appname - a commit creation tool for Git.
2561 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2564 append v
"$appname version $appvers\n"
2565 append v
"[exec git version]\n"
2567 if {$tcl_patchLevel eq
$tk_patchLevel} {
2568 append v
"Tcl/Tk version $tcl_patchLevel"
2570 append v
"Tcl version $tcl_patchLevel"
2571 append v
", Tk version $tk_patchLevel"
2582 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2584 menu
$w.ctxm
-tearoff 0
2585 $w.ctxm add
command \
2590 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2593 bind $w <Visibility
> "grab $w; focus $w"
2594 bind $w <Key-Escape
> "destroy $w"
2595 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2596 wm title
$w "About $appname"
2600 proc do_options
{} {
2601 global appname gitdir reponame font_descs
2602 global repo_config global_config
2603 global repo_config_new global_config_new
2605 array
unset repo_config_new
2606 array
unset global_config_new
2607 foreach name
[array names repo_config
] {
2608 set repo_config_new
($name) $repo_config($name)
2611 foreach name
[array names repo_config
] {
2613 gui.diffcontext
{continue}
2615 set repo_config_new
($name) $repo_config($name)
2617 foreach name
[array names global_config
] {
2618 set global_config_new
($name) $global_config($name)
2621 set w .options_editor
2623 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2625 label
$w.header
-text "$appname Options" \
2627 pack
$w.header
-side top
-fill x
2630 button
$w.buttons.restore
-text {Restore Defaults
} \
2632 -command do_restore_defaults
2633 pack
$w.buttons.restore
-side left
2634 button
$w.buttons.save
-text Save \
2636 -command [list do_save_config
$w]
2637 pack
$w.buttons.save
-side right
2638 button
$w.buttons.cancel
-text {Cancel
} \
2640 -command [list destroy
$w]
2641 pack
$w.buttons.cancel
-side right
2642 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2644 labelframe
$w.repo
-text "$reponame Repository" \
2646 -relief raised
-borderwidth 2
2647 labelframe
$w.global
-text {Global
(All Repositories
)} \
2649 -relief raised
-borderwidth 2
2650 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2651 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2654 {b partialinclude
{Allow Partially Added Files
}}
2655 {b pullsummary
{Show Pull Summary
}}
2656 {b trustmtime
{Trust File Modification Timestamps
}}
2657 {i diffcontext
{Number of Diff Context Lines
}}
2659 set type [lindex
$option 0]
2660 set name
[lindex
$option 1]
2661 set text
[lindex
$option 2]
2662 foreach f
{repo global
} {
2665 checkbutton
$w.
$f.
$name -text $text \
2666 -variable ${f}_config_new
(gui.
$name) \
2670 pack
$w.
$f.
$name -side top
-anchor w
2674 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2675 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2676 spinbox
$w.
$f.
$name.v \
2677 -textvariable ${f}_config_new
(gui.
$name) \
2678 -from 1 -to 99 -increment 1 \
2681 pack
$w.
$f.
$name.v
-side right
-anchor e
2682 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2688 set all_fonts
[lsort
[font families
]]
2689 foreach option
$font_descs {
2690 set name
[lindex
$option 0]
2691 set font
[lindex
$option 1]
2692 set text
[lindex
$option 2]
2694 set global_config_new
(gui.
$font^^family
) \
2695 [font configure
$font -family]
2696 set global_config_new
(gui.
$font^^size
) \
2697 [font configure
$font -size]
2699 frame
$w.global.
$name
2700 label
$w.global.
$name.l
-text "$text:" -font font_ui
2701 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2702 eval tk_optionMenu
$w.global.
$name.family \
2703 global_config_new
(gui.
$font^^family
) \
2705 spinbox
$w.global.
$name.size \
2706 -textvariable global_config_new
(gui.
$font^^size
) \
2707 -from 2 -to 80 -increment 1 \
2710 pack
$w.global.
$name.size
-side right
-anchor e
2711 pack
$w.global.
$name.family
-side right
-anchor e
2712 pack
$w.global.
$name -side top
-anchor w
-fill x
2715 bind $w <Visibility
> "grab $w; focus $w"
2716 bind $w <Key-Escape
> "destroy $w"
2717 wm title
$w "$appname ($reponame): Options"
2721 proc do_restore_defaults
{} {
2722 global font_descs default_config repo_config
2723 global repo_config_new global_config_new
2725 foreach name
[array names default_config
] {
2726 set repo_config_new
($name) $default_config($name)
2727 set global_config_new
($name) $default_config($name)
2730 foreach option
$font_descs {
2731 set name
[lindex
$option 0]
2732 set repo_config
(gui.
$name) $default_config(gui.
$name)
2736 foreach option
$font_descs {
2737 set name
[lindex
$option 0]
2738 set font
[lindex
$option 1]
2739 set global_config_new
(gui.
$font^^family
) \
2740 [font configure
$font -family]
2741 set global_config_new
(gui.
$font^^size
) \
2742 [font configure
$font -size]
2746 proc do_save_config
{w
} {
2747 if {[catch
{save_config
} err
]} {
2748 error_popup
"Failed to completely save options:\n\n$err"
2754 proc do_windows_shortcut
{} {
2755 global gitdir appname reponame argv0
2758 set desktop
[exec cygpath \
2766 set fn
[tk_getSaveFile \
2768 -title "$appname ($reponame): Create Desktop Icon" \
2769 -initialdir $desktop \
2770 -initialfile "Git $reponame.bat"]
2774 set sh
[exec cygpath \
2778 set me
[exec cygpath \
2782 set gd
[exec cygpath \
2786 regsub
-all ' $me "'\\''" me
2787 regsub -all ' $gd "'\\''" gd
2788 puts $fd "@ECHO Starting git-gui... Please wait..."
2789 puts -nonewline $fd "@\"$sh\" --login -c \""
2790 puts -nonewline $fd "GIT_DIR='$gd'"
2791 puts -nonewline $fd " '$me'"
2795 error_popup "Cannot write script:\n\n$err"
2800 proc do_macosx_app {} {
2801 global gitdir appname reponame argv0 env
2803 set fn [tk_getSaveFile \
2805 -title "$appname ($reponame): Create Desktop Icon" \
2806 -initialdir [file join $env(HOME) Desktop] \
2807 -initialfile "Git $reponame.app"]
2810 set Contents [file join $fn Contents]
2811 set MacOS [file join $Contents MacOS]
2812 set exe [file join $MacOS git-gui]
2816 set fd [open [file join $Contents Info.plist] w]
2817 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2818 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2819 <plist version="1.0">
2821 <key>CFBundleDevelopmentRegion</key>
2822 <string>English</string>
2823 <key>CFBundleExecutable</key>
2824 <string>git-gui</string>
2825 <key>CFBundleIdentifier</key>
2826 <string>org.spearce.git-gui</string>
2827 <key>CFBundleInfoDictionaryVersion</key>
2828 <string>6.0</string>
2829 <key>CFBundlePackageType</key>
2830 <string>APPL</string>
2831 <key>CFBundleSignature</key>
2832 <string>????</string>
2833 <key>CFBundleVersion</key>
2834 <string>1.0</string>
2835 <key>NSPrincipalClass</key>
2836 <string>NSApplication</string>
2841 set fd [open $exe w]
2842 set gd [file normalize $gitdir]
2843 set ep [file normalize [exec git --exec-path]]
2844 regsub -all ' $gd "'\\''" gd
2845 regsub
-all ' $ep "'\\''" ep
2846 puts $fd "#!/bin/sh"
2847 foreach name
[array names env
] {
2848 if {[string match GIT_
* $name]} {
2849 regsub
-all ' $env($name) "'\\''" v
2850 puts $fd "export $name='$v'"
2853 puts $fd "export PATH
='$ep':\
$PATH"
2854 puts $fd "export GIT_DIR
='$gd'"
2855 puts $fd "exec [file normalize
$argv0]"
2858 file attributes $exe -permissions u+x,g+x,o+x
2860 error_popup "Cannot
write icon
:\n\n$err"
2865 proc toggle_or_diff {w x y} {
2866 global file_states file_lists current_diff ui_index ui_other
2867 global last_clicked selected_paths
2869 set pos [split [$w index @$x,$y] .]
2870 set lno [lindex $pos 0]
2871 set col [lindex $pos 1]
2872 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2878 set last_clicked [list $w $lno]
2879 array unset selected_paths
2880 $ui_index tag remove in_sel 0.0 end
2881 $ui_other tag remove in_sel 0.0 end
2884 if {$current_diff eq $path} {
2885 set after {reshow_diff;}
2889 switch -glob -- [lindex $file_states($path) 0] {
2896 "Removing
[short_path
$path] from commit
" \
2898 [concat $after {set ui_status_value {Ready.}}]
2902 "Adding
[short_path
$path]" \
2904 [concat $after {set ui_status_value {Ready.}}]
2908 show_diff $path $w $lno
2912 proc add_one_to_selection {w x y} {
2914 global last_clicked selected_paths
2916 set pos [split [$w index @$x,$y] .]
2917 set lno [lindex $pos 0]
2918 set col [lindex $pos 1]
2919 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2925 set last_clicked [list $w $lno]
2926 if {[catch {set in_sel $selected_paths($path)}]} {
2930 unset selected_paths($path)
2931 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2933 set selected_paths($path) 1
2934 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2938 proc add_range_to_selection {w x y} {
2940 global last_clicked selected_paths
2942 if {[lindex $last_clicked 0] ne $w} {
2943 toggle_or_diff $w $x $y
2947 set pos [split [$w index @$x,$y] .]
2948 set lno [lindex $pos 0]
2949 set lc [lindex $last_clicked 1]
2958 foreach path [lrange $file_lists($w) \
2959 [expr {$begin - 1}] \
2960 [expr {$end - 1}]] {
2961 set selected_paths($path) 1
2963 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2966 ######################################################################
2970 set cursor_ptr arrow
2971 font create font_diff -family Courier -size 10
2975 eval font configure font_ui [font actual [.dummy cget -font]]
2979 font create font_uibold
2980 font create font_diffbold
2985 } elseif {[is_MacOSX]} {
2993 proc apply_config {} {
2994 global repo_config font_descs
2996 foreach option $font_descs {
2997 set name [lindex $option 0]
2998 set font [lindex $option 1]
3000 foreach {cn cv} $repo_config(gui.$name) {
3001 font configure $font $cn $cv
3004 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3006 foreach {cn cv} [font configure $font] {
3007 font configure ${font}bold $cn $cv
3009 font configure ${font}bold -weight bold
3013 set default_config(gui.trustmtime) false
3014 set default_config(gui.pullsummary) true
3015 set default_config(gui.partialinclude) false
3016 set default_config(gui.diffcontext) 5
3017 set default_config(gui.fontui) [font configure font_ui]
3018 set default_config(gui.fontdiff) [font configure font_diff]
3020 {fontui font_ui {Main Font}}
3021 {fontdiff font_diff {Diff/Console Font}}
3026 ######################################################################
3032 menu .mbar -tearoff 0
3033 .mbar add cascade -label Repository -menu .mbar.repository
3034 .mbar add cascade -label Edit -menu .mbar.edit
3035 if {!$single_commit} {
3036 .mbar add cascade -label Branch -menu .mbar.branch
3038 .mbar add cascade -label Commit -menu .mbar.commit
3039 if {!$single_commit} {
3040 .mbar add cascade -label Fetch -menu .mbar.fetch
3041 .mbar add cascade -label Pull -menu .mbar.pull
3042 .mbar add cascade -label Push -menu .mbar.push
3044 . configure -menu .mbar
3046 # -- Repository Menu
3048 menu .mbar.repository
3049 .mbar.repository add command \
3050 -label {Visualize Current Branch} \
3051 -command {do_gitk {}} \
3054 .mbar.repository add command \
3055 -label {Visualize All Branches} \
3056 -command {do_gitk {--all}} \
3059 .mbar.repository add separator
3061 if {!$single_commit} {
3062 .mbar.repository add command -label {Compress Database} \
3066 .mbar.repository add command -label {Verify Database} \
3067 -command do_fsck_objects \
3070 .mbar.repository add separator
3073 .mbar.repository add command \
3074 -label {Create Desktop Icon} \
3075 -command do_windows_shortcut \
3077 } elseif {[is_MacOSX]} {
3078 .mbar.repository add command \
3079 -label {Create Desktop Icon} \
3080 -command do_macosx_app \
3085 .mbar.repository add command -label Quit \
3087 -accelerator $M1T-Q \
3093 .mbar.edit add command -label Undo \
3094 -command {catch {[focus] edit undo}} \
3095 -accelerator $M1T-Z \
3097 .mbar.edit add command -label Redo \
3098 -command {catch {[focus] edit redo}} \
3099 -accelerator $M1T-Y \
3101 .mbar.edit add separator
3102 .mbar.edit add command -label Cut \
3103 -command {catch {tk_textCut [focus]}} \
3104 -accelerator $M1T-X \
3106 .mbar.edit add command -label Copy \
3107 -command {catch {tk_textCopy [focus]}} \
3108 -accelerator $M1T-C \
3110 .mbar.edit add command -label Paste \
3111 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3112 -accelerator $M1T-V \
3114 .mbar.edit add command -label Delete \
3115 -command {catch {[focus] delete sel.first sel.last}} \
3118 .mbar.edit add separator
3119 .mbar.edit add command -label {Select All} \
3120 -command {catch {[focus] tag add sel 0.0 end}} \
3121 -accelerator $M1T-A \
3126 if {!$single_commit} {
3129 .mbar.branch add command -label {Create...} \
3130 -command do_create_branch \
3132 lappend disable_on_lock [list .mbar.branch entryconf \
3133 [.mbar.branch index last] -state]
3135 .mbar.branch add command -label {Delete...} \
3136 -command do_delete_branch \
3138 lappend disable_on_lock [list .mbar.branch entryconf \
3139 [.mbar.branch index last] -state]
3146 .mbar.commit add radiobutton \
3147 -label {New Commit} \
3148 -command do_select_commit_type \
3149 -variable selected_commit_type \
3152 lappend disable_on_lock \
3153 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3155 .mbar.commit add radiobutton \
3156 -label {Amend Last Commit} \
3157 -command do_select_commit_type \
3158 -variable selected_commit_type \
3161 lappend disable_on_lock \
3162 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3164 .mbar.commit add separator
3166 .mbar.commit add command -label Rescan \
3167 -command do_rescan \
3170 lappend disable_on_lock \
3171 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173 .mbar.commit add command -label {Add To Commit} \
3174 -command do_include_selection \
3176 lappend disable_on_lock \
3177 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179 .mbar.commit add command -label {Add All To Commit} \
3180 -command do_include_all \
3181 -accelerator $M1T-I \
3183 lappend disable_on_lock \
3184 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3186 .mbar.commit add command -label {Remove From Commit} \
3187 -command do_remove_selection \
3189 lappend disable_on_lock \
3190 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3192 .mbar.commit add command -label {Revert Changes} \
3193 -command do_revert_selection \
3195 lappend disable_on_lock \
3196 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3198 .mbar.commit add separator
3200 .mbar.commit add command -label {Sign Off} \
3201 -command do_signoff \
3202 -accelerator $M1T-S \
3205 .mbar.commit add command -label Commit \
3206 -command do_commit \
3207 -accelerator $M1T-Return \
3209 lappend disable_on_lock \
3210 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3212 # -- Transport menus
3214 if {!$single_commit} {
3221 # -- Apple Menu (Mac OS X only)
3223 .mbar add cascade -label Apple -menu .mbar.apple
3226 .mbar.apple add command -label "About
$appname" \
3229 .mbar.apple add command -label "$appname Options...
" \
3230 -command do_options \
3235 .mbar.edit add separator
3236 .mbar.edit add command -label {Options...} \
3237 -command do_options \
3242 if {[file exists /usr/local/miga/lib/gui-miga]
3243 && [file exists .pvcsrc]} {
3245 global gitdir ui_status_value
3246 if {![lock_index update]} return
3247 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3248 set miga_fd [open "|
$cmd" r]
3249 fconfigure $miga_fd -blocking 0
3250 fileevent $miga_fd readable [list miga_done $miga_fd]
3251 set ui_status_value {Running miga...}
3253 proc miga_done {fd} {
3258 rescan [list set ui_status_value {Ready.}]
3261 .mbar add cascade -label Tools -menu .mbar.tools
3263 .mbar.tools add command -label "Migrate
" \
3266 lappend disable_on_lock \
3267 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3272 .mbar add cascade -label Help -menu .mbar.help
3275 .mbar.help add command -label "About
$appname" \
3287 -text {Current Branch:} \
3292 -textvariable current_branch \
3296 pack .branch.l1 -side left
3297 pack .branch.cb -side left -fill x
3298 pack .branch -side top -fill x
3300 # -- Main Window Layout
3302 panedwindow .vpane -orient vertical
3303 panedwindow .vpane.files -orient horizontal
3304 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3305 pack .vpane -anchor n -side top -fill both -expand 1
3307 # -- Index File List
3309 frame .vpane.files.index -height 100 -width 400
3310 label .vpane.files.index.title -text {Modified Files} \
3313 text $ui_index -background white -borderwidth 0 \
3314 -width 40 -height 10 \
3316 -cursor $cursor_ptr \
3317 -yscrollcommand {.vpane.files.index.sb set} \
3319 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3320 pack .vpane.files.index.title -side top -fill x
3321 pack .vpane.files.index.sb -side right -fill y
3322 pack $ui_index -side left -fill both -expand 1
3323 .vpane.files add .vpane.files.index -sticky nsew
3325 # -- Other (Add) File List
3327 frame .vpane.files.other -height 100 -width 100
3328 label .vpane.files.other.title -text {Untracked Files} \
3331 text $ui_other -background white -borderwidth 0 \
3332 -width 40 -height 10 \
3334 -cursor $cursor_ptr \
3335 -yscrollcommand {.vpane.files.other.sb set} \
3337 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3338 pack .vpane.files.other.title -side top -fill x
3339 pack .vpane.files.other.sb -side right -fill y
3340 pack $ui_other -side left -fill both -expand 1
3341 .vpane.files add .vpane.files.other -sticky nsew
3343 foreach i [list $ui_index $ui_other] {
3344 $i tag conf in_diff -font font_uibold
3345 $i tag conf in_sel \
3346 -background [$i cget -foreground] \
3347 -foreground [$i cget -background]
3351 # -- Diff and Commit Area
3353 frame .vpane.lower -height 300 -width 400
3354 frame .vpane.lower.commarea
3355 frame .vpane.lower.diff -relief sunken -borderwidth 1
3356 pack .vpane.lower.commarea -side top -fill x
3357 pack .vpane.lower.diff -side bottom -fill both -expand 1
3358 .vpane add .vpane.lower -stick nsew
3360 # -- Commit Area Buttons
3362 frame .vpane.lower.commarea.buttons
3363 label .vpane.lower.commarea.buttons.l -text {} \
3367 pack .vpane.lower.commarea.buttons.l -side top -fill x
3368 pack .vpane.lower.commarea.buttons -side left -fill y
3370 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3371 -command do_rescan \
3373 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3374 lappend disable_on_lock \
3375 {.vpane.lower.commarea.buttons.rescan conf -state}
3377 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3378 -command do_include_all \
3380 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3381 lappend disable_on_lock \
3382 {.vpane.lower.commarea.buttons.incall conf -state}
3384 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3385 -command do_signoff \
3387 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3389 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3390 -command do_commit \
3392 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3393 lappend disable_on_lock \
3394 {.vpane.lower.commarea.buttons.commit conf -state}
3396 # -- Commit Message Buffer
3398 frame .vpane.lower.commarea.buffer
3399 frame .vpane.lower.commarea.buffer.header
3400 set ui_comm .vpane.lower.commarea.buffer.t
3401 set ui_coml .vpane.lower.commarea.buffer.header.l
3402 radiobutton .vpane.lower.commarea.buffer.header.new \
3403 -text {New Commit} \
3404 -command do_select_commit_type \
3405 -variable selected_commit_type \
3408 lappend disable_on_lock \
3409 [list .vpane.lower.commarea.buffer.header.new conf -state]
3410 radiobutton .vpane.lower.commarea.buffer.header.amend \
3411 -text {Amend Last Commit} \
3412 -command do_select_commit_type \
3413 -variable selected_commit_type \
3416 lappend disable_on_lock \
3417 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3422 proc trace_commit_type {varname args} {
3423 global ui_coml commit_type
3424 switch -glob -- $commit_type {
3425 initial {set txt {Initial Commit Message:}}
3426 amend {set txt {Amended Commit Message:}}
3427 amend-initial {set txt {Amended Initial Commit Message:}}
3428 amend-merge {set txt {Amended Merge Commit Message:}}
3429 merge {set txt {Merge Commit Message:}}
3430 * {set txt {Commit Message:}}
3432 $ui_coml conf -text $txt
3434 trace add variable commit_type write trace_commit_type
3435 pack $ui_coml -side left -fill x
3436 pack .vpane.lower.commarea.buffer.header.amend -side right
3437 pack .vpane.lower.commarea.buffer.header.new -side right
3439 text $ui_comm -background white -borderwidth 1 \
3442 -autoseparators true \
3444 -width 75 -height 9 -wrap none \
3446 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3447 scrollbar .vpane.lower.commarea.buffer.sby \
3448 -command [list $ui_comm yview]
3449 pack .vpane.lower.commarea.buffer.header -side top -fill x
3450 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3451 pack $ui_comm -side left -fill y
3452 pack .vpane.lower.commarea.buffer -side left -fill y
3454 # -- Commit Message Buffer Context Menu
3456 set ctxm .vpane.lower.commarea.buffer.ctxm
3457 menu $ctxm -tearoff 0
3461 -command {tk_textCut $ui_comm}
3465 -command {tk_textCopy $ui_comm}
3469 -command {tk_textPaste $ui_comm}
3473 -command {$ui_comm delete sel.first sel.last}
3476 -label {Select All} \
3478 -command {$ui_comm tag add sel 0.0 end}
3483 $ui_comm tag add sel 0.0 end
3484 tk_textCopy $ui_comm
3485 $ui_comm tag remove sel 0.0 end
3492 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3497 set diff_actions [list]
3498 proc trace_current_diff {varname args} {
3499 global current_diff diff_actions file_states
3500 if {$current_diff eq {}} {
3507 set s [mapdesc [lindex $file_states($p) 0] $p]
3509 set p [escape_path $p]
3513 .vpane.lower.diff.header.status configure -text $s
3514 .vpane.lower.diff.header.file configure -text $f
3515 .vpane.lower.diff.header.path configure -text $p
3516 foreach w $diff_actions {
3520 trace add variable current_diff write trace_current_diff
3522 frame .vpane.lower.diff.header -background orange
3523 label .vpane.lower.diff.header.status \
3524 -background orange \
3525 -width $max_status_desc \
3529 label .vpane.lower.diff.header.file \
3530 -background orange \
3534 label .vpane.lower.diff.header.path \
3535 -background orange \
3539 pack .vpane.lower.diff.header.status -side left
3540 pack .vpane.lower.diff.header.file -side left
3541 pack .vpane.lower.diff.header.path -fill x
3542 set ctxm .vpane.lower.diff.header.ctxm
3543 menu $ctxm -tearoff 0
3554 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3555 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3559 frame .vpane.lower.diff.body
3560 set ui_diff .vpane.lower.diff.body.t
3561 text $ui_diff -background white -borderwidth 0 \
3562 -width 80 -height 15 -wrap none \
3564 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3565 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3567 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3568 -command [list $ui_diff xview]
3569 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3570 -command [list $ui_diff yview]
3571 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3572 pack .vpane.lower.diff.body.sby -side right -fill y
3573 pack $ui_diff -side left -fill both -expand 1
3574 pack .vpane.lower.diff.header -side top -fill x
3575 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3577 $ui_diff tag conf d_@ -font font_diffbold
3578 $ui_diff tag conf d_+ -foreground blue
3579 $ui_diff tag conf d_- -foreground red
3580 $ui_diff tag conf d_++ -foreground {#00a000}
3581 $ui_diff tag conf d_-- -foreground {#a000a0}
3582 $ui_diff tag conf d_+- \
3584 -background {light goldenrod yellow}
3585 $ui_diff tag conf d_-+ \
3589 # -- Diff Body Context Menu
3591 set ctxm .vpane.lower.diff.body.ctxm
3592 menu $ctxm -tearoff 0
3596 -command {tk_textCopy $ui_diff}
3597 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3599 -label {Select All} \
3601 -command {$ui_diff tag add sel 0.0 end}
3602 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3607 $ui_diff tag add sel 0.0 end
3608 tk_textCopy $ui_diff
3609 $ui_diff tag remove sel 0.0 end
3611 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3614 -label {Decrease Font Size} \
3616 -command {incr_font_size font_diff -1}
3617 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3619 -label {Increase Font Size} \
3621 -command {incr_font_size font_diff 1}
3622 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3625 -label {Show Less Context} \
3627 -command {if {$repo_config(gui.diffcontext) >= 2} {
3628 incr repo_config(gui.diffcontext) -1
3631 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3633 -label {Show More Context} \
3636 incr repo_config(gui.diffcontext)
3639 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3641 $ctxm add command -label {Options...} \
3644 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3648 set ui_status_value {Initializing...}
3649 label .status -textvariable ui_status_value \
3655 pack .status -anchor w -side bottom -fill x
3660 set gm $repo_config(gui.geometry)
3661 wm geometry . [lindex $gm 0]
3662 .vpane sash place 0 \
3663 [lindex [.vpane sash coord 0] 0] \
3665 .vpane.files sash place 0 \
3667 [lindex [.vpane.files sash coord 0] 1]
3673 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3674 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3675 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3676 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3677 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3678 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3679 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3680 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3681 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3682 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3683 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3685 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3686 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3687 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3688 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3689 bind $ui_diff <$M1B-Key-v> {break}
3690 bind $ui_diff <$M1B-Key-V> {break}
3691 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3692 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3693 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3694 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3695 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3696 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3698 bind . <Destroy> do_quit
3699 bind all <Key-F5> do_rescan
3700 bind all <$M1B-Key-r> do_rescan
3701 bind all <$M1B-Key-R> do_rescan
3702 bind . <$M1B-Key-s> do_signoff
3703 bind . <$M1B-Key-S> do_signoff
3704 bind . <$M1B-Key-i> do_include_all
3705 bind . <$M1B-Key-I> do_include_all
3706 bind . <$M1B-Key-Return> do_commit
3707 bind all <$M1B-Key-q> do_quit
3708 bind all <$M1B-Key-Q> do_quit
3709 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3710 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3711 foreach i [list $ui_index $ui_other] {
3712 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3713 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3714 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3718 set file_lists($ui_index) [list]
3719 set file_lists($ui_other) [list]
3723 set MERGE_HEAD [list]
3726 set current_branch {}
3728 set selected_commit_type new
3730 wm title . "$appname ([file normalize
[file dirname $gitdir]])"
3731 focus -force $ui_comm
3733 # -- Warn the user about environmental problems. Cygwin's Tcl
3734 # does *not* pass its env array onto any processes it spawns.
3735 # This means that git processes get none of our environment.
3740 set msg "Possible environment issues exist.
3742 The following environment variables are probably
3743 going to be ignored by any Git subprocess run
3747 foreach name [array names env] {
3748 switch -regexp -- $name {
3749 {^GIT_INDEX_FILE$} -
3750 {^GIT_OBJECT_DIRECTORY$} -
3751 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3753 {^GIT_EXTERNAL_DIFF$} -
3757 {^GIT_CONFIG_LOCAL$} -
3758 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3759 append msg " - $name\n"
3762 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3763 append msg " - $name\n"
3765 set suggest_user $name
3769 if {$ignored_env > 0} {
3771 This is due to a known issue with the
3772 Tcl binary distributed by Cygwin.
"
3774 if {$suggest_user ne {}} {
3777 A good replacement
for $suggest_user
3778 is placing values
for the user.name and
3779 user.email settings into your personal
3785 unset ignored_env msg suggest_user name
3788 # -- Only initialize complex UI if we are going to stay running.
3790 if {!$single_commit} {
3794 populate_branch_menu .mbar.branch
3795 populate_fetch_menu .mbar.fetch
3796 populate_pull_menu .mbar.pull
3797 populate_push_menu .mbar.push
3800 # -- Only suggest a gc run if we are going to stay running.
3802 if {!$single_commit} {
3803 set object_limit 2000
3804 if {[is_Windows]} {set object_limit 200}
3805 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3806 if {$objects_current >= $object_limit} {
3808 "This repository currently has
$objects_current loose objects.
3810 To maintain optimal performance it is strongly
3811 recommended that you
compress the database
3812 when
more than
$object_limit loose objects exist.
3814 Compress the database now?
"] eq yes} {
3818 unset object_limit _junk objects_current
3821 lock_index begin-read