2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc is_many_config
{name
} {
18 switch
-glob -- $name {
27 proc load_config
{include_global
} {
28 global repo_config global_config default_config
30 array
unset global_config
31 if {$include_global} {
33 set fd_rc
[open
"| git repo-config --global --list" r
]
34 while {[gets
$fd_rc line
] >= 0} {
35 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
36 if {[is_many_config
$name]} {
37 lappend global_config
($name) $value
39 set global_config
($name) $value
47 array
unset repo_config
49 set fd_rc
[open
"| git repo-config --list" r
]
50 while {[gets
$fd_rc line
] >= 0} {
51 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
52 if {[is_many_config
$name]} {
53 lappend repo_config
($name) $value
55 set repo_config
($name) $value
62 foreach name
[array names default_config
] {
63 if {[catch
{set v
$global_config($name)}]} {
64 set global_config
($name) $default_config($name)
66 if {[catch
{set v
$repo_config($name)}]} {
67 set repo_config
($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option
$font_descs {
78 set name
[lindex
$option 0]
79 set font
[lindex
$option 1]
80 font configure
$font \
81 -family $global_config_new(gui.
$font^^family
) \
82 -size $global_config_new(gui.
$font^^size
)
83 font configure
${font}bold \
84 -family $global_config_new(gui.
$font^^family
) \
85 -size $global_config_new(gui.
$font^^size
)
86 set global_config_new
(gui.
$name) [font configure
$font]
87 unset global_config_new
(gui.
$font^^family
)
88 unset global_config_new
(gui.
$font^^size
)
91 foreach name
[array names default_config
] {
92 set value
$global_config_new($name)
93 if {$value ne
$global_config($name)} {
94 if {$value eq
$default_config($name)} {
95 catch
{exec git repo-config
--global --unset $name}
97 regsub
-all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\
[{}\
]" $value {"} value
115 exec git repo-config
$name $value
117 set repo_config
($name) $value
122 proc error_popup
{msg
} {
123 global gitdir appname
128 append title
[lindex \
129 [file split [file normalize
[file dirname $gitdir]]] \
137 -title "$title: error" \
141 proc info_popup
{msg
} {
142 global gitdir appname
147 append title
[lindex \
148 [file split [file normalize
[file dirname $gitdir]]] \
160 ######################################################################
164 if { [catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]
165 ||
[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
166 catch
{wm withdraw .
}
167 error_popup
"Cannot find the git directory:\n\n$err"
176 if {$appname eq
{git-citool
}} {
180 ######################################################################
187 set disable_on_lock
[list
]
188 set index_lock_type none
194 proc lock_index
{type} {
195 global index_lock_type disable_on_lock
197 if {$index_lock_type eq
{none
}} {
198 set index_lock_type
$type
199 foreach w
$disable_on_lock {
200 uplevel
#0 $w disabled
203 } elseif
{$index_lock_type eq
{begin-update
} && $type eq
{update
}} {
204 set index_lock_type
$type
210 proc unlock_index
{} {
211 global index_lock_type disable_on_lock
213 set index_lock_type none
214 foreach w
$disable_on_lock {
219 ######################################################################
223 proc repository_state
{hdvar ctvar
} {
225 upvar
$hdvar hd
$ctvar ct
227 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
229 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
236 proc update_status
{{final Ready.
}} {
237 global HEAD PARENT commit_type
238 global ui_index ui_other ui_status_value ui_comm
239 global status_active file_states
242 if {$status_active ||
![lock_index
read]} return
244 repository_state new_HEAD new_type
245 if {$commit_type eq
{amend
}
246 && $new_type eq
{normal
}
247 && $new_HEAD eq
$HEAD} {
251 set commit_type
$new_type
254 array
unset file_states
256 if {![$ui_comm edit modified
]
257 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
258 if {[load_message GITGUI_MSG
]} {
259 } elseif
{[load_message MERGE_MSG
]} {
260 } elseif
{[load_message SQUASH_MSG
]} {
262 $ui_comm edit modified false
266 if {$repo_config(gui.trustmtime
) eq
{true
}} {
267 update_status_stage2
{} $final
270 set ui_status_value
{Refreshing
file status...
}
271 set cmd
[list git update-index
]
273 lappend cmd
--unmerged
274 lappend cmd
--ignore-missing
275 lappend cmd
--refresh
276 set fd_rf
[open
"| $cmd" r
]
277 fconfigure
$fd_rf -blocking 0 -translation binary
278 fileevent
$fd_rf readable \
279 [list update_status_stage2
$fd_rf $final]
283 proc update_status_stage2
{fd final
} {
284 global gitdir PARENT commit_type
285 global ui_index ui_other ui_status_value ui_comm
287 global buf_rdi buf_rdf buf_rlo
291 if {![eof
$fd]} return
295 set ls_others
[list | git ls-files
--others -z \
296 --exclude-per-directory=.gitignore
]
297 set info_exclude
[file join $gitdir info exclude
]
298 if {[file readable
$info_exclude]} {
299 lappend ls_others
"--exclude-from=$info_exclude"
307 set ui_status_value
{Scanning
for modified files ...
}
308 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
309 set fd_df
[open
"| git diff-files -z" r
]
310 set fd_lo
[open
$ls_others r
]
312 fconfigure
$fd_di -blocking 0 -translation binary
313 fconfigure
$fd_df -blocking 0 -translation binary
314 fconfigure
$fd_lo -blocking 0 -translation binary
315 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
316 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
317 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
320 proc load_message
{file} {
321 global gitdir ui_comm
323 set f
[file join $gitdir $file]
324 if {[file isfile
$f]} {
325 if {[catch
{set fd
[open
$f r
]}]} {
328 set content
[string trim
[read $fd]]
330 $ui_comm delete
0.0 end
331 $ui_comm insert end
$content
337 proc read_diff_index
{fd final
} {
340 append buf_rdi
[read $fd]
342 set n
[string length
$buf_rdi]
344 set z1
[string first
"\0" $buf_rdi $c]
347 set z2
[string first
"\0" $buf_rdi $z1]
353 [string range
$buf_rdi $z1 $z2] \
354 [string index
$buf_rdi [expr $z1 - 2]]_
358 set buf_rdi
[string range
$buf_rdi $c end
]
363 status_eof
$fd buf_rdi
$final
366 proc read_diff_files
{fd final
} {
369 append buf_rdf
[read $fd]
371 set n
[string length
$buf_rdf]
373 set z1
[string first
"\0" $buf_rdf $c]
376 set z2
[string first
"\0" $buf_rdf $z1]
382 [string range
$buf_rdf $z1 $z2] \
383 _
[string index
$buf_rdf [expr $z1 - 2]]
387 set buf_rdf
[string range
$buf_rdf $c end
]
392 status_eof
$fd buf_rdf
$final
395 proc read_ls_others
{fd final
} {
398 append buf_rlo
[read $fd]
399 set pck
[split $buf_rlo "\0"]
400 set buf_rlo
[lindex
$pck end
]
401 foreach p
[lrange
$pck 0 end-1
] {
404 status_eof
$fd buf_rlo
$final
407 proc status_eof
{fd buf final
} {
408 global status_active ui_status_value
409 global file_states repo_config
412 if {![eof
$fd]} return
415 if {[incr status_active
-1] > 0} return
420 if {$repo_config(gui.partialinclude
) ne
{true
}} {
422 foreach path
[array names file_states
] {
423 switch
-- [lindex
$file_states($path) 0] {
425 MM
{lappend pathList
$path}
428 if {$pathList ne
{}} {
429 update_index
$pathList
435 set ui_status_value
$final
438 ######################################################################
443 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
445 $ui_diff conf
-state normal
446 $ui_diff delete
0.0 end
447 $ui_diff conf
-state disabled
449 set ui_fname_value
{}
450 set ui_fstatus_value
{}
452 $ui_index tag remove in_diff
0.0 end
453 $ui_other tag remove in_diff
0.0 end
456 proc reshow_diff
{} {
457 global ui_fname_value ui_status_value file_states
459 if {$ui_fname_value eq
{}
460 ||
[catch
{set s
$file_states($ui_fname_value)}]} {
463 show_diff
$ui_fname_value
467 proc handle_empty_diff
{} {
468 global ui_fname_value file_states file_lists
470 set path
$ui_fname_value
471 set s
$file_states($path)
472 if {[lindex
$s 0] ne
{_M
}} return
474 info_popup
"No differences detected.
476 [short_path $path] has no changes.
478 The modification date of this file was updated
479 by another application and you currently have
480 the Trust File Modification Timestamps option
481 enabled, so Git did not automatically detect
482 that there are no content differences in this
485 This file will now be removed from the modified
486 files list, to prevent possible confusion.
488 if {[catch
{exec git update-index
-- $path} err
]} {
489 error_popup
"Failed to refresh index:\n\n$err"
493 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
494 set lno
[lsearch
-sorted $file_lists($old_w) $path]
496 set file_lists
($old_w) \
497 [lreplace
$file_lists($old_w) $lno $lno]
499 $old_w conf
-state normal
500 $old_w delete
$lno.0 [expr $lno + 1].0
501 $old_w conf
-state disabled
505 proc show_diff
{path
{w
{}} {lno
{}}} {
506 global file_states file_lists
507 global PARENT diff_3way diff_active repo_config
508 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
510 if {$diff_active ||
![lock_index
read]} return
513 if {$w eq
{} ||
$lno == {}} {
514 foreach w
[array names file_lists
] {
515 set lno
[lsearch
-sorted $file_lists($w) $path]
522 if {$w ne
{} && $lno >= 1} {
523 $w tag add in_diff
$lno.0 [expr $lno + 1].0
526 set s
$file_states($path)
530 set ui_fname_value
$path
531 set ui_fstatus_value
[mapdesc
$m $path]
532 set ui_status_value
"Loading diff of [escape_path $path]..."
534 set cmd
[list | git diff-index
]
535 lappend cmd
--no-color
536 if {$repo_config(gui.diffcontext
) > 0} {
537 lappend cmd
"-U$repo_config(gui.diffcontext)"
547 set fd
[open
$path r
]
548 set content
[read $fd]
553 set ui_status_value
"Unable to display [escape_path $path]"
554 error_popup
"Error loading file:\n\n$err"
557 $ui_diff conf
-state normal
558 $ui_diff insert end
$content
559 $ui_diff conf
-state disabled
562 set ui_status_value
{Ready.
}
571 if {[catch
{set fd
[open
$cmd r
]} err
]} {
574 set ui_status_value
"Unable to display [escape_path $path]"
575 error_popup
"Error loading diff:\n\n$err"
579 fconfigure
$fd -blocking 0 -translation auto
580 fileevent
$fd readable
[list read_diff
$fd]
583 proc read_diff
{fd
} {
584 global ui_diff ui_status_value diff_3way diff_active
587 while {[gets
$fd line
] >= 0} {
588 if {[string match
{diff --git *} $line]} continue
589 if {[string match
{diff --combined *} $line]} continue
590 if {[string match
{--- *} $line]} continue
591 if {[string match
{+++ *} $line]} continue
592 if {[string match index
* $line]} {
593 if {[string first
, $line] >= 0} {
598 $ui_diff conf
-state normal
600 set x
[string index
$line 0]
605 default
{set tags
{}}
608 set x
[string range
$line 0 1]
610 default
{set tags
{}}
612 "++" {set tags dp
; set x
" +"}
613 " +" {set tags
{di bold
}; set x
"++"}
614 "+ " {set tags dni
; set x
"-+"}
615 "--" {set tags dm
; set x
" -"}
616 " -" {set tags
{dm bold
}; set x
"--"}
617 "- " {set tags di
; set x
"+-"}
618 default
{set tags
{}}
620 set line
[string replace
$line 0 1 $x]
622 $ui_diff insert end
$line $tags
623 $ui_diff insert end
"\n"
624 $ui_diff conf
-state disabled
631 set ui_status_value
{Ready.
}
633 if {$repo_config(gui.trustmtime
) eq
{true
}
634 && [$ui_diff index end
] eq
{2.0}} {
640 ######################################################################
644 proc load_last_commit
{} {
645 global HEAD PARENT commit_type ui_comm
647 if {$commit_type eq
{amend
}} return
648 if {$commit_type ne
{normal
}} {
649 error_popup
"Can't amend a $commit_type commit."
657 set fd
[open
"| git cat-file commit $HEAD" r
]
658 while {[gets
$fd line
] > 0} {
659 if {[string match
{parent
*} $line]} {
660 set parent
[string range
$line 7 end
]
664 set msg
[string trim
[read $fd]]
667 error_popup
"Error loading commit data for amend:\n\n$err"
671 if {$parent_count == 0} {
672 set commit_type amend
676 } elseif
{$parent_count == 1} {
677 set commit_type amend
679 $ui_comm delete
0.0 end
680 $ui_comm insert end
$msg
681 $ui_comm edit modified false
685 error_popup
{You can
't amend a merge commit.}
690 proc commit_tree {} {
691 global tcl_platform HEAD gitdir commit_type file_states
693 global ui_status_value ui_comm
695 if {![lock_index update]} return
697 # -- Our in memory state should match the repository.
699 repository_state curHEAD cur_type
700 if {$commit_type eq {amend}
701 && $cur_type eq {normal}
702 && $curHEAD eq $HEAD} {
703 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
704 error_popup {Last scanned state does not match repository state.
706 Its highly likely that another Git program modified the
707 repository since our last scan. A rescan is required
715 # -- At least one file should differ in the index.
718 foreach path [array names file_states] {
719 set s $file_states($path)
720 switch -glob -- [lindex $s 0] {
724 M? {set files_ready 1; break}
726 error_popup "Unmerged files cannot be committed.
728 File [short_path $path] has merge conflicts.
729 You must resolve them and include the file before committing.
735 error_popup "Unknown file state [lindex $s 0] detected.
737 File [short_path $path] cannot be committed by this program.
743 error_popup {No included files to commit.
745 You must include at least 1 file before you can commit.
751 # -- A message is required.
753 set msg [string trim [$ui_comm get 1.0 end]]
755 error_popup {Please supply a commit message.
757 A good commit message has the following format:
759 - First line: Describe in one sentance what you did.
761 - Remaining lines: Describe why this change is good.
767 # -- Ask the pre-commit hook for the go-ahead.
769 set pchook [file join $gitdir hooks pre-commit]
770 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
771 set pchook [list sh -c [concat \
772 "if test -x \"$pchook\";" \
773 "then exec \"$pchook\" 2>&1;" \
775 } elseif {[file executable $pchook]} {
776 set pchook [list $pchook |& cat]
781 set ui_status_value {Calling pre-commit hook...}
783 set fd_ph [open "| $pchook" r]
784 fconfigure $fd_ph -blocking 0 -translation binary
785 fileevent $fd_ph readable \
786 [list commit_stage1 $fd_ph $curHEAD $msg]
788 commit_stage2 $curHEAD $msg
792 proc commit_stage1 {fd_ph curHEAD msg} {
793 global pch_error ui_status_value
795 append pch_error [read $fd_ph]
796 fconfigure $fd_ph -blocking 1
798 if {[catch {close $fd_ph}]} {
799 set ui_status_value {Commit declined by pre-commit hook.}
800 hook_failed_popup pre-commit $pch_error
803 commit_stage2 $curHEAD $msg
807 fconfigure $fd_ph -blocking 0
811 proc commit_stage2 {curHEAD msg} {
812 global ui_status_value
814 # -- Write the tree in the background.
816 set ui_status_value {Committing changes...}
817 set fd_wt [open "| git write-tree" r]
818 fileevent $fd_wt readable [list commit_stage3 $fd_wt $curHEAD $msg]
821 proc commit_stage3 {fd_wt curHEAD msg} {
822 global single_commit gitdir HEAD PARENT commit_type tcl_platform
823 global ui_status_value ui_comm
827 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
828 error_popup "write-tree failed:\n\n$err"
829 set ui_status_value {Commit failed.}
834 # -- Create the commit.
836 set cmd [list git commit-tree $tree_id]
838 lappend cmd -p $PARENT
840 if {$commit_type eq {merge}} {
842 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
843 while {[gets $fd_mh merge_head] >= 0} {
844 lappend cmd -p $merge_head
848 error_popup "Loading MERGE_HEAD failed:\n\n$err"
849 set ui_status_value {Commit failed.}
855 # git commit-tree writes to stderr during initial commit.
856 lappend cmd 2>/dev/null
859 if {[catch {set cmt_id [eval exec $cmd]} err]} {
860 error_popup "commit-tree failed:\n\n$err"
861 set ui_status_value {Commit failed.}
866 # -- Update the HEAD ref.
869 if {$commit_type ne {normal}} {
870 append reflogm " ($commit_type)"
872 set i [string first "\n" $msg]
874 append reflogm {: } [string range $msg 0 [expr $i - 1]]
876 append reflogm {: } $msg
878 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
879 if {[catch {eval exec $cmd} err]} {
880 error_popup "update-ref failed:\n\n$err"
881 set ui_status_value {Commit failed.}
886 # -- Cleanup after ourselves.
888 catch {file delete [file join $gitdir MERGE_HEAD]}
889 catch {file delete [file join $gitdir MERGE_MSG]}
890 catch {file delete [file join $gitdir SQUASH_MSG]}
891 catch {file delete [file join $gitdir GITGUI_MSG]}
893 # -- Let rerere do its thing.
895 if {[file isdirectory [file join $gitdir rr-cache]]} {
896 catch {exec git rerere}
899 # -- Run the post-commit hook.
901 set pchook [file join $gitdir hooks post-commit]
902 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
903 set pchook [list sh -c [concat \
904 "if test -x \"$pchook\";" \
905 "then exec \"$pchook\";" \
907 } elseif {![file executable $pchook]} {
911 catch {exec $pchook &}
914 $ui_comm delete 0.0 end
915 $ui_comm edit modified false
918 if {$single_commit} do_quit
920 # -- Update status without invoking any git commands.
922 set commit_type normal
926 foreach path [array names file_states] {
927 set s $file_states($path)
932 D? {set m _[string index $m 1]}
936 unset file_states($path)
938 lset file_states($path) 0 $m
945 set ui_status_value \
946 "Changes committed as [string range $cmt_id 0 7]."
949 ######################################################################
953 proc fetch_from {remote} {
954 set w [new_console "fetch $remote" \
955 "Fetching new changes from $remote"]
956 set cmd [list git fetch]
961 proc pull_remote {remote branch} {
962 global HEAD commit_type file_states repo_config
964 if {![lock_index update]} return
966 # -- Our in memory state should match the repository.
968 repository_state curHEAD cur_type
969 if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
970 error_popup {Last scanned state does not match repository state.
972 Its highly likely that another Git program modified the
973 repository since our last scan. A rescan is required
974 before a pull can be started.
981 # -- No differences should exist before a pull.
983 if {[array size file_states] != 0} {
984 error_popup {Uncommitted but modified files are present.
986 You should not perform a pull with unmodified files in your working
987 directory as Git would be unable to recover from an incorrect merge.
989 Commit or throw away all changes before starting a pull operation.
995 set w [new_console "pull $remote $branch" \
996 "Pulling new changes from branch $branch in $remote"]
997 set cmd [list git pull]
998 if {$repo_config(gui.pullsummary) eq {false}} {
999 lappend cmd --no-summary
1003 console_exec $w $cmd [list post_pull_remote $remote $branch]
1006 proc post_pull_remote {remote branch success} {
1007 global HEAD PARENT commit_type
1008 global ui_status_value
1012 repository_state HEAD commit_type
1014 set $ui_status_value {Ready.}
1017 "Conflicts detected while pulling $branch from $remote."
1021 proc push_to {remote} {
1022 set w [new_console "push $remote" \
1023 "Pushing changes to $remote"]
1024 set cmd [list git push]
1026 console_exec $w $cmd
1029 ######################################################################
1033 proc mapcol {state path} {
1034 global all_cols ui_other
1036 if {[catch {set r $all_cols($state)}]} {
1037 puts "error: no column for state={$state} $path"
1043 proc mapicon {state path} {
1046 if {[catch {set r $all_icons($state)}]} {
1047 puts "error: no icon for state={$state} $path"
1053 proc mapdesc {state path} {
1056 if {[catch {set r $all_descs($state)}]} {
1057 puts "error: no desc for state={$state} $path"
1063 proc escape_path {path} {
1064 regsub -all "\n" $path "\\n" path
1068 proc short_path {path} {
1069 return [escape_path [lindex [file split $path] end]]
1074 proc merge_state {path new_state} {
1075 global file_states next_icon_id
1077 set s0 [string index $new_state 0]
1078 set s1 [string index $new_state 1]
1080 if {[catch {set info $file_states($path)}]} {
1082 set icon n[incr next_icon_id]
1084 set state [lindex $info 0]
1085 set icon [lindex $info 1]
1089 set s0 [string index $state 0]
1090 } elseif {$s0 eq {*}} {
1095 set s1 [string index $state 1]
1096 } elseif {$s1 eq {*}} {
1100 set file_states($path) [list $s0$s1 $icon]
1104 proc display_file {path state} {
1105 global file_states file_lists status_active
1107 set old_m [merge_state $path $state]
1108 if {$status_active} return
1110 set s $file_states($path)
1111 set new_m [lindex $s 0]
1112 set new_w [mapcol $new_m $path]
1113 set old_w [mapcol $old_m $path]
1114 set new_icon [mapicon $new_m $path]
1116 if {$new_w ne $old_w} {
1117 set lno [lsearch -sorted $file_lists($old_w) $path]
1120 $old_w conf -state normal
1121 $old_w delete $lno.0 [expr $lno + 1].0
1122 $old_w conf -state disabled
1125 lappend file_lists($new_w) $path
1126 set file_lists($new_w) [lsort $file_lists($new_w)]
1127 set lno [lsearch -sorted $file_lists($new_w) $path]
1129 $new_w conf -state normal
1130 $new_w image create $lno.0 \
1131 -align center -padx 5 -pady 1 \
1132 -name [lindex $s 1] \
1134 $new_w insert $lno.1 "[escape_path $path]\n"
1135 $new_w conf -state disabled
1136 } elseif {$new_icon ne [mapicon $old_m $path]} {
1137 $new_w conf -state normal
1138 $new_w image conf [lindex $s 1] -image $new_icon
1139 $new_w conf -state disabled
1143 proc display_all_files {} {
1144 global ui_index ui_other file_states file_lists
1146 $ui_index conf -state normal
1147 $ui_other conf -state normal
1149 $ui_index delete 0.0 end
1150 $ui_other delete 0.0 end
1152 set file_lists($ui_index) [list]
1153 set file_lists($ui_other) [list]
1155 foreach path [lsort [array names file_states]] {
1156 set s $file_states($path)
1158 set w [mapcol $m $path]
1159 lappend file_lists($w) $path
1160 $w image create end \
1161 -align center -padx 5 -pady 1 \
1162 -name [lindex $s 1] \
1163 -image [mapicon $m $path]
1164 $w insert end "[escape_path $path]\n"
1167 $ui_index conf -state disabled
1168 $ui_other conf -state disabled
1171 proc update_index {pathList} {
1172 global update_index_cp update_index_rsd ui_status_value
1174 if {![lock_index update]} return
1176 set update_index_cp 0
1177 set update_index_rsd 0
1178 set pathList [lsort $pathList]
1179 set totalCnt [llength $pathList]
1180 set batch [expr {int($totalCnt * .01) + 1}]
1181 if {$batch > 25} {set batch 25}
1183 set ui_status_value [format \
1184 "Including files ... %i/%i files (%.2f%%)" \
1188 set fd [open "| git update-index --add --remove -z --stdin" w]
1194 fileevent $fd writable [list \
1195 write_update_index \
1203 proc write_update_index {fd pathList totalCnt batch} {
1204 global update_index_cp update_index_rsd ui_status_value
1205 global file_states ui_fname_value
1207 if {$update_index_cp >= $totalCnt} {
1210 set ui_status_value {Ready.}
1211 if {$update_index_rsd} {
1217 for {set i $batch} \
1218 {$update_index_cp < $totalCnt && $i > 0} \
1220 set path [lindex $pathList $update_index_cp]
1221 incr update_index_cp
1223 switch -- [lindex $file_states($path) 0] {
1233 puts -nonewline $fd $path
1234 puts -nonewline $fd "\0"
1235 display_file $path $new
1236 if {$ui_fname_value eq $path} {
1237 set update_index_rsd 1
1241 set ui_status_value [format \
1242 "Including files ... %i/%i files (%.2f%%)" \
1245 [expr {100.0 * $update_index_cp / $totalCnt}]]
1248 ######################################################################
1250 ## remote management
1252 proc load_all_remotes {} {
1253 global gitdir all_remotes repo_config
1255 set all_remotes [list]
1256 set rm_dir [file join $gitdir remotes]
1257 if {[file isdirectory $rm_dir]} {
1258 set all_remotes [concat $all_remotes [glob \
1262 -directory $rm_dir *]]
1265 foreach line [array names repo_config remote.*.url] {
1266 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1267 lappend all_remotes $name
1271 set all_remotes [lsort -unique $all_remotes]
1274 proc populate_remote_menu {m pfx op} {
1277 foreach remote $all_remotes {
1278 $m add command -label "$pfx $remote..." \
1279 -command [list $op $remote] \
1284 proc populate_pull_menu {m} {
1285 global gitdir repo_config all_remotes disable_on_lock
1287 foreach remote $all_remotes {
1289 if {[array get repo_config remote.$remote.url] ne {}} {
1290 if {[array get repo_config remote.$remote.fetch] ne {}} {
1291 regexp {^([^:]+):} \
1292 [lindex $repo_config(remote.$remote.fetch) 0] \
1297 set fd [open [file join $gitdir remotes $remote] r]
1298 while {[gets $fd line] >= 0} {
1299 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1308 regsub ^refs/heads/ $rb {} rb_short
1309 if {$rb_short ne {}} {
1311 -label "Branch $rb_short from $remote..." \
1312 -command [list pull_remote $remote $rb] \
1314 lappend disable_on_lock \
1315 [list $m entryconf [$m index last] -state]
1320 ######################################################################
1325 #define mask_width 14
1326 #define mask_height 15
1327 static unsigned char mask_bits[] = {
1328 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1329 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1330 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1333 image create bitmap file_plain -background white -foreground black -data {
1334 #define plain_width 14
1335 #define plain_height 15
1336 static unsigned char plain_bits[] = {
1337 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1338 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1339 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1340 } -maskdata $filemask
1342 image create bitmap file_mod -background white -foreground blue -data {
1343 #define mod_width 14
1344 #define mod_height 15
1345 static unsigned char mod_bits[] = {
1346 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1347 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1348 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1349 } -maskdata $filemask
1351 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1352 #define file_fulltick_width 14
1353 #define file_fulltick_height 15
1354 static unsigned char file_fulltick_bits[] = {
1355 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1356 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1357 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1358 } -maskdata $filemask
1360 image create bitmap file_parttick -background white -foreground "#005050" -data {
1361 #define parttick_width 14
1362 #define parttick_height 15
1363 static unsigned char parttick_bits[] = {
1364 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1365 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1366 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1367 } -maskdata $filemask
1369 image create bitmap file_question -background white -foreground black -data {
1370 #define file_question_width 14
1371 #define file_question_height 15
1372 static unsigned char file_question_bits[] = {
1373 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1374 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1375 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1376 } -maskdata $filemask
1378 image create bitmap file_removed -background white -foreground red -data {
1379 #define file_removed_width 14
1380 #define file_removed_height 15
1381 static unsigned char file_removed_bits[] = {
1382 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1383 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1384 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1385 } -maskdata $filemask
1387 image create bitmap file_merge -background white -foreground blue -data {
1388 #define file_merge_width 14
1389 #define file_merge_height 15
1390 static unsigned char file_merge_bits[] = {
1391 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1392 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1393 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1394 } -maskdata $filemask
1396 set ui_index .vpane.files.index.list
1397 set ui_other .vpane.files.other.list
1398 set max_status_desc 0
1400 {__ i plain "Unmodified"}
1401 {_M i mod "Modified"}
1402 {M_ i fulltick "Included in commit"}
1403 {MM i parttick "Partially included"}
1405 {_O o plain "Untracked"}
1406 {A_ o fulltick "Added by commit"}
1407 {AM o parttick "Partially added"}
1408 {AD o question "Added (but now gone)"}
1410 {_D i question "Missing"}
1411 {D_ i removed "Removed by commit"}
1412 {DD i removed "Removed by commit"}
1413 {DO i removed "Removed (still exists)"}
1415 {UM i merge "Merge conflicts"}
1416 {U_ i merge "Merge conflicts"}
1418 if {$max_status_desc < [string length [lindex $i 3]]} {
1419 set max_status_desc [string length [lindex $i 3]]
1421 if {[lindex $i 1] eq {i}} {
1422 set all_cols([lindex $i 0]) $ui_index
1424 set all_cols([lindex $i 0]) $ui_other
1426 set all_icons([lindex $i 0]) file_[lindex $i 2]
1427 set all_descs([lindex $i 0]) [lindex $i 3]
1431 ######################################################################
1436 global tcl_platform tk_library
1437 if {$tcl_platform(platform) eq {unix}
1438 && $tcl_platform(os) eq {Darwin}
1439 && [string match /Library/Frameworks/* $tk_library]} {
1445 proc bind_button3 {w cmd} {
1446 bind $w <Any-Button-3> $cmd
1448 bind $w <Control-Button-1> $cmd
1452 proc incr_font_size {font {amt 1}} {
1453 set sz [font configure $font -size]
1455 font configure $font -size $sz
1456 font configure ${font}bold -size $sz
1459 proc hook_failed_popup {hook msg} {
1460 global gitdir appname
1466 label $w.m.l1 -text "$hook hook failed:" \
1471 -background white -borderwidth 1 \
1473 -width 80 -height 10 \
1475 -yscrollcommand [list $w.m.sby set]
1477 -text {You must correct the above errors before committing.} \
1481 scrollbar $w.m.sby -command [list $w.m.t yview]
1482 pack $w.m.l1 -side top -fill x
1483 pack $w.m.l2 -side bottom -fill x
1484 pack $w.m.sby -side right -fill y
1485 pack $w.m.t -side left -fill both -expand 1
1486 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1488 $w.m.t insert 1.0 $msg
1489 $w.m.t conf -state disabled
1491 button $w.ok -text OK \
1494 -command "destroy $w"
1495 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1497 bind $w <Visibility> "grab $w; focus $w"
1498 bind $w <Key-Return> "destroy $w"
1499 wm title $w "$appname ([lindex [file split \
1500 [file normalize [file dirname $gitdir]]] \
1505 set next_console_id 0
1507 proc new_console {short_title long_title} {
1508 global next_console_id console_data
1509 set w .console[incr next_console_id]
1510 set console_data($w) [list $short_title $long_title]
1511 return [console_init $w]
1514 proc console_init {w} {
1515 global console_cr console_data
1516 global gitdir appname M1B
1518 set console_cr($w) 1.0
1521 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1526 -background white -borderwidth 1 \
1528 -width 80 -height 10 \
1531 -yscrollcommand [list $w.m.sby set]
1532 label $w.m.s -text {Working... please wait...} \
1536 scrollbar $w.m.sby -command [list $w.m.t yview]
1537 pack $w.m.l1 -side top -fill x
1538 pack $w.m.s -side bottom -fill x
1539 pack $w.m.sby -side right -fill y
1540 pack $w.m.t -side left -fill both -expand 1
1541 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1543 menu $w.ctxm -tearoff 0
1544 $w.ctxm add command -label "Copy" \
1546 -command "tk_textCopy $w.m.t"
1547 $w.ctxm add command -label "Select All" \
1549 -command "$w.m.t tag add sel 0.0 end"
1550 $w.ctxm add command -label "Copy All" \
1553 $w.m.t tag add sel 0.0 end
1555 $w.m.t tag remove sel 0.0 end
1558 button $w.ok -text {Close} \
1561 -command "destroy $w"
1562 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1564 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1565 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1566 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1567 bind $w <Visibility> "focus $w"
1568 wm title $w "$appname ([lindex [file split \
1569 [file normalize [file dirname $gitdir]]] \
1570 end]): [lindex $console_data($w) 0]"
1574 proc console_exec {w cmd {after {}}} {
1577 # -- Windows tosses the enviroment when we exec our child.
1578 # But most users need that so we have to relogin. :-(
1580 if {$tcl_platform(platform) eq {windows}} {
1581 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1584 # -- Tcl won't
let us redirect both stdout and stderr to
1585 # the same pipe. So pass it through cat...
1587 set cmd
[concat |
$cmd |
& cat]
1589 set fd_f
[open
$cmd r
]
1590 fconfigure
$fd_f -blocking 0 -translation binary
1591 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1594 proc console_read
{w fd after
} {
1595 global console_cr console_data
1599 if {![winfo exists
$w]} {console_init
$w}
1600 $w.m.t conf
-state normal
1602 set n
[string length
$buf]
1604 set cr
[string first
"\r" $buf $c]
1605 set lf
[string first
"\n" $buf $c]
1606 if {$cr < 0} {set cr
[expr $n + 1]}
1607 if {$lf < 0} {set lf
[expr $n + 1]}
1610 $w.m.t insert end
[string range
$buf $c $lf]
1611 set console_cr
($w) [$w.m.t index
{end
-1c}]
1615 $w.m.t delete
$console_cr($w) end
1616 $w.m.t insert end
"\n"
1617 $w.m.t insert end
[string range
$buf $c $cr]
1622 $w.m.t conf
-state disabled
1626 fconfigure
$fd -blocking 1
1628 if {[catch
{close
$fd}]} {
1629 if {![winfo exists
$w]} {console_init
$w}
1630 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1631 $w.ok conf
-state normal
1633 } elseif
{[winfo exists
$w]} {
1634 $w.m.s conf
-background green
-text {Success
}
1635 $w.ok conf
-state normal
1638 array
unset console_cr
$w
1639 array
unset console_data
$w
1641 uplevel
#0 $after $ok
1645 fconfigure
$fd -blocking 0
1648 ######################################################################
1652 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1655 global tcl_platform ui_status_value starting_gitk_msg
1657 set ui_status_value
$starting_gitk_msg
1659 if {$ui_status_value eq
$starting_gitk_msg} {
1660 set ui_status_value
{Ready.
}
1664 if {$tcl_platform(platform
) eq
{windows
}} {
1672 set w
[new_console
"repack" "Repacking the object database"]
1673 set cmd
[list git repack
]
1676 console_exec
$w $cmd
1682 global gitdir ui_comm is_quitting repo_config
1684 if {$is_quitting} return
1687 # -- Stash our current commit buffer.
1689 set save
[file join $gitdir GITGUI_MSG
]
1690 set msg
[string trim
[$ui_comm get
0.0 end
]]
1691 if {[$ui_comm edit modified
] && $msg ne
{}} {
1693 set fd
[open
$save w
]
1694 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1697 } elseif
{$msg eq
{} && [file exists
$save]} {
1701 # -- Stash our current window geometry into this repository.
1703 set cfg_geometry
[list
]
1704 lappend cfg_geometry
[wm geometry .
]
1705 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1706 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1707 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1710 if {$cfg_geometry ne
$rc_geometry} {
1711 catch
{exec git repo-config gui.geometry
$cfg_geometry}
1721 proc do_include_all
{} {
1724 if {![lock_index begin-update
]} return
1727 foreach path
[array names file_states
] {
1728 set s
$file_states($path)
1734 _D
{lappend pathList
$path}
1737 if {$pathList eq
{}} {
1740 update_index
$pathList
1744 set GIT_COMMITTER_IDENT
{}
1746 proc do_signoff
{} {
1747 global ui_comm GIT_COMMITTER_IDENT
1749 if {$GIT_COMMITTER_IDENT eq
{}} {
1750 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1751 error_popup
"Unable to obtain your identity:\n\n$err"
1754 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1755 $me me GIT_COMMITTER_IDENT
]} {
1756 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1761 set sob
"Signed-off-by: $GIT_COMMITTER_IDENT"
1762 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
1763 if {$last ne
$sob} {
1764 $ui_comm edit separator
1766 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
1767 $ui_comm insert end
"\n"
1769 $ui_comm insert end
"\n$sob"
1770 $ui_comm edit separator
1775 proc do_amend_last
{} {
1783 proc do_options
{} {
1784 global appname gitdir font_descs
1785 global repo_config global_config
1786 global repo_config_new global_config_new
1788 array
unset repo_config_new
1789 array
unset global_config_new
1790 foreach name
[array names repo_config
] {
1791 set repo_config_new
($name) $repo_config($name)
1794 foreach name
[array names repo_config
] {
1796 gui.diffcontext
{continue}
1798 set repo_config_new
($name) $repo_config($name)
1800 foreach name
[array names global_config
] {
1801 set global_config_new
($name) $global_config($name)
1803 set reponame
[lindex
[file split \
1804 [file normalize
[file dirname $gitdir]]] \
1807 set w .options_editor
1809 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1811 label
$w.header
-text "$appname Options" \
1813 pack
$w.header
-side top
-fill x
1816 button
$w.buttons.restore
-text {Restore Defaults
} \
1818 -command do_restore_defaults
1819 pack
$w.buttons.restore
-side left
1820 button
$w.buttons.save
-text Save \
1822 -command [list do_save_config
$w]
1823 pack
$w.buttons.save
-side right
1824 button
$w.buttons.cancel
-text {Cancel
} \
1826 -command [list destroy
$w]
1827 pack
$w.buttons.cancel
-side right
1828 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1830 labelframe
$w.repo
-text "$reponame Repository" \
1832 -relief raised
-borderwidth 2
1833 labelframe
$w.global
-text {Global
(All Repositories
)} \
1835 -relief raised
-borderwidth 2
1836 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
1837 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
1840 {b partialinclude
{Allow Partially Included Files
}}
1841 {b pullsummary
{Show Pull Summary
}}
1842 {b trustmtime
{Trust File Modification Timestamps
}}
1843 {i diffcontext
{Number of Diff Context Lines
}}
1845 set type [lindex
$option 0]
1846 set name
[lindex
$option 1]
1847 set text
[lindex
$option 2]
1848 foreach f
{repo global
} {
1851 checkbutton
$w.
$f.
$name -text $text \
1852 -variable ${f}_config_new
(gui.
$name) \
1856 pack
$w.
$f.
$name -side top
-anchor w
1860 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
1861 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
1862 spinbox
$w.
$f.
$name.v \
1863 -textvariable ${f}_config_new
(gui.
$name) \
1864 -from 1 -to 99 -increment 1 \
1867 pack
$w.
$f.
$name.v
-side right
-anchor e
1868 pack
$w.
$f.
$name -side top
-anchor w
-fill x
1874 set all_fonts
[lsort
[font families
]]
1875 foreach option
$font_descs {
1876 set name
[lindex
$option 0]
1877 set font
[lindex
$option 1]
1878 set text
[lindex
$option 2]
1880 set global_config_new
(gui.
$font^^family
) \
1881 [font configure
$font -family]
1882 set global_config_new
(gui.
$font^^size
) \
1883 [font configure
$font -size]
1885 frame
$w.global.
$name
1886 label
$w.global.
$name.l
-text "$text:" -font font_ui
1887 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
1888 eval tk_optionMenu
$w.global.
$name.family \
1889 global_config_new
(gui.
$font^^family
) \
1891 spinbox
$w.global.
$name.size \
1892 -textvariable global_config_new
(gui.
$font^^size
) \
1893 -from 2 -to 80 -increment 1 \
1896 pack
$w.global.
$name.size
-side right
-anchor e
1897 pack
$w.global.
$name.family
-side right
-anchor e
1898 pack
$w.global.
$name -side top
-anchor w
-fill x
1901 bind $w <Visibility
> "grab $w; focus $w"
1902 bind $w <Key-Escape
> "destroy $w"
1903 wm title
$w "$appname ($reponame): Options"
1907 proc do_restore_defaults
{} {
1908 global font_descs default_config repo_config
1909 global repo_config_new global_config_new
1911 foreach name
[array names default_config
] {
1912 set repo_config_new
($name) $default_config($name)
1913 set global_config_new
($name) $default_config($name)
1916 foreach option
$font_descs {
1917 set name
[lindex
$option 0]
1918 set repo_config
(gui.
$name) $default_config(gui.
$name)
1922 foreach option
$font_descs {
1923 set name
[lindex
$option 0]
1924 set font
[lindex
$option 1]
1925 set global_config_new
(gui.
$font^^family
) \
1926 [font configure
$font -family]
1927 set global_config_new
(gui.
$font^^size
) \
1928 [font configure
$font -size]
1932 proc do_save_config
{w
} {
1933 if {[catch
{save_config
} err
]} {
1934 error_popup
"Failed to completely save options:\n\n$err"
1940 proc file_left_click
{w x y
} {
1943 set pos
[split [$w index @
$x,$y] .
]
1944 set lno
[lindex
$pos 0]
1945 set col [lindex
$pos 1]
1946 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1947 if {$path eq
{}} return
1950 show_diff
$path $w $lno
1954 proc file_left_unclick
{w x y
} {
1957 set pos
[split [$w index @
$x,$y] .
]
1958 set lno
[lindex
$pos 0]
1959 set col [lindex
$pos 1]
1960 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1961 if {$path eq
{}} return
1964 update_index
[list
$path]
1968 ######################################################################
1972 set cursor_ptr arrow
1973 font create font_diff
-family Courier
-size 10
1977 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1981 font create font_uibold
1982 font create font_diffbold
1986 if {$tcl_platform(platform
) eq
{windows
}} {
1989 } elseif
{[is_MacOSX
]} {
1994 proc apply_config
{} {
1995 global repo_config font_descs
1997 foreach option
$font_descs {
1998 set name
[lindex
$option 0]
1999 set font
[lindex
$option 1]
2001 foreach
{cn cv
} $repo_config(gui.
$name) {
2002 font configure
$font $cn $cv
2005 error_popup
"Invalid font specified in gui.$name:\n\n$err"
2007 foreach
{cn cv
} [font configure
$font] {
2008 font configure
${font}bold
$cn $cv
2010 font configure
${font}bold
-weight bold
2014 set default_config
(gui.trustmtime
) false
2015 set default_config
(gui.pullsummary
) true
2016 set default_config
(gui.partialinclude
) false
2017 set default_config
(gui.diffcontext
) 5
2018 set default_config
(gui.fontui
) [font configure font_ui
]
2019 set default_config
(gui.fontdiff
) [font configure font_diff
]
2021 {fontui font_ui
{Main Font
}}
2022 {fontdiff font_diff
{Diff
/Console Font
}}
2027 ######################################################################
2032 menu .mbar
-tearoff 0
2033 .mbar add cascade
-label Project
-menu .mbar.project
2034 .mbar add cascade
-label Edit
-menu .mbar.edit
2035 .mbar add cascade
-label Commit
-menu .mbar.commit
2036 if {!$single_commit} {
2037 .mbar add cascade
-label Fetch
-menu .mbar.fetch
2038 .mbar add cascade
-label Pull
-menu .mbar.pull
2039 .mbar add cascade
-label Push
-menu .mbar.push
2041 . configure
-menu .mbar
2045 .mbar.project add
command -label Visualize \
2048 if {!$single_commit} {
2049 .mbar.project add
command -label {Repack Database
} \
2050 -command do_repack \
2053 .mbar.project add
command -label Quit \
2055 -accelerator $M1T-Q \
2061 .mbar.edit add
command -label Undo \
2062 -command {catch
{[focus
] edit undo
}} \
2063 -accelerator $M1T-Z \
2065 .mbar.edit add
command -label Redo \
2066 -command {catch
{[focus
] edit redo
}} \
2067 -accelerator $M1T-Y \
2069 .mbar.edit add separator
2070 .mbar.edit add
command -label Cut \
2071 -command {catch
{tk_textCut
[focus
]}} \
2072 -accelerator $M1T-X \
2074 .mbar.edit add
command -label Copy \
2075 -command {catch
{tk_textCopy
[focus
]}} \
2076 -accelerator $M1T-C \
2078 .mbar.edit add
command -label Paste \
2079 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2080 -accelerator $M1T-V \
2082 .mbar.edit add
command -label Delete \
2083 -command {catch
{[focus
] delete sel.first sel.last
}} \
2086 .mbar.edit add separator
2087 .mbar.edit add
command -label {Select All
} \
2088 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2089 -accelerator $M1T-A \
2091 .mbar.edit add separator
2092 .mbar.edit add
command -label {Options...
} \
2093 -command do_options \
2098 .mbar.commit add
command -label Rescan \
2099 -command do_rescan \
2102 lappend disable_on_lock \
2103 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2104 .mbar.commit add
command -label {Amend Last Commit
} \
2105 -command do_amend_last \
2107 lappend disable_on_lock \
2108 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2109 .mbar.commit add
command -label {Include All Files
} \
2110 -command do_include_all \
2111 -accelerator $M1T-I \
2113 lappend disable_on_lock \
2114 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2115 .mbar.commit add
command -label {Sign Off
} \
2116 -command do_signoff \
2117 -accelerator $M1T-S \
2119 .mbar.commit add
command -label Commit \
2120 -command do_commit \
2121 -accelerator $M1T-Return \
2123 lappend disable_on_lock \
2124 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2126 if {!$single_commit} {
2137 # -- Main Window Layout
2138 panedwindow .vpane
-orient vertical
2139 panedwindow .vpane.files
-orient horizontal
2140 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
2141 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2143 # -- Index File List
2144 frame .vpane.files.index
-height 100 -width 400
2145 label .vpane.files.index.title
-text {Modified Files
} \
2148 text
$ui_index -background white
-borderwidth 0 \
2149 -width 40 -height 10 \
2151 -cursor $cursor_ptr \
2152 -yscrollcommand {.vpane.files.index.sb
set} \
2154 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
2155 pack .vpane.files.index.title
-side top
-fill x
2156 pack .vpane.files.index.sb
-side right
-fill y
2157 pack
$ui_index -side left
-fill both
-expand 1
2158 .vpane.files add .vpane.files.index
-sticky nsew
2160 # -- Other (Add) File List
2161 frame .vpane.files.other
-height 100 -width 100
2162 label .vpane.files.other.title
-text {Untracked Files
} \
2165 text
$ui_other -background white
-borderwidth 0 \
2166 -width 40 -height 10 \
2168 -cursor $cursor_ptr \
2169 -yscrollcommand {.vpane.files.other.sb
set} \
2171 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
2172 pack .vpane.files.other.title
-side top
-fill x
2173 pack .vpane.files.other.sb
-side right
-fill y
2174 pack
$ui_other -side left
-fill both
-expand 1
2175 .vpane.files add .vpane.files.other
-sticky nsew
2177 $ui_index tag conf in_diff
-font font_uibold
2178 $ui_other tag conf in_diff
-font font_uibold
2180 # -- Diff and Commit Area
2181 frame .vpane.lower
-height 300 -width 400
2182 frame .vpane.lower.commarea
2183 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2184 pack .vpane.lower.commarea
-side top
-fill x
2185 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2186 .vpane add .vpane.lower
-stick nsew
2188 # -- Commit Area Buttons
2189 frame .vpane.lower.commarea.buttons
2190 label .vpane.lower.commarea.buttons.l
-text {} \
2194 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2195 pack .vpane.lower.commarea.buttons
-side left
-fill y
2197 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2198 -command do_rescan \
2200 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2201 lappend disable_on_lock \
2202 {.vpane.lower.commarea.buttons.rescan conf
-state}
2204 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
2205 -command do_amend_last \
2207 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
2208 lappend disable_on_lock \
2209 {.vpane.lower.commarea.buttons.amend conf
-state}
2211 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
2212 -command do_include_all \
2214 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2215 lappend disable_on_lock \
2216 {.vpane.lower.commarea.buttons.incall conf
-state}
2218 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2219 -command do_signoff \
2221 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2223 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2224 -command do_commit \
2226 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2227 lappend disable_on_lock \
2228 {.vpane.lower.commarea.buttons.commit conf
-state}
2230 # -- Commit Message Buffer
2231 frame .vpane.lower.commarea.buffer
2232 set ui_comm .vpane.lower.commarea.buffer.t
2233 set ui_coml .vpane.lower.commarea.buffer.l
2234 label
$ui_coml -text {Commit Message
:} \
2238 trace add variable commit_type
write {uplevel
#0 {
2239 switch
-glob $commit_type \
2240 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
2241 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
2242 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
2243 * {$ui_coml conf
-text {Commit Message
:}}
2245 text
$ui_comm -background white
-borderwidth 1 \
2248 -autoseparators true \
2250 -width 75 -height 9 -wrap none \
2252 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2253 scrollbar .vpane.lower.commarea.buffer.sby \
2254 -command [list
$ui_comm yview
]
2255 pack
$ui_coml -side top
-fill x
2256 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2257 pack
$ui_comm -side left
-fill y
2258 pack .vpane.lower.commarea.buffer
-side left
-fill y
2260 # -- Commit Message Buffer Context Menu
2262 menu
$ui_comm.ctxm
-tearoff 0
2263 $ui_comm.ctxm add
command -label "Cut" \
2265 -command "tk_textCut $ui_comm"
2266 $ui_comm.ctxm add
command -label "Copy" \
2268 -command "tk_textCopy $ui_comm"
2269 $ui_comm.ctxm add
command -label "Paste" \
2271 -command "tk_textPaste $ui_comm"
2272 $ui_comm.ctxm add
command -label "Delete" \
2274 -command "$ui_comm delete sel.first sel.last"
2275 $ui_comm.ctxm add separator
2276 $ui_comm.ctxm add
command -label "Select All" \
2278 -command "$ui_comm tag add sel 0.0 end"
2279 $ui_comm.ctxm add
command -label "Copy All" \
2282 $ui_comm tag add sel 0.0 end
2283 tk_textCopy $ui_comm
2284 $ui_comm tag remove sel 0.0 end
2286 $ui_comm.ctxm add separator
2287 $ui_comm.ctxm add
command -label "Sign Off" \
2290 bind_button3
$ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2293 set ui_fname_value
{}
2294 set ui_fstatus_value
{}
2295 frame .vpane.lower.
diff.header
-background orange
2296 label .vpane.lower.
diff.header.l4 \
2297 -textvariable ui_fstatus_value \
2298 -background orange \
2299 -width $max_status_desc \
2303 label .vpane.lower.
diff.header.l1
-text {File
:} \
2304 -background orange \
2306 set ui_fname .vpane.lower.
diff.header.l2
2308 -textvariable ui_fname_value \
2309 -background orange \
2313 menu
$ui_fname.ctxm
-tearoff 0
2314 $ui_fname.ctxm add
command -label "Copy" \
2323 bind_button3
$ui_fname "tk_popup $ui_fname.ctxm %X %Y"
2324 pack .vpane.lower.
diff.header.l4
-side left
2325 pack .vpane.lower.
diff.header.l1
-side left
2326 pack
$ui_fname -fill x
2329 frame .vpane.lower.
diff.body
2330 set ui_diff .vpane.lower.
diff.body.t
2331 text
$ui_diff -background white
-borderwidth 0 \
2332 -width 80 -height 15 -wrap none \
2334 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2335 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2337 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2338 -command [list
$ui_diff xview
]
2339 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2340 -command [list
$ui_diff yview
]
2341 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2342 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2343 pack
$ui_diff -side left
-fill both
-expand 1
2344 pack .vpane.lower.
diff.header
-side top
-fill x
2345 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2347 $ui_diff tag conf dm
-foreground red
2348 $ui_diff tag conf dp
-foreground blue
2349 $ui_diff tag conf di
-foreground {#00a000}
2350 $ui_diff tag conf dni
-foreground {#a000a0}
2351 $ui_diff tag conf da
-font font_diffbold
2352 $ui_diff tag conf bold
-font font_diffbold
2354 # -- Diff Body Context Menu
2356 menu
$ui_diff.ctxm
-tearoff 0
2357 $ui_diff.ctxm add
command -label "Copy" \
2359 -command "tk_textCopy $ui_diff"
2360 $ui_diff.ctxm add
command -label "Select All" \
2362 -command "$ui_diff tag add sel 0.0 end"
2363 $ui_diff.ctxm add
command -label "Copy All" \
2366 $ui_diff tag add sel 0.0 end
2367 tk_textCopy $ui_diff
2368 $ui_diff tag remove sel 0.0 end
2370 $ui_diff.ctxm add separator
2371 $ui_diff.ctxm add
command -label "Decrease Font Size" \
2373 -command {incr_font_size font_diff
-1}
2374 $ui_diff.ctxm add
command -label "Increase Font Size" \
2376 -command {incr_font_size font_diff
1}
2377 $ui_diff.ctxm add separator
2378 $ui_diff.ctxm add
command -label "Show Less Context" \
2380 -command {if {$ui_fname_value ne
{}
2381 && $repo_config(gui.diffcontext
) >= 2} {
2382 incr repo_config
(gui.diffcontext
) -1
2385 $ui_diff.ctxm add
command -label "Show More Context" \
2387 -command {if {$ui_fname_value ne
{}} {
2388 incr repo_config
(gui.diffcontext
)
2391 $ui_diff.ctxm add separator
2392 $ui_diff.ctxm add
command -label {Options...
} \
2395 bind_button3
$ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2398 set ui_status_value
{Initializing...
}
2399 label .status
-textvariable ui_status_value \
2405 pack .status
-anchor w
-side bottom
-fill x
2409 set gm
$repo_config(gui.geometry
)
2410 wm geometry .
[lindex
$gm 0]
2411 .vpane sash place
0 \
2412 [lindex
[.vpane sash coord
0] 0] \
2414 .vpane.files sash place
0 \
2416 [lindex
[.vpane.files sash coord
0] 1]
2421 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2422 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
2423 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
2424 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2425 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2426 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2427 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2428 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2429 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2430 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2431 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2433 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2434 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2435 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2436 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2437 bind $ui_diff <$M1B-Key-v> {break}
2438 bind $ui_diff <$M1B-Key-V> {break}
2439 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2440 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2441 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2442 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2443 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2444 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2446 bind .
<Destroy
> do_quit
2447 bind all
<Key-F5
> do_rescan
2448 bind all
<$M1B-Key-r> do_rescan
2449 bind all
<$M1B-Key-R> do_rescan
2450 bind .
<$M1B-Key-s> do_signoff
2451 bind .
<$M1B-Key-S> do_signoff
2452 bind .
<$M1B-Key-i> do_include_all
2453 bind .
<$M1B-Key-I> do_include_all
2454 bind .
<$M1B-Key-Return> do_commit
2455 bind all
<$M1B-Key-q> do_quit
2456 bind all
<$M1B-Key-Q> do_quit
2457 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2458 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2459 foreach i
[list
$ui_index $ui_other] {
2460 bind $i <Button-1
> {file_left_click
%W
%x
%y
; break}
2461 bind $i <ButtonRelease-1
> {file_left_unclick
%W
%x
%y
; break}
2465 set file_lists
($ui_index) [list
]
2466 set file_lists
($ui_other) [list
]
2468 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
2469 focus
-force $ui_comm
2470 if {!$single_commit} {
2472 populate_remote_menu .mbar.fetch From fetch_from
2473 populate_remote_menu .mbar.push To push_to
2474 populate_pull_menu .mbar.pull
2476 after
1 update_status