--- /dev/null
--- /dev/null
- show_diff $next_diff_p $next_diff_w $next_diff_i
++#!/bin/sh
++# Tcl ignores the next line -*- tcl -*- \
++ if test "z$*" = zversion \
++ || test "z$*" = z--version; \
++ then \
++ echo 'git-gui version @@GITGUI_VERSION@@'; \
++ exit; \
++ fi; \
++ argv0=$0; \
++ exec wish "$argv0" -- "$@"
++
++set appvers {@@GITGUI_VERSION@@}
++set copyright [encoding convertfrom utf-8 {
++Copyright © 2006, 2007 Shawn Pearce, et. al.
++
++This program is free software; you can redistribute it and/or modify
++it under the terms of the GNU General Public License as published by
++the Free Software Foundation; either version 2 of the License, or
++(at your option) any later version.
++
++This program is distributed in the hope that it will be useful,
++but WITHOUT ANY WARRANTY; without even the implied warranty of
++MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++GNU General Public License for more details.
++
++You should have received a copy of the GNU General Public License
++along with this program; if not, write to the Free Software
++Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
++
++######################################################################
++##
++## Tcl/Tk sanity check
++
++if {[catch {package require Tcl 8.4} err]
++ || [catch {package require Tk 8.4} err]
++} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message $err
++ exit 1
++}
++
++catch {rename send {}} ; # What an evil concept...
++
++######################################################################
++##
++## locate our library
++
++set oguilib {@@GITGUI_LIBDIR@@}
++set oguirel {@@GITGUI_RELATIVE@@}
++if {$oguirel eq {1}} {
++ set oguilib [file dirname [file normalize $argv0]]
++ if {[file tail $oguilib] eq {git-core}} {
++ set oguilib [file dirname $oguilib]
++ }
++ set oguilib [file dirname $oguilib]
++ set oguilib [file join $oguilib share git-gui lib]
++ set oguimsg [file join $oguilib msgs]
++} elseif {[string match @@* $oguirel]} {
++ set oguilib [file join [file dirname [file normalize $argv0]] lib]
++ set oguimsg [file join [file dirname [file normalize $argv0]] po]
++} else {
++ set oguimsg [file join $oguilib msgs]
++}
++unset oguirel
++
++######################################################################
++##
++## enable verbose loading?
++
++if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
++ unset _verbose
++ rename auto_load real__auto_load
++ proc auto_load {name args} {
++ puts stderr "auto_load $name"
++ return [uplevel 1 real__auto_load $name $args]
++ }
++ rename source real__source
++ proc source {name} {
++ puts stderr "source $name"
++ uplevel 1 real__source $name
++ }
++}
++
++######################################################################
++##
++## Internationalization (i18n) through msgcat and gettext. See
++## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
++
++package require msgcat
++
++proc _mc_trim {fmt} {
++ set cmk [string first @@ $fmt]
++ if {$cmk > 0} {
++ return [string range $fmt 0 [expr {$cmk - 1}]]
++ }
++ return $fmt
++}
++
++proc mc {en_fmt args} {
++ set fmt [_mc_trim [::msgcat::mc $en_fmt]]
++ if {[catch {set msg [eval [list format $fmt] $args]} err]} {
++ set msg [eval [list format [_mc_trim $en_fmt]] $args]
++ }
++ return $msg
++}
++
++proc strcat {args} {
++ return [join $args {}]
++}
++
++::msgcat::mcload $oguimsg
++unset oguimsg
++
++######################################################################
++##
++## read only globals
++
++set _appname {Git Gui}
++set _gitdir {}
++set _gitexec {}
++set _reponame {}
++set _iscygwin {}
++set _search_path {}
++
++set _trace [lsearch -exact $argv --trace]
++if {$_trace >= 0} {
++ set argv [lreplace $argv $_trace $_trace]
++ set _trace 1
++} else {
++ set _trace 0
++}
++
++proc appname {} {
++ global _appname
++ return $_appname
++}
++
++proc gitdir {args} {
++ global _gitdir
++ if {$args eq {}} {
++ return $_gitdir
++ }
++ return [eval [list file join $_gitdir] $args]
++}
++
++proc gitexec {args} {
++ global _gitexec
++ if {$_gitexec eq {}} {
++ if {[catch {set _gitexec [git --exec-path]} err]} {
++ error "Git not installed?\n\n$err"
++ }
++ if {[is_Cygwin]} {
++ set _gitexec [exec cygpath \
++ --windows \
++ --absolute \
++ $_gitexec]
++ } else {
++ set _gitexec [file normalize $_gitexec]
++ }
++ }
++ if {$args eq {}} {
++ return $_gitexec
++ }
++ return [eval [list file join $_gitexec] $args]
++}
++
++proc reponame {} {
++ return $::_reponame
++}
++
++proc is_MacOSX {} {
++ if {[tk windowingsystem] eq {aqua}} {
++ return 1
++ }
++ return 0
++}
++
++proc is_Windows {} {
++ if {$::tcl_platform(platform) eq {windows}} {
++ return 1
++ }
++ return 0
++}
++
++proc is_Cygwin {} {
++ global _iscygwin
++ if {$_iscygwin eq {}} {
++ if {$::tcl_platform(platform) eq {windows}} {
++ if {[catch {set p [exec cygpath --windir]} err]} {
++ set _iscygwin 0
++ } else {
++ set _iscygwin 1
++ }
++ } else {
++ set _iscygwin 0
++ }
++ }
++ return $_iscygwin
++}
++
++proc is_enabled {option} {
++ global enabled_options
++ if {[catch {set on $enabled_options($option)}]} {return 0}
++ return $on
++}
++
++proc enable_option {option} {
++ global enabled_options
++ set enabled_options($option) 1
++}
++
++proc disable_option {option} {
++ global enabled_options
++ set enabled_options($option) 0
++}
++
++######################################################################
++##
++## config
++
++proc is_many_config {name} {
++ switch -glob -- $name {
++ gui.recentrepo -
++ remote.*.fetch -
++ remote.*.push
++ {return 1}
++ *
++ {return 0}
++ }
++}
++
++proc is_config_true {name} {
++ global repo_config
++ if {[catch {set v $repo_config($name)}]} {
++ return 0
++ } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
++ return 1
++ } else {
++ return 0
++ }
++}
++
++proc get_config {name} {
++ global repo_config
++ if {[catch {set v $repo_config($name)}]} {
++ return {}
++ } else {
++ return $v
++ }
++}
++
++######################################################################
++##
++## handy utils
++
++proc _trace_exec {cmd} {
++ if {!$::_trace} return
++ set d {}
++ foreach v $cmd {
++ if {$d ne {}} {
++ append d { }
++ }
++ if {[regexp {[ \t\r\n'"$?*]} $v]} {
++ set v [sq $v]
++ }
++ append d $v
++ }
++ puts stderr $d
++}
++
++proc _git_cmd {name} {
++ global _git_cmd_path
++
++ if {[catch {set v $_git_cmd_path($name)}]} {
++ switch -- $name {
++ version -
++ --version -
++ --exec-path { return [list $::_git $name] }
++ }
++
++ set p [gitexec git-$name$::_search_exe]
++ if {[file exists $p]} {
++ set v [list $p]
++ } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
++ # Try to determine what sort of magic will make
++ # git-$name go and do its thing, because native
++ # Tcl on Windows doesn't know it.
++ #
++ set p [gitexec git-$name]
++ set f [open $p r]
++ set s [gets $f]
++ close $f
++
++ switch -glob -- [lindex $s 0] {
++ #!*sh { set i sh }
++ #!*perl { set i perl }
++ #!*python { set i python }
++ default { error "git-$name is not supported: $s" }
++ }
++
++ upvar #0 _$i interp
++ if {![info exists interp]} {
++ set interp [_which $i]
++ }
++ if {$interp eq {}} {
++ error "git-$name requires $i (not in PATH)"
++ }
++ set v [concat [list $interp] [lrange $s 1 end] [list $p]]
++ } else {
++ # Assume it is builtin to git somehow and we
++ # aren't actually able to see a file for it.
++ #
++ set v [list $::_git $name]
++ }
++ set _git_cmd_path($name) $v
++ }
++ return $v
++}
++
++proc _which {what args} {
++ global env _search_exe _search_path
++
++ if {$_search_path eq {}} {
++ if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
++ set _search_path [split [exec cygpath \
++ --windows \
++ --path \
++ --absolute \
++ $env(PATH)] {;}]
++ set _search_exe .exe
++ } elseif {[is_Windows]} {
++ set gitguidir [file dirname [info script]]
++ regsub -all ";" $gitguidir "\\;" gitguidir
++ set env(PATH) "$gitguidir;$env(PATH)"
++ set _search_path [split $env(PATH) {;}]
++ set _search_exe .exe
++ } else {
++ set _search_path [split $env(PATH) :]
++ set _search_exe {}
++ }
++ }
++
++ if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
++ set suffix {}
++ } else {
++ set suffix $_search_exe
++ }
++
++ foreach p $_search_path {
++ set p [file join $p $what$suffix]
++ if {[file exists $p]} {
++ return [file normalize $p]
++ }
++ }
++ return {}
++}
++
++proc _lappend_nice {cmd_var} {
++ global _nice
++ upvar $cmd_var cmd
++
++ if {![info exists _nice]} {
++ set _nice [_which nice]
++ }
++ if {$_nice ne {}} {
++ lappend cmd $_nice
++ }
++}
++
++proc git {args} {
++ set opt [list]
++
++ while {1} {
++ switch -- [lindex $args 0] {
++ --nice {
++ _lappend_nice opt
++ }
++
++ default {
++ break
++ }
++
++ }
++
++ set args [lrange $args 1 end]
++ }
++
++ set cmdp [_git_cmd [lindex $args 0]]
++ set args [lrange $args 1 end]
++
++ _trace_exec [concat $opt $cmdp $args]
++ set result [eval exec $opt $cmdp $args]
++ if {$::_trace} {
++ puts stderr "< $result"
++ }
++ return $result
++}
++
++proc _open_stdout_stderr {cmd} {
++ _trace_exec $cmd
++ if {[catch {
++ set fd [open [concat [list | ] $cmd] r]
++ } err]} {
++ if { [lindex $cmd end] eq {2>@1}
++ && $err eq {can not find channel named "1"}
++ } {
++ # Older versions of Tcl 8.4 don't have this 2>@1 IO
++ # redirect operator. Fallback to |& cat for those.
++ # The command was not actually started, so its safe
++ # to try to start it a second time.
++ #
++ set fd [open [concat \
++ [list | ] \
++ [lrange $cmd 0 end-1] \
++ [list |& cat] \
++ ] r]
++ } else {
++ error $err
++ }
++ }
++ fconfigure $fd -eofchar {}
++ return $fd
++}
++
++proc git_read {args} {
++ set opt [list]
++
++ while {1} {
++ switch -- [lindex $args 0] {
++ --nice {
++ _lappend_nice opt
++ }
++
++ --stderr {
++ lappend args 2>@1
++ }
++
++ default {
++ break
++ }
++
++ }
++
++ set args [lrange $args 1 end]
++ }
++
++ set cmdp [_git_cmd [lindex $args 0]]
++ set args [lrange $args 1 end]
++
++ return [_open_stdout_stderr [concat $opt $cmdp $args]]
++}
++
++proc git_write {args} {
++ set opt [list]
++
++ while {1} {
++ switch -- [lindex $args 0] {
++ --nice {
++ _lappend_nice opt
++ }
++
++ default {
++ break
++ }
++
++ }
++
++ set args [lrange $args 1 end]
++ }
++
++ set cmdp [_git_cmd [lindex $args 0]]
++ set args [lrange $args 1 end]
++
++ _trace_exec [concat $opt $cmdp $args]
++ return [open [concat [list | ] $opt $cmdp $args] w]
++}
++
++proc githook_read {hook_name args} {
++ set pchook [gitdir hooks $hook_name]
++ lappend args 2>@1
++
++ # On Windows [file executable] might lie so we need to ask
++ # the shell if the hook is executable. Yes that's annoying.
++ #
++ if {[is_Windows]} {
++ upvar #0 _sh interp
++ if {![info exists interp]} {
++ set interp [_which sh]
++ }
++ if {$interp eq {}} {
++ error "hook execution requires sh (not in PATH)"
++ }
++
++ set scr {if test -x "$1";then exec "$@";fi}
++ set sh_c [list $interp -c $scr $interp $pchook]
++ return [_open_stdout_stderr [concat $sh_c $args]]
++ }
++
++ if {[file executable $pchook]} {
++ return [_open_stdout_stderr [concat [list $pchook] $args]]
++ }
++
++ return {}
++}
++
++proc kill_file_process {fd} {
++ set process [pid $fd]
++
++ catch {
++ if {[is_Windows]} {
++ # Use a Cygwin-specific flag to allow killing
++ # native Windows processes
++ exec kill -f $process
++ } else {
++ exec kill $process
++ }
++ }
++}
++
++proc sq {value} {
++ regsub -all ' $value "'\\''" value
++ return "'$value'"
++}
++
++proc load_current_branch {} {
++ global current_branch is_detached
++
++ set fd [open [gitdir HEAD] r]
++ if {[gets $fd ref] < 1} {
++ set ref {}
++ }
++ close $fd
++
++ set pfx {ref: refs/heads/}
++ set len [string length $pfx]
++ if {[string equal -length $len $pfx $ref]} {
++ # We're on a branch. It might not exist. But
++ # HEAD looks good enough to be a branch.
++ #
++ set current_branch [string range $ref $len end]
++ set is_detached 0
++ } else {
++ # Assume this is a detached head.
++ #
++ set current_branch HEAD
++ set is_detached 1
++ }
++}
++
++auto_load tk_optionMenu
++rename tk_optionMenu real__tkOptionMenu
++proc tk_optionMenu {w varName args} {
++ set m [eval real__tkOptionMenu $w $varName $args]
++ $m configure -font font_ui
++ $w configure -font font_ui
++ return $m
++}
++
++proc rmsel_tag {text} {
++ $text tag conf sel \
++ -background [$text cget -background] \
++ -foreground [$text cget -foreground] \
++ -borderwidth 0
++ $text tag conf in_sel -background lightgray
++ bind $text <Motion> break
++ return $text
++}
++
++set root_exists 0
++bind . <Visibility> {
++ bind . <Visibility> {}
++ set root_exists 1
++}
++
++if {[is_Windows]} {
++ wm iconbitmap . -default $oguilib/git-gui.ico
++}
++
++######################################################################
++##
++## config defaults
++
++set cursor_ptr arrow
++font create font_diff -family Courier -size 10
++font create font_ui
++catch {
++ label .dummy
++ eval font configure font_ui [font actual [.dummy cget -font]]
++ destroy .dummy
++}
++
++font create font_uiitalic
++font create font_uibold
++font create font_diffbold
++font create font_diffitalic
++
++foreach class {Button Checkbutton Entry Label
++ Labelframe Listbox Menu Message
++ Radiobutton Spinbox Text} {
++ option add *$class.font font_ui
++}
++unset class
++
++if {[is_Windows] || [is_MacOSX]} {
++ option add *Menu.tearOff 0
++}
++
++if {[is_MacOSX]} {
++ set M1B M1
++ set M1T Cmd
++} else {
++ set M1B Control
++ set M1T Ctrl
++}
++
++proc bind_button3 {w cmd} {
++ bind $w <Any-Button-3> $cmd
++ if {[is_MacOSX]} {
++ # Mac OS X sends Button-2 on right click through three-button mouse,
++ # or through trackpad right-clicking (two-finger touch + click).
++ bind $w <Any-Button-2> $cmd
++ bind $w <Control-Button-1> $cmd
++ }
++}
++
++proc apply_config {} {
++ global repo_config font_descs
++
++ foreach option $font_descs {
++ set name [lindex $option 0]
++ set font [lindex $option 1]
++ if {[catch {
++ set need_weight 1
++ foreach {cn cv} $repo_config(gui.$name) {
++ if {$cn eq {-weight}} {
++ set need_weight 0
++ }
++ font configure $font $cn $cv
++ }
++ if {$need_weight} {
++ font configure $font -weight normal
++ }
++ } err]} {
++ error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
++ }
++ foreach {cn cv} [font configure $font] {
++ font configure ${font}bold $cn $cv
++ font configure ${font}italic $cn $cv
++ }
++ font configure ${font}bold -weight bold
++ font configure ${font}italic -slant italic
++ }
++}
++
++set default_config(branch.autosetupmerge) true
+++set default_config(merge.tool) {}
+++set default_config(merge.keepbackup) true
++set default_config(merge.diffstat) true
++set default_config(merge.summary) false
++set default_config(merge.verbosity) 2
++set default_config(user.name) {}
++set default_config(user.email) {}
++
++set default_config(gui.matchtrackingbranch) false
++set default_config(gui.pruneduringfetch) false
++set default_config(gui.trustmtime) false
++set default_config(gui.fastcopyblame) false
++set default_config(gui.copyblamethreshold) 40
+++set default_config(gui.blamehistoryctx) 7
++set default_config(gui.diffcontext) 5
++set default_config(gui.commitmsgwidth) 75
++set default_config(gui.newbranchtemplate) {}
++set default_config(gui.spellingdictionary) {}
++set default_config(gui.fontui) [font configure font_ui]
++set default_config(gui.fontdiff) [font configure font_diff]
++set font_descs {
++ {fontui font_ui {mc "Main Font"}}
++ {fontdiff font_diff {mc "Diff/Console Font"}}
++}
++
++######################################################################
++##
++## find git
++
++set _git [_which git]
++if {$_git eq {}} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message [mc "Cannot find git in PATH."]
++ exit 1
++}
++
++######################################################################
++##
++## version check
++
++if {[catch {set _git_version [git --version]} err]} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message "Cannot determine Git version:
++
++$err
++
++[appname] requires Git 1.5.0 or later."
++ exit 1
++}
++if {![regsub {^git version } $_git_version {} _git_version]} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
++ exit 1
++}
++
++set _real_git_version $_git_version
++regsub -- {[\-\.]dirty$} $_git_version {} _git_version
++regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
++regsub {\.rc[0-9]+$} $_git_version {} _git_version
++regsub {\.GIT$} $_git_version {} _git_version
++regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
++
++if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
++ catch {wm withdraw .}
++ if {[tk_messageBox \
++ -icon warning \
++ -type yesno \
++ -default no \
++ -title "[appname]: warning" \
++ -message [mc "Git version cannot be determined.
++
++%s claims it is version '%s'.
++
++%s requires at least Git 1.5.0 or later.
++
++Assume '%s' is version 1.5.0?
++" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
++ set _git_version 1.5.0
++ } else {
++ exit 1
++ }
++}
++unset _real_git_version
++
++proc git-version {args} {
++ global _git_version
++
++ switch [llength $args] {
++ 0 {
++ return $_git_version
++ }
++
++ 2 {
++ set op [lindex $args 0]
++ set vr [lindex $args 1]
++ set cm [package vcompare $_git_version $vr]
++ return [expr $cm $op 0]
++ }
++
++ 4 {
++ set type [lindex $args 0]
++ set name [lindex $args 1]
++ set parm [lindex $args 2]
++ set body [lindex $args 3]
++
++ if {($type ne {proc} && $type ne {method})} {
++ error "Invalid arguments to git-version"
++ }
++ if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
++ error "Last arm of $type $name must be default"
++ }
++
++ foreach {op vr cb} [lrange $body 0 end-2] {
++ if {[git-version $op $vr]} {
++ return [uplevel [list $type $name $parm $cb]]
++ }
++ }
++
++ return [uplevel [list $type $name $parm [lindex $body end]]]
++ }
++
++ default {
++ error "git-version >= x"
++ }
++
++ }
++}
++
++if {[git-version < 1.5]} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message "[appname] requires Git 1.5.0 or later.
++
++You are using [git-version]:
++
++[git --version]"
++ exit 1
++}
++
++######################################################################
++##
++## configure our library
++
++set idx [file join $oguilib tclIndex]
++if {[catch {set fd [open $idx r]} err]} {
++ catch {wm withdraw .}
++ tk_messageBox \
++ -icon error \
++ -type ok \
++ -title [mc "git-gui: fatal error"] \
++ -message $err
++ exit 1
++}
++if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
++ set idx [list]
++ while {[gets $fd n] >= 0} {
++ if {$n ne {} && ![string match #* $n]} {
++ lappend idx $n
++ }
++ }
++} else {
++ set idx {}
++}
++close $fd
++
++if {$idx ne {}} {
++ set loaded [list]
++ foreach p $idx {
++ if {[lsearch -exact $loaded $p] >= 0} continue
++ source [file join $oguilib $p]
++ lappend loaded $p
++ }
++ unset loaded p
++} else {
++ set auto_path [concat [list $oguilib] $auto_path]
++}
++unset -nocomplain idx fd
++
++######################################################################
++##
++## config file parsing
++
++git-version proc _parse_config {arr_name args} {
++ >= 1.5.3 {
++ upvar $arr_name arr
++ array unset arr
++ set buf {}
++ catch {
++ set fd_rc [eval \
++ [list git_read config] \
++ $args \
++ [list --null --list]]
++ fconfigure $fd_rc -translation binary
++ set buf [read $fd_rc]
++ close $fd_rc
++ }
++ foreach line [split $buf "\0"] {
++ if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
++ if {[is_many_config $name]} {
++ lappend arr($name) $value
++ } else {
++ set arr($name) $value
++ }
++ }
++ }
++ }
++ default {
++ upvar $arr_name arr
++ array unset arr
++ catch {
++ set fd_rc [eval [list git_read config --list] $args]
++ while {[gets $fd_rc line] >= 0} {
++ if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
++ if {[is_many_config $name]} {
++ lappend arr($name) $value
++ } else {
++ set arr($name) $value
++ }
++ }
++ }
++ close $fd_rc
++ }
++ }
++}
++
++proc load_config {include_global} {
++ global repo_config global_config default_config
++
++ if {$include_global} {
++ _parse_config global_config --global
++ }
++ _parse_config repo_config
++
++ foreach name [array names default_config] {
++ if {[catch {set v $global_config($name)}]} {
++ set global_config($name) $default_config($name)
++ }
++ if {[catch {set v $repo_config($name)}]} {
++ set repo_config($name) $default_config($name)
++ }
++ }
++}
++
++######################################################################
++##
++## feature option selection
++
++if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
++ unset _junk
++} else {
++ set subcommand gui
++}
++if {$subcommand eq {gui.sh}} {
++ set subcommand gui
++}
++if {$subcommand eq {gui} && [llength $argv] > 0} {
++ set subcommand [lindex $argv 0]
++ set argv [lrange $argv 1 end]
++}
++
++enable_option multicommit
++enable_option branch
++enable_option transport
++disable_option bare
++
++switch -- $subcommand {
++browser -
++blame {
++ enable_option bare
++
++ disable_option multicommit
++ disable_option branch
++ disable_option transport
++}
++citool {
++ enable_option singlecommit
++
++ disable_option multicommit
++ disable_option branch
++ disable_option transport
++}
++}
++
++######################################################################
++##
++## repository setup
++
++if {[catch {
++ set _gitdir $env(GIT_DIR)
++ set _prefix {}
++ }]
++ && [catch {
++ set _gitdir [git rev-parse --git-dir]
++ set _prefix [git rev-parse --show-prefix]
++ } err]} {
++ load_config 1
++ apply_config
++ choose_repository::pick
++}
++if {![file isdirectory $_gitdir] && [is_Cygwin]} {
++ catch {set _gitdir [exec cygpath --windows $_gitdir]}
++}
++if {![file isdirectory $_gitdir]} {
++ catch {wm withdraw .}
++ error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
++ exit 1
++}
++if {$_prefix ne {}} {
++ regsub -all {[^/]+/} $_prefix ../ cdup
++ if {[catch {cd $cdup} err]} {
++ catch {wm withdraw .}
++ error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
++ exit 1
++ }
++ unset cdup
++} elseif {![is_enabled bare]} {
++ if {[lindex [file split $_gitdir] end] ne {.git}} {
++ catch {wm withdraw .}
++ error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
++ exit 1
++ }
++ if {[catch {cd [file dirname $_gitdir]} err]} {
++ catch {wm withdraw .}
++ error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
++ exit 1
++ }
++}
++set _reponame [file split [file normalize $_gitdir]]
++if {[lindex $_reponame end] eq {.git}} {
++ set _reponame [lindex $_reponame end-1]
++} else {
++ set _reponame [lindex $_reponame end]
++}
++
++######################################################################
++##
++## global init
++
++set current_diff_path {}
++set current_diff_side {}
++set diff_actions [list]
++
++set HEAD {}
++set PARENT {}
++set MERGE_HEAD [list]
++set commit_type {}
++set empty_tree {}
++set current_branch {}
++set is_detached 0
++set current_diff_path {}
++set is_3way_diff 0
++set selected_commit_type new
++
++######################################################################
++##
++## task management
++
++set rescan_active 0
++set diff_active 0
++set last_clicked {}
++
++set disable_on_lock [list]
++set index_lock_type none
++
++proc lock_index {type} {
++ global index_lock_type disable_on_lock
++
++ if {$index_lock_type eq {none}} {
++ set index_lock_type $type
++ foreach w $disable_on_lock {
++ uplevel #0 $w disabled
++ }
++ return 1
++ } elseif {$index_lock_type eq "begin-$type"} {
++ set index_lock_type $type
++ return 1
++ }
++ return 0
++}
++
++proc unlock_index {} {
++ global index_lock_type disable_on_lock
++
++ set index_lock_type none
++ foreach w $disable_on_lock {
++ uplevel #0 $w normal
++ }
++}
++
++######################################################################
++##
++## status
++
++proc repository_state {ctvar hdvar mhvar} {
++ global current_branch
++ upvar $ctvar ct $hdvar hd $mhvar mh
++
++ set mh [list]
++
++ load_current_branch
++ if {[catch {set hd [git rev-parse --verify HEAD]}]} {
++ set hd {}
++ set ct initial
++ return
++ }
++
++ set merge_head [gitdir MERGE_HEAD]
++ if {[file exists $merge_head]} {
++ set ct merge
++ set fd_mh [open $merge_head r]
++ while {[gets $fd_mh line] >= 0} {
++ lappend mh $line
++ }
++ close $fd_mh
++ return
++ }
++
++ set ct normal
++}
++
++proc PARENT {} {
++ global PARENT empty_tree
++
++ set p [lindex $PARENT 0]
++ if {$p ne {}} {
++ return $p
++ }
++ if {$empty_tree eq {}} {
++ set empty_tree [git mktree << {}]
++ }
++ return $empty_tree
++}
++
++proc rescan {after {honor_trustmtime 1}} {
++ global HEAD PARENT MERGE_HEAD commit_type
++ global ui_index ui_workdir ui_comm
++ global rescan_active file_states
++ global repo_config
++
++ if {$rescan_active > 0 || ![lock_index read]} return
++
++ repository_state newType newHEAD newMERGE_HEAD
++ if {[string match amend* $commit_type]
++ && $newType eq {normal}
++ && $newHEAD eq $HEAD} {
++ } else {
++ set HEAD $newHEAD
++ set PARENT $newHEAD
++ set MERGE_HEAD $newMERGE_HEAD
++ set commit_type $newType
++ }
++
++ array unset file_states
++
++ if {!$::GITGUI_BCK_exists &&
++ (![$ui_comm edit modified]
++ || [string trim [$ui_comm get 0.0 end]] eq {})} {
++ if {[string match amend* $commit_type]} {
++ } elseif {[load_message GITGUI_MSG]} {
++ } elseif {[load_message MERGE_MSG]} {
++ } elseif {[load_message SQUASH_MSG]} {
++ }
++ $ui_comm edit reset
++ $ui_comm edit modified false
++ }
++
++ if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
++ rescan_stage2 {} $after
++ } else {
++ set rescan_active 1
++ ui_status [mc "Refreshing file status..."]
++ set fd_rf [git_read update-index \
++ -q \
++ --unmerged \
++ --ignore-missing \
++ --refresh \
++ ]
++ fconfigure $fd_rf -blocking 0 -translation binary
++ fileevent $fd_rf readable \
++ [list rescan_stage2 $fd_rf $after]
++ }
++}
++
++if {[is_Cygwin]} {
++ set is_git_info_exclude {}
++ proc have_info_exclude {} {
++ global is_git_info_exclude
++
++ if {$is_git_info_exclude eq {}} {
++ if {[catch {exec test -f [gitdir info exclude]}]} {
++ set is_git_info_exclude 0
++ } else {
++ set is_git_info_exclude 1
++ }
++ }
++ return $is_git_info_exclude
++ }
++} else {
++ proc have_info_exclude {} {
++ return [file readable [gitdir info exclude]]
++ }
++}
++
++proc rescan_stage2 {fd after} {
++ global rescan_active buf_rdi buf_rdf buf_rlo
++
++ if {$fd ne {}} {
++ read $fd
++ if {![eof $fd]} return
++ close $fd
++ }
++
++ set ls_others [list --exclude-per-directory=.gitignore]
++ if {[have_info_exclude]} {
++ lappend ls_others "--exclude-from=[gitdir info exclude]"
++ }
++ set user_exclude [get_config core.excludesfile]
++ if {$user_exclude ne {} && [file readable $user_exclude]} {
++ lappend ls_others "--exclude-from=$user_exclude"
++ }
++
++ set buf_rdi {}
++ set buf_rdf {}
++ set buf_rlo {}
++
++ set rescan_active 3
++ ui_status [mc "Scanning for modified files ..."]
++ set fd_di [git_read diff-index --cached -z [PARENT]]
++ set fd_df [git_read diff-files -z]
++ set fd_lo [eval git_read ls-files --others -z $ls_others]
++
++ fconfigure $fd_di -blocking 0 -translation binary -encoding binary
++ fconfigure $fd_df -blocking 0 -translation binary -encoding binary
++ fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
++ fileevent $fd_di readable [list read_diff_index $fd_di $after]
++ fileevent $fd_df readable [list read_diff_files $fd_df $after]
++ fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
++}
++
++proc load_message {file} {
++ global ui_comm
++
++ set f [gitdir $file]
++ if {[file isfile $f]} {
++ if {[catch {set fd [open $f r]}]} {
++ return 0
++ }
++ fconfigure $fd -eofchar {}
++ set content [string trim [read $fd]]
++ close $fd
++ regsub -all -line {[ \r\t]+$} $content {} content
++ $ui_comm delete 0.0 end
++ $ui_comm insert end $content
++ return 1
++ }
++ return 0
++}
++
++proc read_diff_index {fd after} {
++ global buf_rdi
++
++ append buf_rdi [read $fd]
++ set c 0
++ set n [string length $buf_rdi]
++ while {$c < $n} {
++ set z1 [string first "\0" $buf_rdi $c]
++ if {$z1 == -1} break
++ incr z1
++ set z2 [string first "\0" $buf_rdi $z1]
++ if {$z2 == -1} break
++
++ incr c
++ set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
++ set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
++ merge_state \
++ [encoding convertfrom $p] \
++ [lindex $i 4]? \
++ [list [lindex $i 0] [lindex $i 2]] \
++ [list]
++ set c $z2
++ incr c
++ }
++ if {$c < $n} {
++ set buf_rdi [string range $buf_rdi $c end]
++ } else {
++ set buf_rdi {}
++ }
++
++ rescan_done $fd buf_rdi $after
++}
++
++proc read_diff_files {fd after} {
++ global buf_rdf
++
++ append buf_rdf [read $fd]
++ set c 0
++ set n [string length $buf_rdf]
++ while {$c < $n} {
++ set z1 [string first "\0" $buf_rdf $c]
++ if {$z1 == -1} break
++ incr z1
++ set z2 [string first "\0" $buf_rdf $z1]
++ if {$z2 == -1} break
++
++ incr c
++ set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
++ set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
++ merge_state \
++ [encoding convertfrom $p] \
++ ?[lindex $i 4] \
++ [list] \
++ [list [lindex $i 0] [lindex $i 2]]
++ set c $z2
++ incr c
++ }
++ if {$c < $n} {
++ set buf_rdf [string range $buf_rdf $c end]
++ } else {
++ set buf_rdf {}
++ }
++
++ rescan_done $fd buf_rdf $after
++}
++
++proc read_ls_others {fd after} {
++ global buf_rlo
++
++ append buf_rlo [read $fd]
++ set pck [split $buf_rlo "\0"]
++ set buf_rlo [lindex $pck end]
++ foreach p [lrange $pck 0 end-1] {
++ set p [encoding convertfrom $p]
++ if {[string index $p end] eq {/}} {
++ set p [string range $p 0 end-1]
++ }
++ merge_state $p ?O
++ }
++ rescan_done $fd buf_rlo $after
++}
++
++proc rescan_done {fd buf after} {
++ global rescan_active current_diff_path
++ global file_states repo_config
++ upvar $buf to_clear
++
++ if {![eof $fd]} return
++ set to_clear {}
++ close $fd
++ if {[incr rescan_active -1] > 0} return
++
++ prune_selection
++ unlock_index
++ display_all_files
++ if {$current_diff_path ne {}} reshow_diff
+++ if {$current_diff_path eq {}} select_first_diff
+++
++ uplevel #0 $after
++}
++
++proc prune_selection {} {
++ global file_states selected_paths
++
++ foreach path [array names selected_paths] {
++ if {[catch {set still_here $file_states($path)}]} {
++ unset selected_paths($path)
++ }
++ }
++}
++
++######################################################################
++##
++## ui helpers
++
++proc mapicon {w state path} {
++ global all_icons
++
++ if {[catch {set r $all_icons($state$w)}]} {
++ puts "error: no icon for $w state={$state} $path"
++ return file_plain
++ }
++ return $r
++}
++
++proc mapdesc {state path} {
++ global all_descs
++
++ if {[catch {set r $all_descs($state)}]} {
++ puts "error: no desc for state={$state} $path"
++ return $state
++ }
++ return $r
++}
++
++proc ui_status {msg} {
++ global main_status
++ if {[info exists main_status]} {
++ $main_status show $msg
++ }
++}
++
++proc ui_ready {{test {}}} {
++ global main_status
++ if {[info exists main_status]} {
++ $main_status show [mc "Ready."] $test
++ }
++}
++
++proc escape_path {path} {
++ regsub -all {\\} $path "\\\\" path
++ regsub -all "\n" $path "\\n" path
++ return $path
++}
++
++proc short_path {path} {
++ return [escape_path [lindex [file split $path] end]]
++}
++
++set next_icon_id 0
++set null_sha1 [string repeat 0 40]
++
++proc merge_state {path new_state {head_info {}} {index_info {}}} {
++ global file_states next_icon_id null_sha1
++
++ set s0 [string index $new_state 0]
++ set s1 [string index $new_state 1]
++
++ if {[catch {set info $file_states($path)}]} {
++ set state __
++ set icon n[incr next_icon_id]
++ } else {
++ set state [lindex $info 0]
++ set icon [lindex $info 1]
++ if {$head_info eq {}} {set head_info [lindex $info 2]}
++ if {$index_info eq {}} {set index_info [lindex $info 3]}
++ }
++
++ if {$s0 eq {?}} {set s0 [string index $state 0]} \
++ elseif {$s0 eq {_}} {set s0 _}
++
++ if {$s1 eq {?}} {set s1 [string index $state 1]} \
++ elseif {$s1 eq {_}} {set s1 _}
++
++ if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
++ set head_info [list 0 $null_sha1]
++ } elseif {$s0 ne {_} && [string index $state 0] eq {_}
++ && $head_info eq {}} {
++ set head_info $index_info
++ }
++
++ set file_states($path) [list $s0$s1 $icon \
++ $head_info $index_info \
++ ]
++ return $state
++}
++
++proc display_file_helper {w path icon_name old_m new_m} {
++ global file_lists
++
++ if {$new_m eq {_}} {
++ set lno [lsearch -sorted -exact $file_lists($w) $path]
++ if {$lno >= 0} {
++ set file_lists($w) [lreplace $file_lists($w) $lno $lno]
++ incr lno
++ $w conf -state normal
++ $w delete $lno.0 [expr {$lno + 1}].0
++ $w conf -state disabled
++ }
++ } elseif {$old_m eq {_} && $new_m ne {_}} {
++ lappend file_lists($w) $path
++ set file_lists($w) [lsort -unique $file_lists($w)]
++ set lno [lsearch -sorted -exact $file_lists($w) $path]
++ incr lno
++ $w conf -state normal
++ $w image create $lno.0 \
++ -align center -padx 5 -pady 1 \
++ -name $icon_name \
++ -image [mapicon $w $new_m $path]
++ $w insert $lno.1 "[escape_path $path]\n"
++ $w conf -state disabled
++ } elseif {$old_m ne $new_m} {
++ $w conf -state normal
++ $w image conf $icon_name -image [mapicon $w $new_m $path]
++ $w conf -state disabled
++ }
++}
++
++proc display_file {path state} {
++ global file_states selected_paths
++ global ui_index ui_workdir
++
++ set old_m [merge_state $path $state]
++ set s $file_states($path)
++ set new_m [lindex $s 0]
++ set icon_name [lindex $s 1]
++
++ set o [string index $old_m 0]
++ set n [string index $new_m 0]
++ if {$o eq {U}} {
++ set o _
++ }
++ if {$n eq {U}} {
++ set n _
++ }
++ display_file_helper $ui_index $path $icon_name $o $n
++
++ if {[string index $old_m 0] eq {U}} {
++ set o U
++ } else {
++ set o [string index $old_m 1]
++ }
++ if {[string index $new_m 0] eq {U}} {
++ set n U
++ } else {
++ set n [string index $new_m 1]
++ }
++ display_file_helper $ui_workdir $path $icon_name $o $n
++
++ if {$new_m eq {__}} {
++ unset file_states($path)
++ catch {unset selected_paths($path)}
++ }
++}
++
++proc display_all_files_helper {w path icon_name m} {
++ global file_lists
++
++ lappend file_lists($w) $path
++ set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
++ $w image create end \
++ -align center -padx 5 -pady 1 \
++ -name $icon_name \
++ -image [mapicon $w $m $path]
++ $w insert end "[escape_path $path]\n"
++}
++
++proc display_all_files {} {
++ global ui_index ui_workdir
++ global file_states file_lists
++ global last_clicked
++
++ $ui_index conf -state normal
++ $ui_workdir conf -state normal
++
++ $ui_index delete 0.0 end
++ $ui_workdir delete 0.0 end
++ set last_clicked {}
++
++ set file_lists($ui_index) [list]
++ set file_lists($ui_workdir) [list]
++
++ foreach path [lsort [array names file_states]] {
++ set s $file_states($path)
++ set m [lindex $s 0]
++ set icon_name [lindex $s 1]
++
++ set s [string index $m 0]
++ if {$s ne {U} && $s ne {_}} {
++ display_all_files_helper $ui_index $path \
++ $icon_name $s
++ }
++
++ if {[string index $m 0] eq {U}} {
++ set s U
++ } else {
++ set s [string index $m 1]
++ }
++ if {$s ne {_}} {
++ display_all_files_helper $ui_workdir $path \
++ $icon_name $s
++ }
++ }
++
++ $ui_index conf -state disabled
++ $ui_workdir conf -state disabled
++}
++
++######################################################################
++##
++## icons
++
++set filemask {
++#define mask_width 14
++#define mask_height 15
++static unsigned char mask_bits[] = {
++ 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
++ 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
++ 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
++}
++
++image create bitmap file_plain -background white -foreground black -data {
++#define plain_width 14
++#define plain_height 15
++static unsigned char plain_bits[] = {
++ 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
++ 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
++ 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_mod -background white -foreground blue -data {
++#define mod_width 14
++#define mod_height 15
++static unsigned char mod_bits[] = {
++ 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
++ 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
++ 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_fulltick -background white -foreground "#007000" -data {
++#define file_fulltick_width 14
++#define file_fulltick_height 15
++static unsigned char file_fulltick_bits[] = {
++ 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
++ 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
++ 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_parttick -background white -foreground "#005050" -data {
++#define parttick_width 14
++#define parttick_height 15
++static unsigned char parttick_bits[] = {
++ 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
++ 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
++ 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_question -background white -foreground black -data {
++#define file_question_width 14
++#define file_question_height 15
++static unsigned char file_question_bits[] = {
++ 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
++ 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
++ 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_removed -background white -foreground red -data {
++#define file_removed_width 14
++#define file_removed_height 15
++static unsigned char file_removed_bits[] = {
++ 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
++ 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
++ 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
++image create bitmap file_merge -background white -foreground blue -data {
++#define file_merge_width 14
++#define file_merge_height 15
++static unsigned char file_merge_bits[] = {
++ 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
++ 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
++ 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
++} -maskdata $filemask
++
+++image create bitmap file_statechange -background white -foreground green -data {
+++#define file_merge_width 14
+++#define file_merge_height 15
+++static unsigned char file_statechange_bits[] = {
+++ 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
+++ 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
+++ 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
+++} -maskdata $filemask
+++
++set ui_index .vpane.files.index.list
++set ui_workdir .vpane.files.workdir.list
++
++set all_icons(_$ui_index) file_plain
++set all_icons(A$ui_index) file_fulltick
++set all_icons(M$ui_index) file_fulltick
++set all_icons(D$ui_index) file_removed
++set all_icons(U$ui_index) file_merge
+++set all_icons(T$ui_index) file_statechange
++
++set all_icons(_$ui_workdir) file_plain
++set all_icons(M$ui_workdir) file_mod
++set all_icons(D$ui_workdir) file_question
++set all_icons(U$ui_workdir) file_merge
++set all_icons(O$ui_workdir) file_plain
+++set all_icons(T$ui_workdir) file_statechange
++
++set max_status_desc 0
++foreach i {
++ {__ {mc "Unmodified"}}
++
++ {_M {mc "Modified, not staged"}}
++ {M_ {mc "Staged for commit"}}
++ {MM {mc "Portions staged for commit"}}
++ {MD {mc "Staged for commit, missing"}}
++
+++ {_T {mc "File type changed, not staged"}}
+++ {T_ {mc "File type changed, staged"}}
+++
++ {_O {mc "Untracked, not staged"}}
++ {A_ {mc "Staged for commit"}}
++ {AM {mc "Portions staged for commit"}}
++ {AD {mc "Staged for commit, missing"}}
++
++ {_D {mc "Missing"}}
++ {D_ {mc "Staged for removal"}}
++ {DO {mc "Staged for removal, still present"}}
++
+++ {_U {mc "Requires merge resolution"}}
++ {U_ {mc "Requires merge resolution"}}
++ {UU {mc "Requires merge resolution"}}
++ {UM {mc "Requires merge resolution"}}
++ {UD {mc "Requires merge resolution"}}
+++ {UT {mc "Requires merge resolution"}}
++ } {
++ set text [eval [lindex $i 1]]
++ if {$max_status_desc < [string length $text]} {
++ set max_status_desc [string length $text]
++ }
++ set all_descs([lindex $i 0]) $text
++}
++unset i
++
++######################################################################
++##
++## util
++
++proc scrollbar2many {list mode args} {
++ foreach w $list {eval $w $mode $args}
++}
++
++proc many2scrollbar {list mode sb top bottom} {
++ $sb set $top $bottom
++ foreach w $list {$w $mode moveto $top}
++}
++
++proc incr_font_size {font {amt 1}} {
++ set sz [font configure $font -size]
++ incr sz $amt
++ font configure $font -size $sz
++ font configure ${font}bold -size $sz
++ font configure ${font}italic -size $sz
++}
++
++######################################################################
++##
++## ui commands
++
++set starting_gitk_msg [mc "Starting gitk... please wait..."]
++
++proc do_gitk {revs} {
++ # -- Always start gitk through whatever we were loaded with. This
++ # lets us bypass using shell process on Windows systems.
++ #
++ set exe [_which gitk -script]
++ set cmd [list [info nameofexecutable] $exe]
++ if {$exe eq {}} {
++ error_popup [mc "Couldn't find gitk in PATH"]
++ } else {
++ global env
++
++ if {[info exists env(GIT_DIR)]} {
++ set old_GIT_DIR $env(GIT_DIR)
++ } else {
++ set old_GIT_DIR {}
++ }
++
++ set pwd [pwd]
++ cd [file dirname [gitdir]]
++ set env(GIT_DIR) [file tail [gitdir]]
++
++ eval exec $cmd $revs &
++
++ if {$old_GIT_DIR eq {}} {
++ unset env(GIT_DIR)
++ } else {
++ set env(GIT_DIR) $old_GIT_DIR
++ }
++ cd $pwd
++
++ ui_status $::starting_gitk_msg
++ after 10000 {
++ ui_ready $starting_gitk_msg
++ }
++ }
++}
++
++set is_quitting 0
++
++proc do_quit {} {
++ global ui_comm is_quitting repo_config commit_type
++ global GITGUI_BCK_exists GITGUI_BCK_i
++ global ui_comm_spell
++
++ if {$is_quitting} return
++ set is_quitting 1
++
++ if {[winfo exists $ui_comm]} {
++ # -- Stash our current commit buffer.
++ #
++ set save [gitdir GITGUI_MSG]
++ if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
++ file rename -force [gitdir GITGUI_BCK] $save
++ set GITGUI_BCK_exists 0
++ } else {
++ set msg [string trim [$ui_comm get 0.0 end]]
++ regsub -all -line {[ \r\t]+$} $msg {} msg
++ if {(![string match amend* $commit_type]
++ || [$ui_comm edit modified])
++ && $msg ne {}} {
++ catch {
++ set fd [open $save w]
++ puts -nonewline $fd $msg
++ close $fd
++ }
++ } else {
++ catch {file delete $save}
++ }
++ }
++
++ # -- Cancel our spellchecker if its running.
++ #
++ if {[info exists ui_comm_spell]} {
++ $ui_comm_spell stop
++ }
++
++ # -- Remove our editor backup, its not needed.
++ #
++ after cancel $GITGUI_BCK_i
++ if {$GITGUI_BCK_exists} {
++ catch {file delete [gitdir GITGUI_BCK]}
++ }
++
++ # -- Stash our current window geometry into this repository.
++ #
++ set cfg_geometry [list]
++ lappend cfg_geometry [wm geometry .]
++ lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
++ lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
++ if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
++ set rc_geometry {}
++ }
++ if {$cfg_geometry ne $rc_geometry} {
++ catch {git config gui.geometry $cfg_geometry}
++ }
++ }
++
++ destroy .
++}
++
++proc do_rescan {} {
++ rescan ui_ready
++}
++
+++proc ui_do_rescan {} {
+++ rescan {force_first_diff; ui_ready}
+++}
+++
++proc do_commit {} {
++ commit_tree
++}
++
++proc next_diff {} {
++ global next_diff_p next_diff_w next_diff_i
- if {$col == 0 && $y > 1} {
- set i [expr {$lno-1}]
- set ll [expr {[llength $file_lists($w)]-1}]
-
- if {$i == $ll && $i == 0} {
- set after {reshow_diff;}
- } else {
- global next_diff_p next_diff_w next_diff_i
-
- set next_diff_w $w
-
- if {$i < $ll} {
- set i [expr {$i + 1}]
- set next_diff_i $i
- } else {
- set next_diff_i $i
- set i [expr {$i - 1}]
- }
+++ show_diff $next_diff_p $next_diff_w {}
+++}
+++
+++proc find_anchor_pos {lst name} {
+++ set lid [lsearch -sorted -exact $lst $name]
+++
+++ if {$lid == -1} {
+++ set lid 0
+++ foreach lname $lst {
+++ if {$lname >= $name} break
+++ incr lid
+++ }
+++ }
+++
+++ return $lid
+++}
+++
+++proc find_file_from {flist idx delta path mmask} {
+++ global file_states
+++
+++ set len [llength $flist]
+++ while {$idx >= 0 && $idx < $len} {
+++ set name [lindex $flist $idx]
+++
+++ if {$name ne $path && [info exists file_states($name)]} {
+++ set state [lindex $file_states($name) 0]
+++
+++ if {$mmask eq {} || [regexp $mmask $state]} {
+++ return $idx
+++ }
+++ }
+++
+++ incr idx $delta
+++ }
+++
+++ return {}
+++}
+++
+++proc find_next_diff {w path {lno {}} {mmask {}}} {
+++ global next_diff_p next_diff_w next_diff_i
+++ global file_lists ui_index ui_workdir
+++
+++ set flist $file_lists($w)
+++ if {$lno eq {}} {
+++ set lno [find_anchor_pos $flist $path]
+++ } else {
+++ incr lno -1
+++ }
+++
+++ if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
+++ if {$w eq $ui_index} {
+++ set mmask "^$mmask"
+++ } else {
+++ set mmask "$mmask\$"
+++ }
+++ }
+++
+++ set idx [find_file_from $flist $lno 1 $path $mmask]
+++ if {$idx eq {}} {
+++ incr lno -1
+++ set idx [find_file_from $flist $lno -1 $path $mmask]
+++ }
+++
+++ if {$idx ne {}} {
+++ set next_diff_w $w
+++ set next_diff_p [lindex $flist $idx]
+++ set next_diff_i [expr {$idx+1}]
+++ return 1
+++ } else {
+++ return 0
+++ }
+++}
+++
+++proc next_diff_after_action {w path {lno {}} {mmask {}}} {
+++ global current_diff_path
+++
+++ if {$path ne $current_diff_path} {
+++ return {}
+++ } elseif {[find_next_diff $w $path $lno $mmask]} {
+++ return {next_diff;}
+++ } else {
+++ return {reshow_diff;}
+++ }
+++}
+++
+++proc select_first_diff {} {
+++ global ui_workdir
+++
+++ if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
+++ [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
+++ next_diff
+++ }
+++}
+++
+++proc force_first_diff {} {
+++ global current_diff_path
+++
+++ if {[info exists file_states($current_diff_path)]} {
+++ set state [lindex $file_states($current_diff_path) 0]
+++
+++ if {[string index $state 1] ne {O}} return
+++ }
+++
+++ select_first_diff
++}
++
++proc toggle_or_diff {w x y} {
++ global file_states file_lists current_diff_path ui_index ui_workdir
++ global last_clicked selected_paths
++
++ set pos [split [$w index @$x,$y] .]
++ set lno [lindex $pos 0]
++ set col [lindex $pos 1]
++ set path [lindex $file_lists($w) [expr {$lno - 1}]]
++ if {$path eq {}} {
++ set last_clicked {}
++ return
++ }
++
++ set last_clicked [list $w $lno]
++ array unset selected_paths
++ $ui_index tag remove in_sel 0.0 end
++ $ui_workdir tag remove in_sel 0.0 end
++
- set next_diff_p [lindex $file_lists($w) $i]
+++ # Do not stage files with conflicts
+++ if {[info exists file_states($path)]} {
+++ set state [lindex $file_states($path) 0]
+++ } else {
+++ set state {__}
+++ }
++
- if {$next_diff_p ne {} && $current_diff_path ne {}} {
- set after {next_diff;}
- } else {
- set after {}
- }
+++ if {[string first {U} $state] >= 0} {
+++ set col 1
+++ }
++
- -command do_rescan \
+++ # Restage the file, or simply show the diff
+++ if {$col == 0 && $y > 1} {
+++ if {[string index $state 1] eq {O}} {
+++ set mmask {}
+++ } else {
+++ set mmask {[^O]}
++ }
++
+++ set after [next_diff_after_action $w $path $lno $mmask]
+++
++ if {$w eq $ui_index} {
++ update_indexinfo \
++ "Unstaging [short_path $path] from commit" \
++ [list $path] \
++ [concat $after [list ui_ready]]
++ } elseif {$w eq $ui_workdir} {
++ update_index \
++ "Adding [short_path $path]" \
++ [list $path] \
++ [concat $after [list ui_ready]]
++ }
++ } else {
++ show_diff $path $w $lno
++ }
++}
++
++proc add_one_to_selection {w x y} {
++ global file_lists last_clicked selected_paths
++
++ set lno [lindex [split [$w index @$x,$y] .] 0]
++ set path [lindex $file_lists($w) [expr {$lno - 1}]]
++ if {$path eq {}} {
++ set last_clicked {}
++ return
++ }
++
++ if {$last_clicked ne {}
++ && [lindex $last_clicked 0] ne $w} {
++ array unset selected_paths
++ [lindex $last_clicked 0] tag remove in_sel 0.0 end
++ }
++
++ set last_clicked [list $w $lno]
++ if {[catch {set in_sel $selected_paths($path)}]} {
++ set in_sel 0
++ }
++ if {$in_sel} {
++ unset selected_paths($path)
++ $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
++ } else {
++ set selected_paths($path) 1
++ $w tag add in_sel $lno.0 [expr {$lno + 1}].0
++ }
++}
++
++proc add_range_to_selection {w x y} {
++ global file_lists last_clicked selected_paths
++
++ if {[lindex $last_clicked 0] ne $w} {
++ toggle_or_diff $w $x $y
++ return
++ }
++
++ set lno [lindex [split [$w index @$x,$y] .] 0]
++ set lc [lindex $last_clicked 1]
++ if {$lc < $lno} {
++ set begin $lc
++ set end $lno
++ } else {
++ set begin $lno
++ set end $lc
++ }
++
++ foreach path [lrange $file_lists($w) \
++ [expr {$begin - 1}] \
++ [expr {$end - 1}]] {
++ set selected_paths($path) 1
++ }
++ $w tag add in_sel $begin.0 [expr {$end + 1}].0
++}
++
++proc show_more_context {} {
++ global repo_config
++ if {$repo_config(gui.diffcontext) < 99} {
++ incr repo_config(gui.diffcontext)
++ reshow_diff
++ }
++}
++
++proc show_less_context {} {
++ global repo_config
++ if {$repo_config(gui.diffcontext) > 1} {
++ incr repo_config(gui.diffcontext) -1
++ reshow_diff
++ }
++}
++
++######################################################################
++##
++## ui construction
++
++load_config 0
++apply_config
++set ui_comm {}
++
++# -- Menu Bar
++#
++menu .mbar -tearoff 0
++.mbar add cascade -label [mc Repository] -menu .mbar.repository
++.mbar add cascade -label [mc Edit] -menu .mbar.edit
++if {[is_enabled branch]} {
++ .mbar add cascade -label [mc Branch] -menu .mbar.branch
++}
++if {[is_enabled multicommit] || [is_enabled singlecommit]} {
++ .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
++}
++if {[is_enabled transport]} {
++ .mbar add cascade -label [mc Merge] -menu .mbar.merge
++ .mbar add cascade -label [mc Remote] -menu .mbar.remote
++}
++. configure -menu .mbar
++
++# -- Repository Menu
++#
++menu .mbar.repository
++
++.mbar.repository add command \
++ -label [mc "Browse Current Branch's Files"] \
++ -command {browser::new $current_branch}
++set ui_browse_current [.mbar.repository index last]
++.mbar.repository add command \
++ -label [mc "Browse Branch Files..."] \
++ -command browser_open::dialog
++.mbar.repository add separator
++
++.mbar.repository add command \
++ -label [mc "Visualize Current Branch's History"] \
++ -command {do_gitk $current_branch}
++set ui_visualize_current [.mbar.repository index last]
++.mbar.repository add command \
++ -label [mc "Visualize All Branch History"] \
++ -command {do_gitk --all}
++.mbar.repository add separator
++
++proc current_branch_write {args} {
++ global current_branch
++ .mbar.repository entryconf $::ui_browse_current \
++ -label [mc "Browse %s's Files" $current_branch]
++ .mbar.repository entryconf $::ui_visualize_current \
++ -label [mc "Visualize %s's History" $current_branch]
++}
++trace add variable current_branch write current_branch_write
++
++if {[is_enabled multicommit]} {
++ .mbar.repository add command -label [mc "Database Statistics"] \
++ -command do_stats
++
++ .mbar.repository add command -label [mc "Compress Database"] \
++ -command do_gc
++
++ .mbar.repository add command -label [mc "Verify Database"] \
++ -command do_fsck_objects
++
++ .mbar.repository add separator
++
++ if {[is_Cygwin]} {
++ .mbar.repository add command \
++ -label [mc "Create Desktop Icon"] \
++ -command do_cygwin_shortcut
++ } elseif {[is_Windows]} {
++ .mbar.repository add command \
++ -label [mc "Create Desktop Icon"] \
++ -command do_windows_shortcut
++ } elseif {[is_MacOSX]} {
++ .mbar.repository add command \
++ -label [mc "Create Desktop Icon"] \
++ -command do_macosx_app
++ }
++}
++
++if {[is_MacOSX]} {
++ proc ::tk::mac::Quit {args} { do_quit }
++} else {
++ .mbar.repository add command -label [mc Quit] \
++ -command do_quit \
++ -accelerator $M1T-Q
++}
++
++# -- Edit Menu
++#
++menu .mbar.edit
++.mbar.edit add command -label [mc Undo] \
++ -command {catch {[focus] edit undo}} \
++ -accelerator $M1T-Z
++.mbar.edit add command -label [mc Redo] \
++ -command {catch {[focus] edit redo}} \
++ -accelerator $M1T-Y
++.mbar.edit add separator
++.mbar.edit add command -label [mc Cut] \
++ -command {catch {tk_textCut [focus]}} \
++ -accelerator $M1T-X
++.mbar.edit add command -label [mc Copy] \
++ -command {catch {tk_textCopy [focus]}} \
++ -accelerator $M1T-C
++.mbar.edit add command -label [mc Paste] \
++ -command {catch {tk_textPaste [focus]; [focus] see insert}} \
++ -accelerator $M1T-V
++.mbar.edit add command -label [mc Delete] \
++ -command {catch {[focus] delete sel.first sel.last}} \
++ -accelerator Del
++.mbar.edit add separator
++.mbar.edit add command -label [mc "Select All"] \
++ -command {catch {[focus] tag add sel 0.0 end}} \
++ -accelerator $M1T-A
++
++# -- Branch Menu
++#
++if {[is_enabled branch]} {
++ menu .mbar.branch
++
++ .mbar.branch add command -label [mc "Create..."] \
++ -command branch_create::dialog \
++ -accelerator $M1T-N
++ lappend disable_on_lock [list .mbar.branch entryconf \
++ [.mbar.branch index last] -state]
++
++ .mbar.branch add command -label [mc "Checkout..."] \
++ -command branch_checkout::dialog \
++ -accelerator $M1T-O
++ lappend disable_on_lock [list .mbar.branch entryconf \
++ [.mbar.branch index last] -state]
++
++ .mbar.branch add command -label [mc "Rename..."] \
++ -command branch_rename::dialog
++ lappend disable_on_lock [list .mbar.branch entryconf \
++ [.mbar.branch index last] -state]
++
++ .mbar.branch add command -label [mc "Delete..."] \
++ -command branch_delete::dialog
++ lappend disable_on_lock [list .mbar.branch entryconf \
++ [.mbar.branch index last] -state]
++
++ .mbar.branch add command -label [mc "Reset..."] \
++ -command merge::reset_hard
++ lappend disable_on_lock [list .mbar.branch entryconf \
++ [.mbar.branch index last] -state]
++}
++
++# -- Commit Menu
++#
++if {[is_enabled multicommit] || [is_enabled singlecommit]} {
++ menu .mbar.commit
++
++ .mbar.commit add radiobutton \
++ -label [mc "New Commit"] \
++ -command do_select_commit_type \
++ -variable selected_commit_type \
++ -value new
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add radiobutton \
++ -label [mc "Amend Last Commit"] \
++ -command do_select_commit_type \
++ -variable selected_commit_type \
++ -value amend
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add separator
++
++ .mbar.commit add command -label [mc Rescan] \
- set subcommand_args {rev? path}
+++ -command ui_do_rescan \
++ -accelerator F5
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add command -label [mc "Stage To Commit"] \
++ -command do_add_selection \
++ -accelerator $M1T-T
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
++ -command do_add_all \
++ -accelerator $M1T-I
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add command -label [mc "Unstage From Commit"] \
++ -command do_unstage_selection
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add command -label [mc "Revert Changes"] \
++ -command do_revert_selection
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++
++ .mbar.commit add separator
++
++ .mbar.commit add command -label [mc "Show Less Context"] \
++ -command show_less_context \
++ -accelerator $M1T-\-
++
++ .mbar.commit add command -label [mc "Show More Context"] \
++ -command show_more_context \
++ -accelerator $M1T-=
++
++ .mbar.commit add separator
++
++ .mbar.commit add command -label [mc "Sign Off"] \
++ -command do_signoff \
++ -accelerator $M1T-S
++
++ .mbar.commit add command -label [mc Commit@@verb] \
++ -command do_commit \
++ -accelerator $M1T-Return
++ lappend disable_on_lock \
++ [list .mbar.commit entryconf [.mbar.commit index last] -state]
++}
++
++# -- Merge Menu
++#
++if {[is_enabled branch]} {
++ menu .mbar.merge
++ .mbar.merge add command -label [mc "Local Merge..."] \
++ -command merge::dialog \
++ -accelerator $M1T-M
++ lappend disable_on_lock \
++ [list .mbar.merge entryconf [.mbar.merge index last] -state]
++ .mbar.merge add command -label [mc "Abort Merge..."] \
++ -command merge::reset_hard
++ lappend disable_on_lock \
++ [list .mbar.merge entryconf [.mbar.merge index last] -state]
++}
++
++# -- Transport Menu
++#
++if {[is_enabled transport]} {
++ menu .mbar.remote
++
++ .mbar.remote add command \
++ -label [mc "Push..."] \
++ -command do_push_anywhere \
++ -accelerator $M1T-P
++ .mbar.remote add command \
++ -label [mc "Delete..."] \
++ -command remote_branch_delete::dialog
++}
++
++if {[is_MacOSX]} {
++ # -- Apple Menu (Mac OS X only)
++ #
++ .mbar add cascade -label Apple -menu .mbar.apple
++ menu .mbar.apple
++
++ .mbar.apple add command -label [mc "About %s" [appname]] \
++ -command do_about
++ .mbar.apple add separator
++ .mbar.apple add command \
++ -label [mc "Preferences..."] \
++ -command do_options \
++ -accelerator $M1T-,
++ bind . <$M1B-,> do_options
++} else {
++ # -- Edit Menu
++ #
++ .mbar.edit add separator
++ .mbar.edit add command -label [mc "Options..."] \
++ -command do_options
++}
++
++# -- Help Menu
++#
++.mbar add cascade -label [mc Help] -menu .mbar.help
++menu .mbar.help
++
++if {![is_MacOSX]} {
++ .mbar.help add command -label [mc "About %s" [appname]] \
++ -command do_about
++}
++
++set browser {}
++catch {set browser $repo_config(instaweb.browser)}
++set doc_path [file dirname [gitexec]]
++set doc_path [file join $doc_path Documentation index.html]
++
++if {[is_Cygwin]} {
++ set doc_path [exec cygpath --mixed $doc_path]
++}
++
++if {$browser eq {}} {
++ if {[is_MacOSX]} {
++ set browser open
++ } elseif {[is_Cygwin]} {
++ set program_files [file dirname [exec cygpath --windir]]
++ set program_files [file join $program_files {Program Files}]
++ set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
++ set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
++ if {[file exists $firefox]} {
++ set browser $firefox
++ } elseif {[file exists $ie]} {
++ set browser $ie
++ }
++ unset program_files firefox ie
++ }
++}
++
++if {[file isfile $doc_path]} {
++ set doc_url "file:$doc_path"
++} else {
++ set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
++}
++
++if {$browser ne {}} {
++ .mbar.help add command -label [mc "Online Documentation"] \
++ -command [list exec $browser $doc_url &]
++}
++unset browser doc_path doc_url
++
++# -- Standard bindings
++#
++wm protocol . WM_DELETE_WINDOW do_quit
++bind all <$M1B-Key-q> do_quit
++bind all <$M1B-Key-Q> do_quit
++bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
++bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
++
++set subcommand_args {}
++proc usage {} {
++ puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
++ exit 1
++}
++
++# -- Not a normal commit type invocation? Do that instead!
++#
++switch -- $subcommand {
++browser -
++blame {
- blame::new $head $path
+++ if {$subcommand eq "blame"} {
+++ set subcommand_args {[--line=<num>] rev? path}
+++ } else {
+++ set subcommand_args {rev? path}
+++ }
++ if {$argv eq {}} usage
++ set head {}
++ set path {}
+++ set jump_spec {}
++ set is_path 0
++ foreach a $argv {
++ if {$is_path || [file exists $_prefix$a]} {
++ if {$path ne {}} usage
++ set path $_prefix$a
++ break
++ } elseif {$a eq {--}} {
++ if {$path ne {}} {
++ if {$head ne {}} usage
++ set head $path
++ set path {}
++ }
++ set is_path 1
+++ } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
+++ if {$jump_spec ne {} || $head ne {}} usage
+++ set jump_spec [list $lnum]
++ } elseif {$head eq {}} {
++ if {$head ne {}} usage
++ set head $a
++ set is_path 1
++ } else {
++ usage
++ }
++ }
++ unset is_path
++
++ if {$head ne {} && $path eq {}} {
++ set path $_prefix$head
++ set head {}
++ }
++
++ if {$head eq {}} {
++ load_current_branch
++ } else {
++ if {[regexp {^[0-9a-f]{1,39}$} $head]} {
++ if {[catch {
++ set head [git rev-parse --verify $head]
++ } err]} {
++ puts stderr $err
++ exit 1
++ }
++ }
++ set current_branch $head
++ }
++
++ switch -- $subcommand {
++ browser {
+++ if {$jump_spec ne {}} usage
++ if {$head eq {}} {
++ if {$path ne {} && [file isdirectory $path]} {
++ set head $current_branch
++ } else {
++ set head $path
++ set path {}
++ }
++ }
++ browser::new $head $path
++ }
++ blame {
++ if {$head eq {} && ![file exists $path]} {
++ puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
++ exit 1
++ }
- -command do_rescan
+++ blame::new $head $path $jump_spec
++ }
++ }
++ return
++}
++citool -
++gui {
++ if {[llength $argv] != 0} {
++ puts -nonewline stderr "usage: $argv0"
++ if {$subcommand ne {gui}
++ && [file tail $argv0] ne "git-$subcommand"} {
++ puts -nonewline stderr " $subcommand"
++ }
++ puts stderr {}
++ exit 1
++ }
++ # fall through to setup UI for commits
++}
++default {
++ puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
++ exit 1
++}
++}
++
++# -- Branch Control
++#
++frame .branch \
++ -borderwidth 1 \
++ -relief sunken
++label .branch.l1 \
++ -text [mc "Current Branch:"] \
++ -anchor w \
++ -justify left
++label .branch.cb \
++ -textvariable current_branch \
++ -anchor w \
++ -justify left
++pack .branch.l1 -side left
++pack .branch.cb -side left -fill x
++pack .branch -side top -fill x
++
++# -- Main Window Layout
++#
++panedwindow .vpane -orient horizontal
++panedwindow .vpane.files -orient vertical
++.vpane add .vpane.files -sticky nsew -height 100 -width 200
++pack .vpane -anchor n -side top -fill both -expand 1
++
++# -- Index File List
++#
++frame .vpane.files.index -height 100 -width 200
++label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
++ -background lightgreen -foreground black
++text $ui_index -background white -foreground black \
++ -borderwidth 0 \
++ -width 20 -height 10 \
++ -wrap none \
++ -cursor $cursor_ptr \
++ -xscrollcommand {.vpane.files.index.sx set} \
++ -yscrollcommand {.vpane.files.index.sy set} \
++ -state disabled
++scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
++scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
++pack .vpane.files.index.title -side top -fill x
++pack .vpane.files.index.sx -side bottom -fill x
++pack .vpane.files.index.sy -side right -fill y
++pack $ui_index -side left -fill both -expand 1
++
++# -- Working Directory File List
++#
++frame .vpane.files.workdir -height 100 -width 200
++label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
++ -background lightsalmon -foreground black
++text $ui_workdir -background white -foreground black \
++ -borderwidth 0 \
++ -width 20 -height 10 \
++ -wrap none \
++ -cursor $cursor_ptr \
++ -xscrollcommand {.vpane.files.workdir.sx set} \
++ -yscrollcommand {.vpane.files.workdir.sy set} \
++ -state disabled
++scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
++scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
++pack .vpane.files.workdir.title -side top -fill x
++pack .vpane.files.workdir.sx -side bottom -fill x
++pack .vpane.files.workdir.sy -side right -fill y
++pack $ui_workdir -side left -fill both -expand 1
++
++.vpane.files add .vpane.files.workdir -sticky nsew
++.vpane.files add .vpane.files.index -sticky nsew
++
++foreach i [list $ui_index $ui_workdir] {
++ rmsel_tag $i
++ $i tag conf in_diff -background [$i tag cget in_sel -background]
++}
++unset i
++
++# -- Diff and Commit Area
++#
++frame .vpane.lower -height 300 -width 400
++frame .vpane.lower.commarea
++frame .vpane.lower.diff -relief sunken -borderwidth 1
++pack .vpane.lower.diff -fill both -expand 1
++pack .vpane.lower.commarea -side bottom -fill x
++.vpane add .vpane.lower -sticky nsew
++
++# -- Commit Area Buttons
++#
++frame .vpane.lower.commarea.buttons
++label .vpane.lower.commarea.buttons.l -text {} \
++ -anchor w \
++ -justify left
++pack .vpane.lower.commarea.buttons.l -side top -fill x
++pack .vpane.lower.commarea.buttons -side left -fill y
++
++button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
- $ctxm add command \
- -label [mc "Show Less Context"] \
- -command show_less_context
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add command \
- -label [mc "Show More Context"] \
- -command show_more_context
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add separator
- $ctxm add command \
- -label [mc Refresh] \
- -command reshow_diff
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add command \
- -label [mc Copy] \
- -command {tk_textCopy $ui_diff}
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add command \
- -label [mc "Select All"] \
- -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add command \
- -label [mc "Copy All"] \
- -command {
- $ui_diff tag add sel 0.0 end
- tk_textCopy $ui_diff
- $ui_diff tag remove sel 0.0 end
- }
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add separator
- $ctxm add command \
- -label [mc "Decrease Font Size"] \
- -command {incr_font_size font_diff -1}
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add command \
- -label [mc "Increase Font Size"] \
- -command {incr_font_size font_diff 1}
- lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
- $ctxm add separator
- $ctxm add command -label [mc "Options..."] \
- -command do_options
- proc popup_diff_menu {ctxm x y X Y} {
+++ -command ui_do_rescan
++pack .vpane.lower.commarea.buttons.rescan -side top -fill x
++lappend disable_on_lock \
++ {.vpane.lower.commarea.buttons.rescan conf -state}
++
++button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
++ -command do_add_all
++pack .vpane.lower.commarea.buttons.incall -side top -fill x
++lappend disable_on_lock \
++ {.vpane.lower.commarea.buttons.incall conf -state}
++
++button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
++ -command do_signoff
++pack .vpane.lower.commarea.buttons.signoff -side top -fill x
++
++button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
++ -command do_commit
++pack .vpane.lower.commarea.buttons.commit -side top -fill x
++lappend disable_on_lock \
++ {.vpane.lower.commarea.buttons.commit conf -state}
++
++button .vpane.lower.commarea.buttons.push -text [mc Push] \
++ -command do_push_anywhere
++pack .vpane.lower.commarea.buttons.push -side top -fill x
++
++# -- Commit Message Buffer
++#
++frame .vpane.lower.commarea.buffer
++frame .vpane.lower.commarea.buffer.header
++set ui_comm .vpane.lower.commarea.buffer.t
++set ui_coml .vpane.lower.commarea.buffer.header.l
++radiobutton .vpane.lower.commarea.buffer.header.new \
++ -text [mc "New Commit"] \
++ -command do_select_commit_type \
++ -variable selected_commit_type \
++ -value new
++lappend disable_on_lock \
++ [list .vpane.lower.commarea.buffer.header.new conf -state]
++radiobutton .vpane.lower.commarea.buffer.header.amend \
++ -text [mc "Amend Last Commit"] \
++ -command do_select_commit_type \
++ -variable selected_commit_type \
++ -value amend
++lappend disable_on_lock \
++ [list .vpane.lower.commarea.buffer.header.amend conf -state]
++label $ui_coml \
++ -anchor w \
++ -justify left
++proc trace_commit_type {varname args} {
++ global ui_coml commit_type
++ switch -glob -- $commit_type {
++ initial {set txt [mc "Initial Commit Message:"]}
++ amend {set txt [mc "Amended Commit Message:"]}
++ amend-initial {set txt [mc "Amended Initial Commit Message:"]}
++ amend-merge {set txt [mc "Amended Merge Commit Message:"]}
++ merge {set txt [mc "Merge Commit Message:"]}
++ * {set txt [mc "Commit Message:"]}
++ }
++ $ui_coml conf -text $txt
++}
++trace add variable commit_type write trace_commit_type
++pack $ui_coml -side left -fill x
++pack .vpane.lower.commarea.buffer.header.amend -side right
++pack .vpane.lower.commarea.buffer.header.new -side right
++
++text $ui_comm -background white -foreground black \
++ -borderwidth 1 \
++ -undo true \
++ -maxundo 20 \
++ -autoseparators true \
++ -relief sunken \
++ -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
++ -font font_diff \
++ -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
++scrollbar .vpane.lower.commarea.buffer.sby \
++ -command [list $ui_comm yview]
++pack .vpane.lower.commarea.buffer.header -side top -fill x
++pack .vpane.lower.commarea.buffer.sby -side right -fill y
++pack $ui_comm -side left -fill y
++pack .vpane.lower.commarea.buffer -side left -fill y
++
++# -- Commit Message Buffer Context Menu
++#
++set ctxm .vpane.lower.commarea.buffer.ctxm
++menu $ctxm -tearoff 0
++$ctxm add command \
++ -label [mc Cut] \
++ -command {tk_textCut $ui_comm}
++$ctxm add command \
++ -label [mc Copy] \
++ -command {tk_textCopy $ui_comm}
++$ctxm add command \
++ -label [mc Paste] \
++ -command {tk_textPaste $ui_comm}
++$ctxm add command \
++ -label [mc Delete] \
++ -command {$ui_comm delete sel.first sel.last}
++$ctxm add separator
++$ctxm add command \
++ -label [mc "Select All"] \
++ -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
++$ctxm add command \
++ -label [mc "Copy All"] \
++ -command {
++ $ui_comm tag add sel 0.0 end
++ tk_textCopy $ui_comm
++ $ui_comm tag remove sel 0.0 end
++ }
++$ctxm add separator
++$ctxm add command \
++ -label [mc "Sign Off"] \
++ -command do_signoff
++set ui_comm_ctxm $ctxm
++
++# -- Diff Header
++#
++proc trace_current_diff_path {varname args} {
++ global current_diff_path diff_actions file_states
++ if {$current_diff_path eq {}} {
++ set s {}
++ set f {}
++ set p {}
++ set o disabled
++ } else {
++ set p $current_diff_path
++ set s [mapdesc [lindex $file_states($p) 0] $p]
++ set f [mc "File:"]
++ set p [escape_path $p]
++ set o normal
++ }
++
++ .vpane.lower.diff.header.status configure -text $s
++ .vpane.lower.diff.header.file configure -text $f
++ .vpane.lower.diff.header.path configure -text $p
++ foreach w $diff_actions {
++ uplevel #0 $w $o
++ }
++}
++trace add variable current_diff_path write trace_current_diff_path
++
++frame .vpane.lower.diff.header -background gold
++label .vpane.lower.diff.header.status \
++ -background gold \
++ -foreground black \
++ -width $max_status_desc \
++ -anchor w \
++ -justify left
++label .vpane.lower.diff.header.file \
++ -background gold \
++ -foreground black \
++ -anchor w \
++ -justify left
++label .vpane.lower.diff.header.path \
++ -background gold \
++ -foreground black \
++ -anchor w \
++ -justify left
++pack .vpane.lower.diff.header.status -side left
++pack .vpane.lower.diff.header.file -side left
++pack .vpane.lower.diff.header.path -fill x
++set ctxm .vpane.lower.diff.header.ctxm
++menu $ctxm -tearoff 0
++$ctxm add command \
++ -label [mc Copy] \
++ -command {
++ clipboard clear
++ clipboard append \
++ -format STRING \
++ -type STRING \
++ -- $current_diff_path
++ }
++lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
++bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
++
++# -- Diff Body
++#
++frame .vpane.lower.diff.body
++set ui_diff .vpane.lower.diff.body.t
++text $ui_diff -background white -foreground black \
++ -borderwidth 0 \
++ -width 80 -height 15 -wrap none \
++ -font font_diff \
++ -xscrollcommand {.vpane.lower.diff.body.sbx set} \
++ -yscrollcommand {.vpane.lower.diff.body.sby set} \
++ -state disabled
++scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
++ -command [list $ui_diff xview]
++scrollbar .vpane.lower.diff.body.sby -orient vertical \
++ -command [list $ui_diff yview]
++pack .vpane.lower.diff.body.sbx -side bottom -fill x
++pack .vpane.lower.diff.body.sby -side right -fill y
++pack $ui_diff -side left -fill both -expand 1
++pack .vpane.lower.diff.header -side top -fill x
++pack .vpane.lower.diff.body -side bottom -fill both -expand 1
++
++$ui_diff tag conf d_cr -elide true
++$ui_diff tag conf d_@ -foreground blue -font font_diffbold
++$ui_diff tag conf d_+ -foreground {#00a000}
++$ui_diff tag conf d_- -foreground red
++
++$ui_diff tag conf d_++ -foreground {#00a000}
++$ui_diff tag conf d_-- -foreground red
++$ui_diff tag conf d_+s \
++ -foreground {#00a000} \
++ -background {#e2effa}
++$ui_diff tag conf d_-s \
++ -foreground red \
++ -background {#e2effa}
++$ui_diff tag conf d_s+ \
++ -foreground {#00a000} \
++ -background ivory1
++$ui_diff tag conf d_s- \
++ -foreground red \
++ -background ivory1
++
++$ui_diff tag conf d<<<<<<< \
++ -foreground orange \
++ -font font_diffbold
++$ui_diff tag conf d======= \
++ -foreground orange \
++ -font font_diffbold
++$ui_diff tag conf d>>>>>>> \
++ -foreground orange \
++ -font font_diffbold
++
++$ui_diff tag raise sel
++
++# -- Diff Body Context Menu
++#
+++
+++proc create_common_diff_popup {ctxm} {
+++ $ctxm add command \
+++ -label [mc "Show Less Context"] \
+++ -command show_less_context
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add command \
+++ -label [mc "Show More Context"] \
+++ -command show_more_context
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add separator
+++ $ctxm add command \
+++ -label [mc Refresh] \
+++ -command reshow_diff
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add command \
+++ -label [mc Copy] \
+++ -command {tk_textCopy $ui_diff}
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add command \
+++ -label [mc "Select All"] \
+++ -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add command \
+++ -label [mc "Copy All"] \
+++ -command {
+++ $ui_diff tag add sel 0.0 end
+++ tk_textCopy $ui_diff
+++ $ui_diff tag remove sel 0.0 end
+++ }
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add separator
+++ $ctxm add command \
+++ -label [mc "Decrease Font Size"] \
+++ -command {incr_font_size font_diff -1}
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add command \
+++ -label [mc "Increase Font Size"] \
+++ -command {incr_font_size font_diff 1}
+++ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
+++ $ctxm add separator
+++ $ctxm add command -label [mc "Options..."] \
+++ -command do_options
+++}
+++
++set ctxm .vpane.lower.diff.body.ctxm
++menu $ctxm -tearoff 0
++$ctxm add command \
++ -label [mc "Apply/Reverse Hunk"] \
++ -command {apply_hunk $cursorX $cursorY}
++set ui_diff_applyhunk [$ctxm index last]
++lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
++$ctxm add command \
++ -label [mc "Apply/Reverse Line"] \
++ -command {apply_line $cursorX $cursorY; do_rescan}
++set ui_diff_applyline [$ctxm index last]
++lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
++$ctxm add separator
- if {$::ui_index eq $::current_diff_side} {
- set l [mc "Unstage Hunk From Commit"]
- set t [mc "Unstage Line From Commit"]
+++create_common_diff_popup $ctxm
+++
+++set ctxmmg .vpane.lower.diff.body.ctxmmg
+++menu $ctxmmg -tearoff 0
+++$ctxmmg add command \
+++ -label [mc "Run Merge Tool"] \
+++ -command {merge_resolve_tool}
+++lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
+++$ctxmmg add separator
+++$ctxmmg add command \
+++ -label [mc "Use Remote Version"] \
+++ -command {merge_resolve_one 3}
+++lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
+++$ctxmmg add command \
+++ -label [mc "Use Local Version"] \
+++ -command {merge_resolve_one 2}
+++lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
+++$ctxmmg add command \
+++ -label [mc "Revert To Base"] \
+++ -command {merge_resolve_one 1}
+++lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
+++$ctxmmg add separator
+++create_common_diff_popup $ctxmmg
+++
+++proc popup_diff_menu {ctxm ctxmmg x y X Y} {
++ global current_diff_path file_states
++ set ::cursorX $x
++ set ::cursorY $y
- set l [mc "Stage Hunk For Commit"]
- set t [mc "Stage Line For Commit"]
- }
- if {$::is_3way_diff
- || $current_diff_path eq {}
- || ![info exists file_states($current_diff_path)]
- || {_O} eq [lindex $file_states($current_diff_path) 0]} {
- set s disabled
+++ if {[info exists file_states($current_diff_path)]} {
+++ set state [lindex $file_states($current_diff_path) 0]
++ } else {
- set s normal
+++ set state {__}
+++ }
+++ if {[string first {U} $state] >= 0} {
+++ tk_popup $ctxmmg $X $Y
++ } else {
- $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
- $ctxm entryconf $::ui_diff_applyline -state $s -label $t
- tk_popup $ctxm $X $Y
+++ if {$::ui_index eq $::current_diff_side} {
+++ set l [mc "Unstage Hunk From Commit"]
+++ set t [mc "Unstage Line From Commit"]
+++ } else {
+++ set l [mc "Stage Hunk For Commit"]
+++ set t [mc "Stage Line For Commit"]
+++ }
+++ if {$::is_3way_diff
+++ || $current_diff_path eq {}
+++ || {__} eq $state
+++ || {_O} eq $state
+++ || {_T} eq $state
+++ || {T_} eq $state} {
+++ set s disabled
+++ } else {
+++ set s normal
+++ }
+++ $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
+++ $ctxm entryconf $::ui_diff_applyline -state $s -label $t
+++ tk_popup $ctxm $X $Y
++ }
- bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
++}
- bind . <Key-F5> do_rescan
- bind . <$M1B-Key-r> do_rescan
- bind . <$M1B-Key-R> do_rescan
+++bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg %x %y %X %Y]
++
++# -- Status Bar
++#
++set main_status [::status_bar::new .status]
++pack .status -anchor w -side bottom -fill x
++$main_status show [mc "Initializing..."]
++
++# -- Load geometry
++#
++catch {
++set gm $repo_config(gui.geometry)
++wm geometry . [lindex $gm 0]
++.vpane sash place 0 \
++ [lindex $gm 1] \
++ [lindex [.vpane sash coord 0] 1]
++.vpane.files sash place 0 \
++ [lindex [.vpane.files sash coord 0] 0] \
++ [lindex $gm 2]
++unset gm
++}
++
++# -- Key Bindings
++#
++bind $ui_comm <$M1B-Key-Return> {do_commit;break}
++bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
++bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
++bind $ui_comm <$M1B-Key-i> {do_add_all;break}
++bind $ui_comm <$M1B-Key-I> {do_add_all;break}
++bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
++bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
++bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
++bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
++bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
++bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
++bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
++bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
++bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
++bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
++bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
++bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
++bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
++
++bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
++bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
++bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
++bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
++bind $ui_diff <$M1B-Key-v> {break}
++bind $ui_diff <$M1B-Key-V> {break}
++bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
++bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
++bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
++bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
++bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
++bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
++bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
++bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
++bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
++bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
++bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
++bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
++bind $ui_diff <Button-1> {focus %W}
++
++if {[is_enabled branch]} {
++ bind . <$M1B-Key-n> branch_create::dialog
++ bind . <$M1B-Key-N> branch_create::dialog
++ bind . <$M1B-Key-o> branch_checkout::dialog
++ bind . <$M1B-Key-O> branch_checkout::dialog
++ bind . <$M1B-Key-m> merge::dialog
++ bind . <$M1B-Key-M> merge::dialog
++}
++if {[is_enabled transport]} {
++ bind . <$M1B-Key-p> do_push_anywhere
++ bind . <$M1B-Key-P> do_push_anywhere
++}
++
+++bind . <Key-F5> ui_do_rescan
+++bind . <$M1B-Key-r> ui_do_rescan
+++bind . <$M1B-Key-R> ui_do_rescan
++bind . <$M1B-Key-s> do_signoff
++bind . <$M1B-Key-S> do_signoff
++bind . <$M1B-Key-t> do_add_selection
++bind . <$M1B-Key-T> do_add_selection
++bind . <$M1B-Key-i> do_add_all
++bind . <$M1B-Key-I> do_add_all
++bind . <$M1B-Key-minus> {show_less_context;break}
++bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
++bind . <$M1B-Key-equal> {show_more_context;break}
++bind . <$M1B-Key-plus> {show_more_context;break}
++bind . <$M1B-Key-KP_Add> {show_more_context;break}
++bind . <$M1B-Key-Return> do_commit
++foreach i [list $ui_index $ui_workdir] {
++ bind $i <Button-1> "toggle_or_diff $i %x %y; break"
++ bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
++ bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
++}
++unset i
++
++set file_lists($ui_index) [list]
++set file_lists($ui_workdir) [list]
++
++wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
++focus -force $ui_comm
++
++# -- Warn the user about environmental problems. Cygwin's Tcl
++# does *not* pass its env array onto any processes it spawns.
++# This means that git processes get none of our environment.
++#
++if {[is_Cygwin]} {
++ set ignored_env 0
++ set suggest_user {}
++ set msg [mc "Possible environment issues exist.
++
++The following environment variables are probably
++going to be ignored by any Git subprocess run
++by %s:
++
++" [appname]]
++ foreach name [array names env] {
++ switch -regexp -- $name {
++ {^GIT_INDEX_FILE$} -
++ {^GIT_OBJECT_DIRECTORY$} -
++ {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
++ {^GIT_DIFF_OPTS$} -
++ {^GIT_EXTERNAL_DIFF$} -
++ {^GIT_PAGER$} -
++ {^GIT_TRACE$} -
++ {^GIT_CONFIG$} -
++ {^GIT_CONFIG_LOCAL$} -
++ {^GIT_(AUTHOR|COMMITTER)_DATE$} {
++ append msg " - $name\n"
++ incr ignored_env
++ }
++ {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
++ append msg " - $name\n"
++ incr ignored_env
++ set suggest_user $name
++ }
++ }
++ }
++ if {$ignored_env > 0} {
++ append msg [mc "
++This is due to a known issue with the
++Tcl binary distributed by Cygwin."]
++
++ if {$suggest_user ne {}} {
++ append msg [mc "
++
++A good replacement for %s
++is placing values for the user.name and
++user.email settings into your personal
++~/.gitconfig file.
++" $suggest_user]
++ }
++ warn_popup $msg
++ }
++ unset ignored_env msg suggest_user name
++}
++
++# -- Only initialize complex UI if we are going to stay running.
++#
++if {[is_enabled transport]} {
++ load_all_remotes
++
++ set n [.mbar.remote index end]
++ populate_push_menu
++ populate_fetch_menu
++ set n [expr {[.mbar.remote index end] - $n}]
++ if {$n > 0} {
++ if {[.mbar.remote type 0] eq "tearoff"} { incr n }
++ .mbar.remote insert $n separator
++ }
++ unset n
++}
++
++if {[winfo exists $ui_comm]} {
++ set GITGUI_BCK_exists [load_message GITGUI_BCK]
++
++ # -- If both our backup and message files exist use the
++ # newer of the two files to initialize the buffer.
++ #
++ if {$GITGUI_BCK_exists} {
++ set m [gitdir GITGUI_MSG]
++ if {[file isfile $m]} {
++ if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
++ catch {file delete [gitdir GITGUI_MSG]}
++ } else {
++ $ui_comm delete 0.0 end
++ $ui_comm edit reset
++ $ui_comm edit modified false
++ catch {file delete [gitdir GITGUI_BCK]}
++ set GITGUI_BCK_exists 0
++ }
++ }
++ unset m
++ }
++
++ proc backup_commit_buffer {} {
++ global ui_comm GITGUI_BCK_exists
++
++ set m [$ui_comm edit modified]
++ if {$m || $GITGUI_BCK_exists} {
++ set msg [string trim [$ui_comm get 0.0 end]]
++ regsub -all -line {[ \r\t]+$} $msg {} msg
++
++ if {$msg eq {}} {
++ if {$GITGUI_BCK_exists} {
++ catch {file delete [gitdir GITGUI_BCK]}
++ set GITGUI_BCK_exists 0
++ }
++ } elseif {$m} {
++ catch {
++ set fd [open [gitdir GITGUI_BCK] w]
++ puts -nonewline $fd $msg
++ close $fd
++ set GITGUI_BCK_exists 1
++ }
++ }
++
++ $ui_comm edit modified false
++ }
++
++ set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
++ }
++
++ backup_commit_buffer
++
++ # -- If the user has aspell available we can drive it
++ # in pipe mode to spellcheck the commit message.
++ #
++ set spell_cmd [list |]
++ set spell_dict [get_config gui.spellingdictionary]
++ lappend spell_cmd aspell
++ if {$spell_dict ne {}} {
++ lappend spell_cmd --master=$spell_dict
++ }
++ lappend spell_cmd --mode=none
++ lappend spell_cmd --encoding=utf-8
++ lappend spell_cmd pipe
++ if {$spell_dict eq {none}
++ || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
++ bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
++ } else {
++ set ui_comm_spell [spellcheck::init \
++ $spell_fd \
++ $ui_comm \
++ $ui_comm_ctxm \
++ ]
++ }
++ unset -nocomplain spell_cmd spell_fd spell_err spell_dict
++}
++
++lock_index begin-read
++if {![winfo ismapped .]} {
++ wm deiconify .
++}
++after 1 do_rescan
++if {[is_enabled multicommit]} {
++ after 1000 hint_gc
++}
--- /dev/null
--- /dev/null
- global pending_select mainheadid
++#!/bin/sh
++# Tcl ignores the next line -*- tcl -*- \
++exec wish "$0" -- "$@"
++
++# Copyright © 2005-2008 Paul Mackerras. All rights reserved.
++# This program is free software; it may be used, copied, modified
++# and distributed under the terms of the GNU General Public Licence,
++# either version 2, or (at your option) any later version.
++
++proc gitdir {} {
++ global env
++ if {[info exists env(GIT_DIR)]} {
++ return $env(GIT_DIR)
++ } else {
++ return [exec git rev-parse --git-dir]
++ }
++}
++
++# A simple scheduler for compute-intensive stuff.
++# The aim is to make sure that event handlers for GUI actions can
++# run at least every 50-100 ms. Unfortunately fileevent handlers are
++# run before X event handlers, so reading from a fast source can
++# make the GUI completely unresponsive.
++proc run args {
++ global isonrunq runq currunq
++
++ set script $args
++ if {[info exists isonrunq($script)]} return
++ if {$runq eq {} && ![info exists currunq]} {
++ after idle dorunq
++ }
++ lappend runq [list {} $script]
++ set isonrunq($script) 1
++}
++
++proc filerun {fd script} {
++ fileevent $fd readable [list filereadable $fd $script]
++}
++
++proc filereadable {fd script} {
++ global runq currunq
++
++ fileevent $fd readable {}
++ if {$runq eq {} && ![info exists currunq]} {
++ after idle dorunq
++ }
++ lappend runq [list $fd $script]
++}
++
++proc nukefile {fd} {
++ global runq
++
++ for {set i 0} {$i < [llength $runq]} {} {
++ if {[lindex $runq $i 0] eq $fd} {
++ set runq [lreplace $runq $i $i]
++ } else {
++ incr i
++ }
++ }
++}
++
++proc dorunq {} {
++ global isonrunq runq currunq
++
++ set tstart [clock clicks -milliseconds]
++ set t0 $tstart
++ while {[llength $runq] > 0} {
++ set fd [lindex $runq 0 0]
++ set script [lindex $runq 0 1]
++ set currunq [lindex $runq 0]
++ set runq [lrange $runq 1 end]
++ set repeat [eval $script]
++ unset currunq
++ set t1 [clock clicks -milliseconds]
++ set t [expr {$t1 - $t0}]
++ if {$repeat ne {} && $repeat} {
++ if {$fd eq {} || $repeat == 2} {
++ # script returns 1 if it wants to be readded
++ # file readers return 2 if they could do more straight away
++ lappend runq [list $fd $script]
++ } else {
++ fileevent $fd readable [list filereadable $fd $script]
++ }
++ } elseif {$fd eq {}} {
++ unset isonrunq($script)
++ }
++ set t0 $t1
++ if {$t1 - $tstart >= 80} break
++ }
++ if {$runq ne {}} {
++ after idle dorunq
++ }
++}
++
++proc reg_instance {fd} {
++ global commfd leftover loginstance
++
++ set i [incr loginstance]
++ set commfd($i) $fd
++ set leftover($i) {}
++ return $i
++}
++
++proc unmerged_files {files} {
++ global nr_unmerged
++
++ # find the list of unmerged files
++ set mlist {}
++ set nr_unmerged 0
++ if {[catch {
++ set fd [open "| git ls-files -u" r]
++ } err]} {
++ show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
++ exit 1
++ }
++ while {[gets $fd line] >= 0} {
++ set i [string first "\t" $line]
++ if {$i < 0} continue
++ set fname [string range $line [expr {$i+1}] end]
++ if {[lsearch -exact $mlist $fname] >= 0} continue
++ incr nr_unmerged
++ if {$files eq {} || [path_filter $files $fname]} {
++ lappend mlist $fname
++ }
++ }
++ catch {close $fd}
++ return $mlist
++}
++
++proc parseviewargs {n arglist} {
++ global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
++
++ set vdatemode($n) 0
++ set vmergeonly($n) 0
++ set glflags {}
++ set diffargs {}
++ set nextisval 0
++ set revargs {}
++ set origargs $arglist
++ set allknown 1
++ set filtered 0
++ set i -1
++ foreach arg $arglist {
++ incr i
++ if {$nextisval} {
++ lappend glflags $arg
++ set nextisval 0
++ continue
++ }
++ switch -glob -- $arg {
++ "-d" -
++ "--date-order" {
++ set vdatemode($n) 1
++ # remove from origargs in case we hit an unknown option
++ set origargs [lreplace $origargs $i $i]
++ incr i -1
++ }
++ # These request or affect diff output, which we don't want.
++ # Some could be used to set our defaults for diff display.
++ "-[puabwcrRBMC]" -
++ "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
++ "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
++ "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
++ "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
++ "--ignore-space-change" - "-U*" - "--unified=*" {
++ lappend diffargs $arg
++ }
++ # These cause our parsing of git log's output to fail, or else
++ # they're options we want to set ourselves, so ignore them.
++ "--raw" - "--patch-with-raw" - "--patch-with-stat" -
++ "--name-only" - "--name-status" - "--color" - "--color-words" -
++ "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
++ "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
++ "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
++ "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
++ "--objects" - "--objects-edge" - "--reverse" {
++ }
++ # These are harmless, and some are even useful
++ "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
++ "--check" - "--exit-code" - "--quiet" - "--topo-order" -
++ "--full-history" - "--dense" - "--sparse" -
++ "--follow" - "--left-right" - "--encoding=*" {
++ lappend glflags $arg
++ }
++ # These mean that we get a subset of the commits
++ "--diff-filter=*" - "--no-merges" - "--unpacked" -
++ "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
++ "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
++ "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
++ "--remove-empty" - "--first-parent" - "--cherry-pick" -
++ "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
++ set filtered 1
++ lappend glflags $arg
++ }
++ # This appears to be the only one that has a value as a
++ # separate word following it
++ "-n" {
++ set filtered 1
++ set nextisval 1
++ lappend glflags $arg
++ }
++ "--not" {
++ set notflag [expr {!$notflag}]
++ lappend revargs $arg
++ }
++ "--all" {
++ lappend revargs $arg
++ }
++ "--merge" {
++ set vmergeonly($n) 1
++ # git rev-parse doesn't understand --merge
++ lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
++ }
++ # Other flag arguments including -<n>
++ "-*" {
++ if {[string is digit -strict [string range $arg 1 end]]} {
++ set filtered 1
++ } else {
++ # a flag argument that we don't recognize;
++ # that means we can't optimize
++ set allknown 0
++ }
++ lappend glflags $arg
++ }
++ # Non-flag arguments specify commits or ranges of commits
++ default {
++ if {[string match "*...*" $arg]} {
++ lappend revargs --gitk-symmetric-diff-marker
++ }
++ lappend revargs $arg
++ }
++ }
++ }
++ set vdflags($n) $diffargs
++ set vflags($n) $glflags
++ set vrevs($n) $revargs
++ set vfiltered($n) $filtered
++ set vorigargs($n) $origargs
++ return $allknown
++}
++
++proc parseviewrevs {view revs} {
++ global vposids vnegids
++
++ if {$revs eq {}} {
++ set revs HEAD
++ }
++ if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
++ # we get stdout followed by stderr in $err
++ # for an unknown rev, git rev-parse echoes it and then errors out
++ set errlines [split $err "\n"]
++ set badrev {}
++ for {set l 0} {$l < [llength $errlines]} {incr l} {
++ set line [lindex $errlines $l]
++ if {!([string length $line] == 40 && [string is xdigit $line])} {
++ if {[string match "fatal:*" $line]} {
++ if {[string match "fatal: ambiguous argument*" $line]
++ && $badrev ne {}} {
++ if {[llength $badrev] == 1} {
++ set err "unknown revision $badrev"
++ } else {
++ set err "unknown revisions: [join $badrev ", "]"
++ }
++ } else {
++ set err [join [lrange $errlines $l end] "\n"]
++ }
++ break
++ }
++ lappend badrev $line
++ }
++ }
++ error_popup "Error parsing revisions: $err"
++ return {}
++ }
++ set ret {}
++ set pos {}
++ set neg {}
++ set sdm 0
++ foreach id [split $ids "\n"] {
++ if {$id eq "--gitk-symmetric-diff-marker"} {
++ set sdm 4
++ } elseif {[string match "^*" $id]} {
++ if {$sdm != 1} {
++ lappend ret $id
++ if {$sdm == 3} {
++ set sdm 0
++ }
++ }
++ lappend neg [string range $id 1 end]
++ } else {
++ if {$sdm != 2} {
++ lappend ret $id
++ } else {
++ lset ret end [lindex $ret end]...$id
++ }
++ lappend pos $id
++ }
++ incr sdm -1
++ }
++ set vposids($view) $pos
++ set vnegids($view) $neg
++ return $ret
++}
++
++# Start off a git log process and arrange to read its output
++proc start_rev_list {view} {
++ global startmsecs commitidx viewcomplete curview
++ global tclencoding
++ global viewargs viewargscmd viewfiles vfilelimit
++ global showlocalchanges commitinterest
++ global viewactive viewinstances vmergeonly
++ global mainheadid
++ global vcanopt vflags vrevs vorigargs
++
++ set startmsecs [clock clicks -milliseconds]
++ set commitidx($view) 0
++ # these are set this way for the error exits
++ set viewcomplete($view) 1
++ set viewactive($view) 0
++ varcinit $view
++
++ set args $viewargs($view)
++ if {$viewargscmd($view) ne {}} {
++ if {[catch {
++ set str [exec sh -c $viewargscmd($view)]
++ } err]} {
++ error_popup "Error executing --argscmd command: $err"
++ return 0
++ }
++ set args [concat $args [split $str "\n"]]
++ }
++ set vcanopt($view) [parseviewargs $view $args]
++
++ set files $viewfiles($view)
++ if {$vmergeonly($view)} {
++ set files [unmerged_files $files]
++ if {$files eq {}} {
++ global nr_unmerged
++ if {$nr_unmerged == 0} {
++ error_popup [mc "No files selected: --merge specified but\
++ no files are unmerged."]
++ } else {
++ error_popup [mc "No files selected: --merge specified but\
++ no unmerged files are within file limit."]
++ }
++ return 0
++ }
++ }
++ set vfilelimit($view) $files
++
++ if {$vcanopt($view)} {
++ set revs [parseviewrevs $view $vrevs($view)]
++ if {$revs eq {}} {
++ return 0
++ }
++ set args [concat $vflags($view) $revs]
++ } else {
++ set args $vorigargs($view)
++ }
++
++ if {[catch {
++ set fd [open [concat | git log --no-color -z --pretty=raw --parents \
++ --boundary $args "--" $files] r]
++ } err]} {
++ error_popup "[mc "Error executing git log:"] $err"
++ return 0
++ }
++ set i [reg_instance $fd]
++ set viewinstances($view) [list $i]
++ if {$showlocalchanges && $mainheadid ne {}} {
++ lappend commitinterest($mainheadid) {dodiffindex}
++ }
++ fconfigure $fd -blocking 0 -translation lf -eofchar {}
++ if {$tclencoding != {}} {
++ fconfigure $fd -encoding $tclencoding
++ }
++ filerun $fd [list getcommitlines $fd $i $view 0]
++ nowbusy $view [mc "Reading"]
++ set viewcomplete($view) 0
++ set viewactive($view) 1
++ return 1
++}
++
++proc stop_instance {inst} {
++ global commfd leftover
++
++ set fd $commfd($inst)
++ catch {
++ set pid [pid $fd]
++
++ if {$::tcl_platform(platform) eq {windows}} {
++ exec kill -f $pid
++ } else {
++ exec kill $pid
++ }
++ }
++ catch {close $fd}
++ nukefile $fd
++ unset commfd($inst)
++ unset leftover($inst)
++}
++
++proc stop_backends {} {
++ global commfd
++
++ foreach inst [array names commfd] {
++ stop_instance $inst
++ }
++}
++
++proc stop_rev_list {view} {
++ global viewinstances
++
++ foreach inst $viewinstances($view) {
++ stop_instance $inst
++ }
++ set viewinstances($view) {}
++}
++
++proc reset_pending_select {selid} {
+++ global pending_select mainheadid selectheadid
++
++ if {$selid ne {}} {
++ set pending_select $selid
+++ } elseif {$selectheadid ne {}} {
+++ set pending_select $selectheadid
++ } else {
++ set pending_select $mainheadid
++ }
++}
++
++proc getcommits {selid} {
++ global canv curview need_redisplay viewactive
++
++ initlayout
++ if {[start_rev_list $curview]} {
++ reset_pending_select $selid
++ show_status [mc "Reading commits..."]
++ set need_redisplay 1
++ } else {
++ show_status [mc "No commits selected"]
++ }
++}
++
++proc updatecommits {} {
++ global curview vcanopt vorigargs vfilelimit viewinstances
++ global viewactive viewcomplete tclencoding
++ global startmsecs showneartags showlocalchanges
++ global mainheadid pending_select
++ global isworktree
++ global varcid vposids vnegids vflags vrevs
++
++ set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
++ set oldmainid $mainheadid
++ rereadrefs
++ if {$showlocalchanges} {
++ if {$mainheadid ne $oldmainid} {
++ dohidelocalchanges
++ }
++ if {[commitinview $mainheadid $curview]} {
++ dodiffindex
++ }
++ }
++ set view $curview
++ if {$vcanopt($view)} {
++ set oldpos $vposids($view)
++ set oldneg $vnegids($view)
++ set revs [parseviewrevs $view $vrevs($view)]
++ if {$revs eq {}} {
++ return
++ }
++ # note: getting the delta when negative refs change is hard,
++ # and could require multiple git log invocations, so in that
++ # case we ask git log for all the commits (not just the delta)
++ if {$oldneg eq $vnegids($view)} {
++ set newrevs {}
++ set npos 0
++ # take out positive refs that we asked for before or
++ # that we have already seen
++ foreach rev $revs {
++ if {[string length $rev] == 40} {
++ if {[lsearch -exact $oldpos $rev] < 0
++ && ![info exists varcid($view,$rev)]} {
++ lappend newrevs $rev
++ incr npos
++ }
++ } else {
++ lappend $newrevs $rev
++ }
++ }
++ if {$npos == 0} return
++ set revs $newrevs
++ set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
++ }
++ set args [concat $vflags($view) $revs --not $oldpos]
++ } else {
++ set args $vorigargs($view)
++ }
++ if {[catch {
++ set fd [open [concat | git log --no-color -z --pretty=raw --parents \
++ --boundary $args "--" $vfilelimit($view)] r]
++ } err]} {
++ error_popup "Error executing git log: $err"
++ return
++ }
++ if {$viewactive($view) == 0} {
++ set startmsecs [clock clicks -milliseconds]
++ }
++ set i [reg_instance $fd]
++ lappend viewinstances($view) $i
++ fconfigure $fd -blocking 0 -translation lf -eofchar {}
++ if {$tclencoding != {}} {
++ fconfigure $fd -encoding $tclencoding
++ }
++ filerun $fd [list getcommitlines $fd $i $view 1]
++ incr viewactive($view)
++ set viewcomplete($view) 0
++ reset_pending_select {}
++ nowbusy $view "Reading"
++ if {$showneartags} {
++ getallcommits
++ }
++}
++
++proc reloadcommits {} {
++ global curview viewcomplete selectedline currentid thickerline
++ global showneartags treediffs commitinterest cached_commitrow
++ global targetid
++
++ set selid {}
++ if {$selectedline ne {}} {
++ set selid $currentid
++ }
++
++ if {!$viewcomplete($curview)} {
++ stop_rev_list $curview
++ }
++ resetvarcs $curview
++ set selectedline {}
++ catch {unset currentid}
++ catch {unset thickerline}
++ catch {unset treediffs}
++ readrefs
++ changedrefs
++ if {$showneartags} {
++ getallcommits
++ }
++ clear_display
++ catch {unset commitinterest}
++ catch {unset cached_commitrow}
++ catch {unset targetid}
++ setcanvscroll
++ getcommits $selid
++ return 0
++}
++
++# This makes a string representation of a positive integer which
++# sorts as a string in numerical order
++proc strrep {n} {
++ if {$n < 16} {
++ return [format "%x" $n]
++ } elseif {$n < 256} {
++ return [format "x%.2x" $n]
++ } elseif {$n < 65536} {
++ return [format "y%.4x" $n]
++ }
++ return [format "z%.8x" $n]
++}
++
++# Procedures used in reordering commits from git log (without
++# --topo-order) into the order for display.
++
++proc varcinit {view} {
++ global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
++ global vtokmod varcmod vrowmod varcix vlastins
++
++ set varcstart($view) {{}}
++ set vupptr($view) {0}
++ set vdownptr($view) {0}
++ set vleftptr($view) {0}
++ set vbackptr($view) {0}
++ set varctok($view) {{}}
++ set varcrow($view) {{}}
++ set vtokmod($view) {}
++ set varcmod($view) 0
++ set vrowmod($view) 0
++ set varcix($view) {{}}
++ set vlastins($view) {0}
++}
++
++proc resetvarcs {view} {
++ global varcid varccommits parents children vseedcount ordertok
++
++ foreach vid [array names varcid $view,*] {
++ unset varcid($vid)
++ unset children($vid)
++ unset parents($vid)
++ }
++ # some commits might have children but haven't been seen yet
++ foreach vid [array names children $view,*] {
++ unset children($vid)
++ }
++ foreach va [array names varccommits $view,*] {
++ unset varccommits($va)
++ }
++ foreach vd [array names vseedcount $view,*] {
++ unset vseedcount($vd)
++ }
++ catch {unset ordertok}
++}
++
++# returns a list of the commits with no children
++proc seeds {v} {
++ global vdownptr vleftptr varcstart
++
++ set ret {}
++ set a [lindex $vdownptr($v) 0]
++ while {$a != 0} {
++ lappend ret [lindex $varcstart($v) $a]
++ set a [lindex $vleftptr($v) $a]
++ }
++ return $ret
++}
++
++proc newvarc {view id} {
++ global varcid varctok parents children vdatemode
++ global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
++ global commitdata commitinfo vseedcount varccommits vlastins
++
++ set a [llength $varctok($view)]
++ set vid $view,$id
++ if {[llength $children($vid)] == 0 || $vdatemode($view)} {
++ if {![info exists commitinfo($id)]} {
++ parsecommit $id $commitdata($id) 1
++ }
++ set cdate [lindex $commitinfo($id) 4]
++ if {![string is integer -strict $cdate]} {
++ set cdate 0
++ }
++ if {![info exists vseedcount($view,$cdate)]} {
++ set vseedcount($view,$cdate) -1
++ }
++ set c [incr vseedcount($view,$cdate)]
++ set cdate [expr {$cdate ^ 0xffffffff}]
++ set tok "s[strrep $cdate][strrep $c]"
++ } else {
++ set tok {}
++ }
++ set ka 0
++ if {[llength $children($vid)] > 0} {
++ set kid [lindex $children($vid) end]
++ set k $varcid($view,$kid)
++ if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
++ set ki $kid
++ set ka $k
++ set tok [lindex $varctok($view) $k]
++ }
++ }
++ if {$ka != 0} {
++ set i [lsearch -exact $parents($view,$ki) $id]
++ set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
++ append tok [strrep $j]
++ }
++ set c [lindex $vlastins($view) $ka]
++ if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
++ set c $ka
++ set b [lindex $vdownptr($view) $ka]
++ } else {
++ set b [lindex $vleftptr($view) $c]
++ }
++ while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
++ set c $b
++ set b [lindex $vleftptr($view) $c]
++ }
++ if {$c == $ka} {
++ lset vdownptr($view) $ka $a
++ lappend vbackptr($view) 0
++ } else {
++ lset vleftptr($view) $c $a
++ lappend vbackptr($view) $c
++ }
++ lset vlastins($view) $ka $a
++ lappend vupptr($view) $ka
++ lappend vleftptr($view) $b
++ if {$b != 0} {
++ lset vbackptr($view) $b $a
++ }
++ lappend varctok($view) $tok
++ lappend varcstart($view) $id
++ lappend vdownptr($view) 0
++ lappend varcrow($view) {}
++ lappend varcix($view) {}
++ set varccommits($view,$a) {}
++ lappend vlastins($view) 0
++ return $a
++}
++
++proc splitvarc {p v} {
++ global varcid varcstart varccommits varctok
++ global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
++
++ set oa $varcid($v,$p)
++ set ac $varccommits($v,$oa)
++ set i [lsearch -exact $varccommits($v,$oa) $p]
++ if {$i <= 0} return
++ set na [llength $varctok($v)]
++ # "%" sorts before "0"...
++ set tok "[lindex $varctok($v) $oa]%[strrep $i]"
++ lappend varctok($v) $tok
++ lappend varcrow($v) {}
++ lappend varcix($v) {}
++ set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
++ set varccommits($v,$na) [lrange $ac $i end]
++ lappend varcstart($v) $p
++ foreach id $varccommits($v,$na) {
++ set varcid($v,$id) $na
++ }
++ lappend vdownptr($v) [lindex $vdownptr($v) $oa]
++ lappend vlastins($v) [lindex $vlastins($v) $oa]
++ lset vdownptr($v) $oa $na
++ lset vlastins($v) $oa 0
++ lappend vupptr($v) $oa
++ lappend vleftptr($v) 0
++ lappend vbackptr($v) 0
++ for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
++ lset vupptr($v) $b $na
++ }
++}
++
++proc renumbervarc {a v} {
++ global parents children varctok varcstart varccommits
++ global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
++
++ set t1 [clock clicks -milliseconds]
++ set todo {}
++ set isrelated($a) 1
++ set kidchanged($a) 1
++ set ntot 0
++ while {$a != 0} {
++ if {[info exists isrelated($a)]} {
++ lappend todo $a
++ set id [lindex $varccommits($v,$a) end]
++ foreach p $parents($v,$id) {
++ if {[info exists varcid($v,$p)]} {
++ set isrelated($varcid($v,$p)) 1
++ }
++ }
++ }
++ incr ntot
++ set b [lindex $vdownptr($v) $a]
++ if {$b == 0} {
++ while {$a != 0} {
++ set b [lindex $vleftptr($v) $a]
++ if {$b != 0} break
++ set a [lindex $vupptr($v) $a]
++ }
++ }
++ set a $b
++ }
++ foreach a $todo {
++ if {![info exists kidchanged($a)]} continue
++ set id [lindex $varcstart($v) $a]
++ if {[llength $children($v,$id)] > 1} {
++ set children($v,$id) [lsort -command [list vtokcmp $v] \
++ $children($v,$id)]
++ }
++ set oldtok [lindex $varctok($v) $a]
++ if {!$vdatemode($v)} {
++ set tok {}
++ } else {
++ set tok $oldtok
++ }
++ set ka 0
++ set kid [last_real_child $v,$id]
++ if {$kid ne {}} {
++ set k $varcid($v,$kid)
++ if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
++ set ki $kid
++ set ka $k
++ set tok [lindex $varctok($v) $k]
++ }
++ }
++ if {$ka != 0} {
++ set i [lsearch -exact $parents($v,$ki) $id]
++ set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
++ append tok [strrep $j]
++ }
++ if {$tok eq $oldtok} {
++ continue
++ }
++ set id [lindex $varccommits($v,$a) end]
++ foreach p $parents($v,$id) {
++ if {[info exists varcid($v,$p)]} {
++ set kidchanged($varcid($v,$p)) 1
++ } else {
++ set sortkids($p) 1
++ }
++ }
++ lset varctok($v) $a $tok
++ set b [lindex $vupptr($v) $a]
++ if {$b != $ka} {
++ if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
++ modify_arc $v $ka
++ }
++ if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
++ modify_arc $v $b
++ }
++ set c [lindex $vbackptr($v) $a]
++ set d [lindex $vleftptr($v) $a]
++ if {$c == 0} {
++ lset vdownptr($v) $b $d
++ } else {
++ lset vleftptr($v) $c $d
++ }
++ if {$d != 0} {
++ lset vbackptr($v) $d $c
++ }
++ if {[lindex $vlastins($v) $b] == $a} {
++ lset vlastins($v) $b $c
++ }
++ lset vupptr($v) $a $ka
++ set c [lindex $vlastins($v) $ka]
++ if {$c == 0 || \
++ [string compare $tok [lindex $varctok($v) $c]] < 0} {
++ set c $ka
++ set b [lindex $vdownptr($v) $ka]
++ } else {
++ set b [lindex $vleftptr($v) $c]
++ }
++ while {$b != 0 && \
++ [string compare $tok [lindex $varctok($v) $b]] >= 0} {
++ set c $b
++ set b [lindex $vleftptr($v) $c]
++ }
++ if {$c == $ka} {
++ lset vdownptr($v) $ka $a
++ lset vbackptr($v) $a 0
++ } else {
++ lset vleftptr($v) $c $a
++ lset vbackptr($v) $a $c
++ }
++ lset vleftptr($v) $a $b
++ if {$b != 0} {
++ lset vbackptr($v) $b $a
++ }
++ lset vlastins($v) $ka $a
++ }
++ }
++ foreach id [array names sortkids] {
++ if {[llength $children($v,$id)] > 1} {
++ set children($v,$id) [lsort -command [list vtokcmp $v] \
++ $children($v,$id)]
++ }
++ }
++ set t2 [clock clicks -milliseconds]
++ #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
++}
++
++# Fix up the graph after we have found out that in view $v,
++# $p (a commit that we have already seen) is actually the parent
++# of the last commit in arc $a.
++proc fix_reversal {p a v} {
++ global varcid varcstart varctok vupptr
++
++ set pa $varcid($v,$p)
++ if {$p ne [lindex $varcstart($v) $pa]} {
++ splitvarc $p $v
++ set pa $varcid($v,$p)
++ }
++ # seeds always need to be renumbered
++ if {[lindex $vupptr($v) $pa] == 0 ||
++ [string compare [lindex $varctok($v) $a] \
++ [lindex $varctok($v) $pa]] > 0} {
++ renumbervarc $pa $v
++ }
++}
++
++proc insertrow {id p v} {
++ global cmitlisted children parents varcid varctok vtokmod
++ global varccommits ordertok commitidx numcommits curview
++ global targetid targetrow
++
++ readcommit $id
++ set vid $v,$id
++ set cmitlisted($vid) 1
++ set children($vid) {}
++ set parents($vid) [list $p]
++ set a [newvarc $v $id]
++ set varcid($vid) $a
++ if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
++ modify_arc $v $a
++ }
++ lappend varccommits($v,$a) $id
++ set vp $v,$p
++ if {[llength [lappend children($vp) $id]] > 1} {
++ set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
++ catch {unset ordertok}
++ }
++ fix_reversal $p $a $v
++ incr commitidx($v)
++ if {$v == $curview} {
++ set numcommits $commitidx($v)
++ setcanvscroll
++ if {[info exists targetid]} {
++ if {![comes_before $targetid $p]} {
++ incr targetrow
++ }
++ }
++ }
++}
++
++proc insertfakerow {id p} {
++ global varcid varccommits parents children cmitlisted
++ global commitidx varctok vtokmod targetid targetrow curview numcommits
++
++ set v $curview
++ set a $varcid($v,$p)
++ set i [lsearch -exact $varccommits($v,$a) $p]
++ if {$i < 0} {
++ puts "oops: insertfakerow can't find [shortids $p] on arc $a"
++ return
++ }
++ set children($v,$id) {}
++ set parents($v,$id) [list $p]
++ set varcid($v,$id) $a
++ lappend children($v,$p) $id
++ set cmitlisted($v,$id) 1
++ set numcommits [incr commitidx($v)]
++ # note we deliberately don't update varcstart($v) even if $i == 0
++ set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
++ modify_arc $v $a $i
++ if {[info exists targetid]} {
++ if {![comes_before $targetid $p]} {
++ incr targetrow
++ }
++ }
++ setcanvscroll
++ drawvisible
++}
++
++proc removefakerow {id} {
++ global varcid varccommits parents children commitidx
++ global varctok vtokmod cmitlisted currentid selectedline
++ global targetid curview numcommits
++
++ set v $curview
++ if {[llength $parents($v,$id)] != 1} {
++ puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
++ return
++ }
++ set p [lindex $parents($v,$id) 0]
++ set a $varcid($v,$id)
++ set i [lsearch -exact $varccommits($v,$a) $id]
++ if {$i < 0} {
++ puts "oops: removefakerow can't find [shortids $id] on arc $a"
++ return
++ }
++ unset varcid($v,$id)
++ set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
++ unset parents($v,$id)
++ unset children($v,$id)
++ unset cmitlisted($v,$id)
++ set numcommits [incr commitidx($v) -1]
++ set j [lsearch -exact $children($v,$p) $id]
++ if {$j >= 0} {
++ set children($v,$p) [lreplace $children($v,$p) $j $j]
++ }
++ modify_arc $v $a $i
++ if {[info exist currentid] && $id eq $currentid} {
++ unset currentid
++ set selectedline {}
++ }
++ if {[info exists targetid] && $targetid eq $id} {
++ set targetid $p
++ }
++ setcanvscroll
++ drawvisible
++}
++
++proc first_real_child {vp} {
++ global children nullid nullid2
++
++ foreach id $children($vp) {
++ if {$id ne $nullid && $id ne $nullid2} {
++ return $id
++ }
++ }
++ return {}
++}
++
++proc last_real_child {vp} {
++ global children nullid nullid2
++
++ set kids $children($vp)
++ for {set i [llength $kids]} {[incr i -1] >= 0} {} {
++ set id [lindex $kids $i]
++ if {$id ne $nullid && $id ne $nullid2} {
++ return $id
++ }
++ }
++ return {}
++}
++
++proc vtokcmp {v a b} {
++ global varctok varcid
++
++ return [string compare [lindex $varctok($v) $varcid($v,$a)] \
++ [lindex $varctok($v) $varcid($v,$b)]]
++}
++
++# This assumes that if lim is not given, the caller has checked that
++# arc a's token is less than $vtokmod($v)
++proc modify_arc {v a {lim {}}} {
++ global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
++
++ if {$lim ne {}} {
++ set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
++ if {$c > 0} return
++ if {$c == 0} {
++ set r [lindex $varcrow($v) $a]
++ if {$r ne {} && $vrowmod($v) <= $r + $lim} return
++ }
++ }
++ set vtokmod($v) [lindex $varctok($v) $a]
++ set varcmod($v) $a
++ if {$v == $curview} {
++ while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
++ set a [lindex $vupptr($v) $a]
++ set lim {}
++ }
++ set r 0
++ if {$a != 0} {
++ if {$lim eq {}} {
++ set lim [llength $varccommits($v,$a)]
++ }
++ set r [expr {[lindex $varcrow($v) $a] + $lim}]
++ }
++ set vrowmod($v) $r
++ undolayout $r
++ }
++}
++
++proc update_arcrows {v} {
++ global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
++ global varcid vrownum varcorder varcix varccommits
++ global vupptr vdownptr vleftptr varctok
++ global displayorder parentlist curview cached_commitrow
++
++ if {$vrowmod($v) == $commitidx($v)} return
++ if {$v == $curview} {
++ if {[llength $displayorder] > $vrowmod($v)} {
++ set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
++ set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
++ }
++ catch {unset cached_commitrow}
++ }
++ set narctot [expr {[llength $varctok($v)] - 1}]
++ set a $varcmod($v)
++ while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
++ # go up the tree until we find something that has a row number,
++ # or we get to a seed
++ set a [lindex $vupptr($v) $a]
++ }
++ if {$a == 0} {
++ set a [lindex $vdownptr($v) 0]
++ if {$a == 0} return
++ set vrownum($v) {0}
++ set varcorder($v) [list $a]
++ lset varcix($v) $a 0
++ lset varcrow($v) $a 0
++ set arcn 0
++ set row 0
++ } else {
++ set arcn [lindex $varcix($v) $a]
++ if {[llength $vrownum($v)] > $arcn + 1} {
++ set vrownum($v) [lrange $vrownum($v) 0 $arcn]
++ set varcorder($v) [lrange $varcorder($v) 0 $arcn]
++ }
++ set row [lindex $varcrow($v) $a]
++ }
++ while {1} {
++ set p $a
++ incr row [llength $varccommits($v,$a)]
++ # go down if possible
++ set b [lindex $vdownptr($v) $a]
++ if {$b == 0} {
++ # if not, go left, or go up until we can go left
++ while {$a != 0} {
++ set b [lindex $vleftptr($v) $a]
++ if {$b != 0} break
++ set a [lindex $vupptr($v) $a]
++ }
++ if {$a == 0} break
++ }
++ set a $b
++ incr arcn
++ lappend vrownum($v) $row
++ lappend varcorder($v) $a
++ lset varcix($v) $a $arcn
++ lset varcrow($v) $a $row
++ }
++ set vtokmod($v) [lindex $varctok($v) $p]
++ set varcmod($v) $p
++ set vrowmod($v) $row
++ if {[info exists currentid]} {
++ set selectedline [rowofcommit $currentid]
++ }
++}
++
++# Test whether view $v contains commit $id
++proc commitinview {id v} {
++ global varcid
++
++ return [info exists varcid($v,$id)]
++}
++
++# Return the row number for commit $id in the current view
++proc rowofcommit {id} {
++ global varcid varccommits varcrow curview cached_commitrow
++ global varctok vtokmod
++
++ set v $curview
++ if {![info exists varcid($v,$id)]} {
++ puts "oops rowofcommit no arc for [shortids $id]"
++ return {}
++ }
++ set a $varcid($v,$id)
++ if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
++ update_arcrows $v
++ }
++ if {[info exists cached_commitrow($id)]} {
++ return $cached_commitrow($id)
++ }
++ set i [lsearch -exact $varccommits($v,$a) $id]
++ if {$i < 0} {
++ puts "oops didn't find commit [shortids $id] in arc $a"
++ return {}
++ }
++ incr i [lindex $varcrow($v) $a]
++ set cached_commitrow($id) $i
++ return $i
++}
++
++# Returns 1 if a is on an earlier row than b, otherwise 0
++proc comes_before {a b} {
++ global varcid varctok curview
++
++ set v $curview
++ if {$a eq $b || ![info exists varcid($v,$a)] || \
++ ![info exists varcid($v,$b)]} {
++ return 0
++ }
++ if {$varcid($v,$a) != $varcid($v,$b)} {
++ return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
++ [lindex $varctok($v) $varcid($v,$b)]] < 0}]
++ }
++ return [expr {[rowofcommit $a] < [rowofcommit $b]}]
++}
++
++proc bsearch {l elt} {
++ if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
++ return 0
++ }
++ set lo 0
++ set hi [llength $l]
++ while {$hi - $lo > 1} {
++ set mid [expr {int(($lo + $hi) / 2)}]
++ set t [lindex $l $mid]
++ if {$elt < $t} {
++ set hi $mid
++ } elseif {$elt > $t} {
++ set lo $mid
++ } else {
++ return $mid
++ }
++ }
++ return $lo
++}
++
++# Make sure rows $start..$end-1 are valid in displayorder and parentlist
++proc make_disporder {start end} {
++ global vrownum curview commitidx displayorder parentlist
++ global varccommits varcorder parents vrowmod varcrow
++ global d_valid_start d_valid_end
++
++ if {$end > $vrowmod($curview)} {
++ update_arcrows $curview
++ }
++ set ai [bsearch $vrownum($curview) $start]
++ set start [lindex $vrownum($curview) $ai]
++ set narc [llength $vrownum($curview)]
++ for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
++ set a [lindex $varcorder($curview) $ai]
++ set l [llength $displayorder]
++ set al [llength $varccommits($curview,$a)]
++ if {$l < $r + $al} {
++ if {$l < $r} {
++ set pad [ntimes [expr {$r - $l}] {}]
++ set displayorder [concat $displayorder $pad]
++ set parentlist [concat $parentlist $pad]
++ } elseif {$l > $r} {
++ set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
++ set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
++ }
++ foreach id $varccommits($curview,$a) {
++ lappend displayorder $id
++ lappend parentlist $parents($curview,$id)
++ }
++ } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
++ set i $r
++ foreach id $varccommits($curview,$a) {
++ lset displayorder $i $id
++ lset parentlist $i $parents($curview,$id)
++ incr i
++ }
++ }
++ incr r $al
++ }
++}
++
++proc commitonrow {row} {
++ global displayorder
++
++ set id [lindex $displayorder $row]
++ if {$id eq {}} {
++ make_disporder $row [expr {$row + 1}]
++ set id [lindex $displayorder $row]
++ }
++ return $id
++}
++
++proc closevarcs {v} {
++ global varctok varccommits varcid parents children
++ global cmitlisted commitidx commitinterest vtokmod
++
++ set missing_parents 0
++ set scripts {}
++ set narcs [llength $varctok($v)]
++ for {set a 1} {$a < $narcs} {incr a} {
++ set id [lindex $varccommits($v,$a) end]
++ foreach p $parents($v,$id) {
++ if {[info exists varcid($v,$p)]} continue
++ # add p as a new commit
++ incr missing_parents
++ set cmitlisted($v,$p) 0
++ set parents($v,$p) {}
++ if {[llength $children($v,$p)] == 1 &&
++ [llength $parents($v,$id)] == 1} {
++ set b $a
++ } else {
++ set b [newvarc $v $p]
++ }
++ set varcid($v,$p) $b
++ if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
++ modify_arc $v $b
++ }
++ lappend varccommits($v,$b) $p
++ incr commitidx($v)
++ if {[info exists commitinterest($p)]} {
++ foreach script $commitinterest($p) {
++ lappend scripts [string map [list "%I" $p] $script]
++ }
++ unset commitinterest($id)
++ }
++ }
++ }
++ if {$missing_parents > 0} {
++ foreach s $scripts {
++ eval $s
++ }
++ }
++}
++
++# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
++# Assumes we already have an arc for $rwid.
++proc rewrite_commit {v id rwid} {
++ global children parents varcid varctok vtokmod varccommits
++
++ foreach ch $children($v,$id) {
++ # make $rwid be $ch's parent in place of $id
++ set i [lsearch -exact $parents($v,$ch) $id]
++ if {$i < 0} {
++ puts "oops rewrite_commit didn't find $id in parent list for $ch"
++ }
++ set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
++ # add $ch to $rwid's children and sort the list if necessary
++ if {[llength [lappend children($v,$rwid) $ch]] > 1} {
++ set children($v,$rwid) [lsort -command [list vtokcmp $v] \
++ $children($v,$rwid)]
++ }
++ # fix the graph after joining $id to $rwid
++ set a $varcid($v,$ch)
++ fix_reversal $rwid $a $v
++ # parentlist is wrong for the last element of arc $a
++ # even if displayorder is right, hence the 3rd arg here
++ modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
++ }
++}
++
++proc getcommitlines {fd inst view updating} {
++ global cmitlisted commitinterest leftover
++ global commitidx commitdata vdatemode
++ global parents children curview hlview
++ global idpending ordertok
++ global varccommits varcid varctok vtokmod vfilelimit
++
++ set stuff [read $fd 500000]
++ # git log doesn't terminate the last commit with a null...
++ if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
++ set stuff "\0"
++ }
++ if {$stuff == {}} {
++ if {![eof $fd]} {
++ return 1
++ }
++ global commfd viewcomplete viewactive viewname
++ global viewinstances
++ unset commfd($inst)
++ set i [lsearch -exact $viewinstances($view) $inst]
++ if {$i >= 0} {
++ set viewinstances($view) [lreplace $viewinstances($view) $i $i]
++ }
++ # set it blocking so we wait for the process to terminate
++ fconfigure $fd -blocking 1
++ if {[catch {close $fd} err]} {
++ set fv {}
++ if {$view != $curview} {
++ set fv " for the \"$viewname($view)\" view"
++ }
++ if {[string range $err 0 4] == "usage"} {
++ set err "Gitk: error reading commits$fv:\
++ bad arguments to git log."
++ if {$viewname($view) eq "Command line"} {
++ append err \
++ " (Note: arguments to gitk are passed to git log\
++ to allow selection of commits to be displayed.)"
++ }
++ } else {
++ set err "Error reading commits$fv: $err"
++ }
++ error_popup $err
++ }
++ if {[incr viewactive($view) -1] <= 0} {
++ set viewcomplete($view) 1
++ # Check if we have seen any ids listed as parents that haven't
++ # appeared in the list
++ closevarcs $view
++ notbusy $view
++ }
++ if {$view == $curview} {
++ run chewcommits
++ }
++ return 0
++ }
++ set start 0
++ set gotsome 0
++ set scripts {}
++ while 1 {
++ set i [string first "\0" $stuff $start]
++ if {$i < 0} {
++ append leftover($inst) [string range $stuff $start end]
++ break
++ }
++ if {$start == 0} {
++ set cmit $leftover($inst)
++ append cmit [string range $stuff 0 [expr {$i - 1}]]
++ set leftover($inst) {}
++ } else {
++ set cmit [string range $stuff $start [expr {$i - 1}]]
++ }
++ set start [expr {$i + 1}]
++ set j [string first "\n" $cmit]
++ set ok 0
++ set listed 1
++ if {$j >= 0 && [string match "commit *" $cmit]} {
++ set ids [string range $cmit 7 [expr {$j - 1}]]
++ if {[string match {[-^<>]*} $ids]} {
++ switch -- [string index $ids 0] {
++ "-" {set listed 0}
++ "^" {set listed 2}
++ "<" {set listed 3}
++ ">" {set listed 4}
++ }
++ set ids [string range $ids 1 end]
++ }
++ set ok 1
++ foreach id $ids {
++ if {[string length $id] != 40} {
++ set ok 0
++ break
++ }
++ }
++ }
++ if {!$ok} {
++ set shortcmit $cmit
++ if {[string length $shortcmit] > 80} {
++ set shortcmit "[string range $shortcmit 0 80]..."
++ }
++ error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
++ exit 1
++ }
++ set id [lindex $ids 0]
++ set vid $view,$id
++
++ if {!$listed && $updating && ![info exists varcid($vid)] &&
++ $vfilelimit($view) ne {}} {
++ # git log doesn't rewrite parents for unlisted commits
++ # when doing path limiting, so work around that here
++ # by working out the rewritten parent with git rev-list
++ # and if we already know about it, using the rewritten
++ # parent as a substitute parent for $id's children.
++ if {![catch {
++ set rwid [exec git rev-list --first-parent --max-count=1 \
++ $id -- $vfilelimit($view)]
++ }]} {
++ if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
++ # use $rwid in place of $id
++ rewrite_commit $view $id $rwid
++ continue
++ }
++ }
++ }
++
++ set a 0
++ if {[info exists varcid($vid)]} {
++ if {$cmitlisted($vid) || !$listed} continue
++ set a $varcid($vid)
++ }
++ if {$listed} {
++ set olds [lrange $ids 1 end]
++ } else {
++ set olds {}
++ }
++ set commitdata($id) [string range $cmit [expr {$j + 1}] end]
++ set cmitlisted($vid) $listed
++ set parents($vid) $olds
++ if {![info exists children($vid)]} {
++ set children($vid) {}
++ } elseif {$a == 0 && [llength $children($vid)] == 1} {
++ set k [lindex $children($vid) 0]
++ if {[llength $parents($view,$k)] == 1 &&
++ (!$vdatemode($view) ||
++ $varcid($view,$k) == [llength $varctok($view)] - 1)} {
++ set a $varcid($view,$k)
++ }
++ }
++ if {$a == 0} {
++ # new arc
++ set a [newvarc $view $id]
++ }
++ if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
++ modify_arc $view $a
++ }
++ if {![info exists varcid($vid)]} {
++ set varcid($vid) $a
++ lappend varccommits($view,$a) $id
++ incr commitidx($view)
++ }
++
++ set i 0
++ foreach p $olds {
++ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
++ set vp $view,$p
++ if {[llength [lappend children($vp) $id]] > 1 &&
++ [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
++ set children($vp) [lsort -command [list vtokcmp $view] \
++ $children($vp)]
++ catch {unset ordertok}
++ }
++ if {[info exists varcid($view,$p)]} {
++ fix_reversal $p $a $view
++ }
++ }
++ incr i
++ }
++
++ if {[info exists commitinterest($id)]} {
++ foreach script $commitinterest($id) {
++ lappend scripts [string map [list "%I" $id] $script]
++ }
++ unset commitinterest($id)
++ }
++ set gotsome 1
++ }
++ if {$gotsome} {
++ global numcommits hlview
++
++ if {$view == $curview} {
++ set numcommits $commitidx($view)
++ run chewcommits
++ }
++ if {[info exists hlview] && $view == $hlview} {
++ # we never actually get here...
++ run vhighlightmore
++ }
++ foreach s $scripts {
++ eval $s
++ }
++ }
++ return 2
++}
++
++proc chewcommits {} {
++ global curview hlview viewcomplete
++ global pending_select
++
++ layoutmore
++ if {$viewcomplete($curview)} {
++ global commitidx varctok
++ global numcommits startmsecs
++
++ if {[info exists pending_select]} {
++ update
++ reset_pending_select {}
++
++ if {[commitinview $pending_select $curview]} {
++ selectline [rowofcommit $pending_select] 1
++ } else {
++ set row [first_real_row]
++ selectline $row 1
++ }
++ }
++ if {$commitidx($curview) > 0} {
++ #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
++ #puts "overall $ms ms for $numcommits commits"
++ #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
++ } else {
++ show_status [mc "No commits selected"]
++ }
++ notbusy layout
++ }
++ return 0
++}
++
++proc readcommit {id} {
++ if {[catch {set contents [exec git cat-file commit $id]}]} return
++ parsecommit $id $contents 0
++}
++
++proc parsecommit {id contents listed} {
++ global commitinfo cdate
++
++ set inhdr 1
++ set comment {}
++ set headline {}
++ set auname {}
++ set audate {}
++ set comname {}
++ set comdate {}
++ set hdrend [string first "\n\n" $contents]
++ if {$hdrend < 0} {
++ # should never happen...
++ set hdrend [string length $contents]
++ }
++ set header [string range $contents 0 [expr {$hdrend - 1}]]
++ set comment [string range $contents [expr {$hdrend + 2}] end]
++ foreach line [split $header "\n"] {
++ set tag [lindex $line 0]
++ if {$tag == "author"} {
++ set audate [lindex $line end-1]
++ set auname [lrange $line 1 end-2]
++ } elseif {$tag == "committer"} {
++ set comdate [lindex $line end-1]
++ set comname [lrange $line 1 end-2]
++ }
++ }
++ set headline {}
++ # take the first non-blank line of the comment as the headline
++ set headline [string trimleft $comment]
++ set i [string first "\n" $headline]
++ if {$i >= 0} {
++ set headline [string range $headline 0 $i]
++ }
++ set headline [string trimright $headline]
++ set i [string first "\r" $headline]
++ if {$i >= 0} {
++ set headline [string trimright [string range $headline 0 $i]]
++ }
++ if {!$listed} {
++ # git log indents the comment by 4 spaces;
++ # if we got this via git cat-file, add the indentation
++ set newcomment {}
++ foreach line [split $comment "\n"] {
++ append newcomment " "
++ append newcomment $line
++ append newcomment "\n"
++ }
++ set comment $newcomment
++ }
++ if {$comdate != {}} {
++ set cdate($id) $comdate
++ }
++ set commitinfo($id) [list $headline $auname $audate \
++ $comname $comdate $comment]
++}
++
++proc getcommit {id} {
++ global commitdata commitinfo
++
++ if {[info exists commitdata($id)]} {
++ parsecommit $id $commitdata($id) 1
++ } else {
++ readcommit $id
++ if {![info exists commitinfo($id)]} {
++ set commitinfo($id) [list [mc "No commit information available"]]
++ }
++ }
++ return 1
++}
++
++proc readrefs {} {
++ global tagids idtags headids idheads tagobjid
++ global otherrefids idotherrefs mainhead mainheadid
+++ global selecthead selectheadid
++
++ foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
++ catch {unset $v}
++ }
++ set refd [open [list | git show-ref -d] r]
++ while {[gets $refd line] >= 0} {
++ if {[string index $line 40] ne " "} continue
++ set id [string range $line 0 39]
++ set ref [string range $line 41 end]
++ if {![string match "refs/*" $ref]} continue
++ set name [string range $ref 5 end]
++ if {[string match "remotes/*" $name]} {
++ if {![string match "*/HEAD" $name]} {
++ set headids($name) $id
++ lappend idheads($id) $name
++ }
++ } elseif {[string match "heads/*" $name]} {
++ set name [string range $name 6 end]
++ set headids($name) $id
++ lappend idheads($id) $name
++ } elseif {[string match "tags/*" $name]} {
++ # this lets refs/tags/foo^{} overwrite refs/tags/foo,
++ # which is what we want since the former is the commit ID
++ set name [string range $name 5 end]
++ if {[string match "*^{}" $name]} {
++ set name [string range $name 0 end-3]
++ } else {
++ set tagobjid($name) $id
++ }
++ set tagids($name) $id
++ lappend idtags($id) $name
++ } else {
++ set otherrefids($name) $id
++ lappend idotherrefs($id) $name
++ }
++ }
++ catch {close $refd}
++ set mainhead {}
++ set mainheadid {}
++ catch {
++ set mainheadid [exec git rev-parse HEAD]
++ set thehead [exec git symbolic-ref HEAD]
++ if {[string match "refs/heads/*" $thehead]} {
++ set mainhead [string range $thehead 11 end]
++ }
++ }
+++ set selectheadid {}
+++ if {$selecthead ne {}} {
+++ catch {
+++ set selectheadid [exec git rev-parse --verify $selecthead]
+++ }
+++ }
++}
++
++# skip over fake commits
++proc first_real_row {} {
++ global nullid nullid2 numcommits
++
++ for {set row 0} {$row < $numcommits} {incr row} {
++ set id [commitonrow $row]
++ if {$id ne $nullid && $id ne $nullid2} {
++ break
++ }
++ }
++ return $row
++}
++
++# update things for a head moved to a child of its previous location
++proc movehead {id name} {
++ global headids idheads
++
++ removehead $headids($name) $name
++ set headids($name) $id
++ lappend idheads($id) $name
++}
++
++# update things when a head has been removed
++proc removehead {id name} {
++ global headids idheads
++
++ if {$idheads($id) eq $name} {
++ unset idheads($id)
++ } else {
++ set i [lsearch -exact $idheads($id) $name]
++ if {$i >= 0} {
++ set idheads($id) [lreplace $idheads($id) $i $i]
++ }
++ }
++ unset headids($name)
++}
++
++proc show_error {w top msg} {
++ message $w.m -text $msg -justify center -aspect 400
++ pack $w.m -side top -fill x -padx 20 -pady 20
++ button $w.ok -text [mc OK] -command "destroy $top"
++ pack $w.ok -side bottom -fill x
++ bind $top <Visibility> "grab $top; focus $top"
++ bind $top <Key-Return> "destroy $top"
++ tkwait window $top
++}
++
++proc error_popup msg {
++ set w .error
++ toplevel $w
++ wm transient $w .
++ show_error $w $w $msg
++}
++
++proc confirm_popup msg {
++ global confirm_ok
++ set confirm_ok 0
++ set w .confirm
++ toplevel $w
++ wm transient $w .
++ message $w.m -text $msg -justify center -aspect 400
++ pack $w.m -side top -fill x -padx 20 -pady 20
++ button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
++ pack $w.ok -side left -fill x
++ button $w.cancel -text [mc Cancel] -command "destroy $w"
++ pack $w.cancel -side right -fill x
++ bind $w <Visibility> "grab $w; focus $w"
++ tkwait window $w
++ return $confirm_ok
++}
++
++proc setoptions {} {
++ option add *Panedwindow.showHandle 1 startupFile
++ option add *Panedwindow.sashRelief raised startupFile
++ option add *Button.font uifont startupFile
++ option add *Checkbutton.font uifont startupFile
++ option add *Radiobutton.font uifont startupFile
++ option add *Menu.font uifont startupFile
++ option add *Menubutton.font uifont startupFile
++ option add *Label.font uifont startupFile
++ option add *Message.font uifont startupFile
++ option add *Entry.font uifont startupFile
++}
++
++proc makewindow {} {
++ global canv canv2 canv3 linespc charspc ctext cflist cscroll
++ global tabstop
++ global findtype findtypemenu findloc findstring fstring geometry
++ global entries sha1entry sha1string sha1but
++ global diffcontextstring diffcontext
++ global ignorespace
++ global maincursor textcursor curtextcursor
++ global rowctxmenu fakerowmenu mergemax wrapcomment
++ global highlight_files gdttype
++ global searchstring sstring
++ global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
++ global headctxmenu progresscanv progressitem progresscoords statusw
++ global fprogitem fprogcoord lastprogupdate progupdatepending
++ global rprogitem rprogcoord rownumsel numcommits
++ global have_tk85
++
++ menu .bar
++ .bar add cascade -label [mc "File"] -menu .bar.file
++ menu .bar.file
++ .bar.file add command -label [mc "Update"] -command updatecommits
++ .bar.file add command -label [mc "Reload"] -command reloadcommits
++ .bar.file add command -label [mc "Reread references"] -command rereadrefs
++ .bar.file add command -label [mc "List references"] -command showrefs
++ .bar.file add command -label [mc "Quit"] -command doquit
++ menu .bar.edit
++ .bar add cascade -label [mc "Edit"] -menu .bar.edit
++ .bar.edit add command -label [mc "Preferences"] -command doprefs
++
++ menu .bar.view
++ .bar add cascade -label [mc "View"] -menu .bar.view
++ .bar.view add command -label [mc "New view..."] -command {newview 0}
++ .bar.view add command -label [mc "Edit view..."] -command editview \
++ -state disabled
++ .bar.view add command -label [mc "Delete view"] -command delview -state disabled
++ .bar.view add separator
++ .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
++ -variable selectedview -value 0
++
++ menu .bar.help
++ .bar add cascade -label [mc "Help"] -menu .bar.help
++ .bar.help add command -label [mc "About gitk"] -command about
++ .bar.help add command -label [mc "Key bindings"] -command keys
++ .bar.help configure
++ . configure -menu .bar
++
++ # the gui has upper and lower half, parts of a paned window.
++ panedwindow .ctop -orient vertical
++
++ # possibly use assumed geometry
++ if {![info exists geometry(pwsash0)]} {
++ set geometry(topheight) [expr {15 * $linespc}]
++ set geometry(topwidth) [expr {80 * $charspc}]
++ set geometry(botheight) [expr {15 * $linespc}]
++ set geometry(botwidth) [expr {50 * $charspc}]
++ set geometry(pwsash0) "[expr {40 * $charspc}] 2"
++ set geometry(pwsash1) "[expr {60 * $charspc}] 2"
++ }
++
++ # the upper half will have a paned window, a scroll bar to the right, and some stuff below
++ frame .tf -height $geometry(topheight) -width $geometry(topwidth)
++ frame .tf.histframe
++ panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
++
++ # create three canvases
++ set cscroll .tf.histframe.csb
++ set canv .tf.histframe.pwclist.canv
++ canvas $canv \
++ -selectbackground $selectbgcolor \
++ -background $bgcolor -bd 0 \
++ -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
++ .tf.histframe.pwclist add $canv
++ set canv2 .tf.histframe.pwclist.canv2
++ canvas $canv2 \
++ -selectbackground $selectbgcolor \
++ -background $bgcolor -bd 0 -yscrollincr $linespc
++ .tf.histframe.pwclist add $canv2
++ set canv3 .tf.histframe.pwclist.canv3
++ canvas $canv3 \
++ -selectbackground $selectbgcolor \
++ -background $bgcolor -bd 0 -yscrollincr $linespc
++ .tf.histframe.pwclist add $canv3
++ eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
++ eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
++
++ # a scroll bar to rule them
++ scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
++ pack $cscroll -side right -fill y
++ bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
++ lappend bglist $canv $canv2 $canv3
++ pack .tf.histframe.pwclist -fill both -expand 1 -side left
++
++ # we have two button bars at bottom of top frame. Bar 1
++ frame .tf.bar
++ frame .tf.lbar -height 15
++
++ set sha1entry .tf.bar.sha1
++ set entries $sha1entry
++ set sha1but .tf.bar.sha1label
++ button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
++ -command gotocommit -width 8
++ $sha1but conf -disabledforeground [$sha1but cget -foreground]
++ pack .tf.bar.sha1label -side left
++ entry $sha1entry -width 40 -font textfont -textvariable sha1string
++ trace add variable sha1string write sha1change
++ pack $sha1entry -side left -pady 2
++
++ image create bitmap bm-left -data {
++ #define left_width 16
++ #define left_height 16
++ static unsigned char left_bits[] = {
++ 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
++ 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
++ 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
++ }
++ image create bitmap bm-right -data {
++ #define right_width 16
++ #define right_height 16
++ static unsigned char right_bits[] = {
++ 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
++ 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
++ 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
++ }
++ button .tf.bar.leftbut -image bm-left -command goback \
++ -state disabled -width 26
++ pack .tf.bar.leftbut -side left -fill y
++ button .tf.bar.rightbut -image bm-right -command goforw \
++ -state disabled -width 26
++ pack .tf.bar.rightbut -side left -fill y
++
++ label .tf.bar.rowlabel -text [mc "Row"]
++ set rownumsel {}
++ label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
++ -relief sunken -anchor e
++ label .tf.bar.rowlabel2 -text "/"
++ label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
++ -relief sunken -anchor e
++ pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
++ -side left
++ global selectedline
++ trace add variable selectedline write selectedline_change
++
++ # Status label and progress bar
++ set statusw .tf.bar.status
++ label $statusw -width 15 -relief sunken
++ pack $statusw -side left -padx 5
++ set h [expr {[font metrics uifont -linespace] + 2}]
++ set progresscanv .tf.bar.progress
++ canvas $progresscanv -relief sunken -height $h -borderwidth 2
++ set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
++ set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
++ set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
++ pack $progresscanv -side right -expand 1 -fill x
++ set progresscoords {0 0}
++ set fprogcoord 0
++ set rprogcoord 0
++ bind $progresscanv <Configure> adjustprogress
++ set lastprogupdate [clock clicks -milliseconds]
++ set progupdatepending 0
++
++ # build up the bottom bar of upper window
++ label .tf.lbar.flabel -text "[mc "Find"] "
++ button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
++ button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
++ label .tf.lbar.flab2 -text " [mc "commit"] "
++ pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
++ -side left -fill y
++ set gdttype [mc "containing:"]
++ set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
++ [mc "containing:"] \
++ [mc "touching paths:"] \
++ [mc "adding/removing string:"]]
++ trace add variable gdttype write gdttype_change
++ pack .tf.lbar.gdttype -side left -fill y
++
++ set findstring {}
++ set fstring .tf.lbar.findstring
++ lappend entries $fstring
++ entry $fstring -width 30 -font textfont -textvariable findstring
++ trace add variable findstring write find_change
++ set findtype [mc "Exact"]
++ set findtypemenu [tk_optionMenu .tf.lbar.findtype \
++ findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
++ trace add variable findtype write findcom_change
++ set findloc [mc "All fields"]
++ tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
++ [mc "Comments"] [mc "Author"] [mc "Committer"]
++ trace add variable findloc write find_change
++ pack .tf.lbar.findloc -side right
++ pack .tf.lbar.findtype -side right
++ pack $fstring -side left -expand 1 -fill x
++
++ # Finish putting the upper half of the viewer together
++ pack .tf.lbar -in .tf -side bottom -fill x
++ pack .tf.bar -in .tf -side bottom -fill x
++ pack .tf.histframe -fill both -side top -expand 1
++ .ctop add .tf
++ .ctop paneconfigure .tf -height $geometry(topheight)
++ .ctop paneconfigure .tf -width $geometry(topwidth)
++
++ # now build up the bottom
++ panedwindow .pwbottom -orient horizontal
++
++ # lower left, a text box over search bar, scroll bar to the right
++ # if we know window height, then that will set the lower text height, otherwise
++ # we set lower text height which will drive window height
++ if {[info exists geometry(main)]} {
++ frame .bleft -width $geometry(botwidth)
++ } else {
++ frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
++ }
++ frame .bleft.top
++ frame .bleft.mid
++ frame .bleft.bottom
++
++ button .bleft.top.search -text [mc "Search"] -command dosearch
++ pack .bleft.top.search -side left -padx 5
++ set sstring .bleft.top.sstring
++ entry $sstring -width 20 -font textfont -textvariable searchstring
++ lappend entries $sstring
++ trace add variable searchstring write incrsearch
++ pack $sstring -side left -expand 1 -fill x
++ radiobutton .bleft.mid.diff -text [mc "Diff"] \
++ -command changediffdisp -variable diffelide -value {0 0}
++ radiobutton .bleft.mid.old -text [mc "Old version"] \
++ -command changediffdisp -variable diffelide -value {0 1}
++ radiobutton .bleft.mid.new -text [mc "New version"] \
++ -command changediffdisp -variable diffelide -value {1 0}
++ label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
++ pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
++ spinbox .bleft.mid.diffcontext -width 5 -font textfont \
++ -from 1 -increment 1 -to 10000000 \
++ -validate all -validatecommand "diffcontextvalidate %P" \
++ -textvariable diffcontextstring
++ .bleft.mid.diffcontext set $diffcontext
++ trace add variable diffcontextstring write diffcontextchange
++ lappend entries .bleft.mid.diffcontext
++ pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
++ checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
++ -command changeignorespace -variable ignorespace
++ pack .bleft.mid.ignspace -side left -padx 5
++ set ctext .bleft.bottom.ctext
++ text $ctext -background $bgcolor -foreground $fgcolor \
++ -state disabled -font textfont \
++ -yscrollcommand scrolltext -wrap none \
++ -xscrollcommand ".bleft.bottom.sbhorizontal set"
++ if {$have_tk85} {
++ $ctext conf -tabstyle wordprocessor
++ }
++ scrollbar .bleft.bottom.sb -command "$ctext yview"
++ scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
++ -width 10
++ pack .bleft.top -side top -fill x
++ pack .bleft.mid -side top -fill x
++ grid $ctext .bleft.bottom.sb -sticky nsew
++ grid .bleft.bottom.sbhorizontal -sticky ew
++ grid columnconfigure .bleft.bottom 0 -weight 1
++ grid rowconfigure .bleft.bottom 0 -weight 1
++ grid rowconfigure .bleft.bottom 1 -weight 0
++ pack .bleft.bottom -side top -fill both -expand 1
++ lappend bglist $ctext
++ lappend fglist $ctext
++
++ $ctext tag conf comment -wrap $wrapcomment
++ $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
++ $ctext tag conf hunksep -fore [lindex $diffcolors 2]
++ $ctext tag conf d0 -fore [lindex $diffcolors 0]
++ $ctext tag conf d1 -fore [lindex $diffcolors 1]
++ $ctext tag conf m0 -fore red
++ $ctext tag conf m1 -fore blue
++ $ctext tag conf m2 -fore green
++ $ctext tag conf m3 -fore purple
++ $ctext tag conf m4 -fore brown
++ $ctext tag conf m5 -fore "#009090"
++ $ctext tag conf m6 -fore magenta
++ $ctext tag conf m7 -fore "#808000"
++ $ctext tag conf m8 -fore "#009000"
++ $ctext tag conf m9 -fore "#ff0080"
++ $ctext tag conf m10 -fore cyan
++ $ctext tag conf m11 -fore "#b07070"
++ $ctext tag conf m12 -fore "#70b0f0"
++ $ctext tag conf m13 -fore "#70f0b0"
++ $ctext tag conf m14 -fore "#f0b070"
++ $ctext tag conf m15 -fore "#ff70b0"
++ $ctext tag conf mmax -fore darkgrey
++ set mergemax 16
++ $ctext tag conf mresult -font textfontbold
++ $ctext tag conf msep -font textfontbold
++ $ctext tag conf found -back yellow
++
++ .pwbottom add .bleft
++ .pwbottom paneconfigure .bleft -width $geometry(botwidth)
++
++ # lower right
++ frame .bright
++ frame .bright.mode
++ radiobutton .bright.mode.patch -text [mc "Patch"] \
++ -command reselectline -variable cmitmode -value "patch"
++ radiobutton .bright.mode.tree -text [mc "Tree"] \
++ -command reselectline -variable cmitmode -value "tree"
++ grid .bright.mode.patch .bright.mode.tree -sticky ew
++ pack .bright.mode -side top -fill x
++ set cflist .bright.cfiles
++ set indent [font measure mainfont "nn"]
++ text $cflist \
++ -selectbackground $selectbgcolor \
++ -background $bgcolor -foreground $fgcolor \
++ -font mainfont \
++ -tabs [list $indent [expr {2 * $indent}]] \
++ -yscrollcommand ".bright.sb set" \
++ -cursor [. cget -cursor] \
++ -spacing1 1 -spacing3 1
++ lappend bglist $cflist
++ lappend fglist $cflist
++ scrollbar .bright.sb -command "$cflist yview"
++ pack .bright.sb -side right -fill y
++ pack $cflist -side left -fill both -expand 1
++ $cflist tag configure highlight \
++ -background [$cflist cget -selectbackground]
++ $cflist tag configure bold -font mainfontbold
++
++ .pwbottom add .bright
++ .ctop add .pwbottom
++
++ # restore window width & height if known
++ if {[info exists geometry(main)]} {
++ if {[scan $geometry(main) "%dx%d" w h] >= 2} {
++ if {$w > [winfo screenwidth .]} {
++ set w [winfo screenwidth .]
++ }
++ if {$h > [winfo screenheight .]} {
++ set h [winfo screenheight .]
++ }
++ wm geometry . "${w}x$h"
++ }
++ }
++
++ if {[tk windowingsystem] eq {aqua}} {
++ set M1B M1
++ } else {
++ set M1B Control
++ }
++
++ bind .pwbottom <Configure> {resizecdetpanes %W %w}
++ pack .ctop -fill both -expand 1
++ bindall <1> {selcanvline %W %x %y}
++ #bindall <B1-Motion> {selcanvline %W %x %y}
++ if {[tk windowingsystem] == "win32"} {
++ bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
++ bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
++ } else {
++ bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
++ bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
++ if {[tk windowingsystem] eq "aqua"} {
++ bindall <MouseWheel> {
++ set delta [expr {- (%D)}]
++ allcanvs yview scroll $delta units
++ }
++ }
++ }
++ bindall <2> "canvscan mark %W %x %y"
++ bindall <B2-Motion> "canvscan dragto %W %x %y"
++ bindkey <Home> selfirstline
++ bindkey <End> sellastline
++ bind . <Key-Up> "selnextline -1"
++ bind . <Key-Down> "selnextline 1"
++ bind . <Shift-Key-Up> "dofind -1 0"
++ bind . <Shift-Key-Down> "dofind 1 0"
++ bindkey <Key-Right> "goforw"
++ bindkey <Key-Left> "goback"
++ bind . <Key-Prior> "selnextpage -1"
++ bind . <Key-Next> "selnextpage 1"
++ bind . <$M1B-Home> "allcanvs yview moveto 0.0"
++ bind . <$M1B-End> "allcanvs yview moveto 1.0"
++ bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
++ bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
++ bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
++ bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
++ bindkey <Key-Delete> "$ctext yview scroll -1 pages"
++ bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
++ bindkey <Key-space> "$ctext yview scroll 1 pages"
++ bindkey p "selnextline -1"
++ bindkey n "selnextline 1"
++ bindkey z "goback"
++ bindkey x "goforw"
++ bindkey i "selnextline -1"
++ bindkey k "selnextline 1"
++ bindkey j "goback"
++ bindkey l "goforw"
++ bindkey b prevfile
++ bindkey d "$ctext yview scroll 18 units"
++ bindkey u "$ctext yview scroll -18 units"
++ bindkey / {dofind 1 1}
++ bindkey <Key-Return> {dofind 1 1}
++ bindkey ? {dofind -1 1}
++ bindkey f nextfile
++ bindkey <F5> updatecommits
++ bind . <$M1B-q> doquit
++ bind . <$M1B-f> {dofind 1 1}
++ bind . <$M1B-g> {dofind 1 0}
++ bind . <$M1B-r> dosearchback
++ bind . <$M1B-s> dosearch
++ bind . <$M1B-equal> {incrfont 1}
++ bind . <$M1B-plus> {incrfont 1}
++ bind . <$M1B-KP_Add> {incrfont 1}
++ bind . <$M1B-minus> {incrfont -1}
++ bind . <$M1B-KP_Subtract> {incrfont -1}
++ wm protocol . WM_DELETE_WINDOW doquit
++ bind . <Destroy> {stop_backends}
++ bind . <Button-1> "click %W"
++ bind $fstring <Key-Return> {dofind 1 1}
++ bind $sha1entry <Key-Return> gotocommit
++ bind $sha1entry <<PasteSelection>> clearsha1
++ bind $cflist <1> {sel_flist %W %x %y; break}
++ bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
++ bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
++ bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
++
++ set maincursor [. cget -cursor]
++ set textcursor [$ctext cget -cursor]
++ set curtextcursor $textcursor
++
++ set rowctxmenu .rowctxmenu
++ menu $rowctxmenu -tearoff 0
++ $rowctxmenu add command -label [mc "Diff this -> selected"] \
++ -command {diffvssel 0}
++ $rowctxmenu add command -label [mc "Diff selected -> this"] \
++ -command {diffvssel 1}
++ $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
++ $rowctxmenu add command -label [mc "Create tag"] -command mktag
++ $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
++ $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
++ $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
++ -command cherrypick
++ $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
++ -command resethead
++
++ set fakerowmenu .fakerowmenu
++ menu $fakerowmenu -tearoff 0
++ $fakerowmenu add command -label [mc "Diff this -> selected"] \
++ -command {diffvssel 0}
++ $fakerowmenu add command -label [mc "Diff selected -> this"] \
++ -command {diffvssel 1}
++ $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
++# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
++# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
++# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
++
++ set headctxmenu .headctxmenu
++ menu $headctxmenu -tearoff 0
++ $headctxmenu add command -label [mc "Check out this branch"] \
++ -command cobranch
++ $headctxmenu add command -label [mc "Remove this branch"] \
++ -command rmbranch
++
++ global flist_menu
++ set flist_menu .flistctxmenu
++ menu $flist_menu -tearoff 0
++ $flist_menu add command -label [mc "Highlight this too"] \
++ -command {flist_hl 0}
++ $flist_menu add command -label [mc "Highlight this only"] \
++ -command {flist_hl 1}
++ $flist_menu add command -label [mc "External diff"] \
++ -command {external_diff}
+++ $flist_menu add command -label [mc "Blame parent commit"] \
+++ -command {external_blame 1}
++}
++
++# Windows sends all mouse wheel events to the current focused window, not
++# the one where the mouse hovers, so bind those events here and redirect
++# to the correct window
++proc windows_mousewheel_redirector {W X Y D} {
++ global canv canv2 canv3
++ set w [winfo containing -displayof $W $X $Y]
++ if {$w ne ""} {
++ set u [expr {$D < 0 ? 5 : -5}]
++ if {$w == $canv || $w == $canv2 || $w == $canv3} {
++ allcanvs yview scroll $u units
++ } else {
++ catch {
++ $w yview scroll $u units
++ }
++ }
++ }
++}
++
++# Update row number label when selectedline changes
++proc selectedline_change {n1 n2 op} {
++ global selectedline rownumsel
++
++ if {$selectedline eq {}} {
++ set rownumsel {}
++ } else {
++ set rownumsel [expr {$selectedline + 1}]
++ }
++}
++
++# mouse-2 makes all windows scan vertically, but only the one
++# the cursor is in scans horizontally
++proc canvscan {op w x y} {
++ global canv canv2 canv3
++ foreach c [list $canv $canv2 $canv3] {
++ if {$c == $w} {
++ $c scan $op $x $y
++ } else {
++ $c scan $op 0 $y
++ }
++ }
++}
++
++proc scrollcanv {cscroll f0 f1} {
++ $cscroll set $f0 $f1
++ drawvisible
++ flushhighlights
++}
++
++# when we make a key binding for the toplevel, make sure
++# it doesn't get triggered when that key is pressed in the
++# find string entry widget.
++proc bindkey {ev script} {
++ global entries
++ bind . $ev $script
++ set escript [bind Entry $ev]
++ if {$escript == {}} {
++ set escript [bind Entry <Key>]
++ }
++ foreach e $entries {
++ bind $e $ev "$escript; break"
++ }
++}
++
++# set the focus back to the toplevel for any click outside
++# the entry widgets
++proc click {w} {
++ global ctext entries
++ foreach e [concat $entries $ctext] {
++ if {$w == $e} return
++ }
++ focus .
++}
++
++# Adjust the progress bar for a change in requested extent or canvas size
++proc adjustprogress {} {
++ global progresscanv progressitem progresscoords
++ global fprogitem fprogcoord lastprogupdate progupdatepending
++ global rprogitem rprogcoord
++
++ set w [expr {[winfo width $progresscanv] - 4}]
++ set x0 [expr {$w * [lindex $progresscoords 0]}]
++ set x1 [expr {$w * [lindex $progresscoords 1]}]
++ set h [winfo height $progresscanv]
++ $progresscanv coords $progressitem $x0 0 $x1 $h
++ $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
++ $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
++ set now [clock clicks -milliseconds]
++ if {$now >= $lastprogupdate + 100} {
++ set progupdatepending 0
++ update
++ } elseif {!$progupdatepending} {
++ set progupdatepending 1
++ after [expr {$lastprogupdate + 100 - $now}] doprogupdate
++ }
++}
++
++proc doprogupdate {} {
++ global lastprogupdate progupdatepending
++
++ if {$progupdatepending} {
++ set progupdatepending 0
++ set lastprogupdate [clock clicks -milliseconds]
++ update
++ }
++}
++
++proc savestuff {w} {
++ global canv canv2 canv3 mainfont textfont uifont tabstop
++ global stuffsaved findmergefiles maxgraphpct
++ global maxwidth showneartags showlocalchanges
++ global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
++ global cmitmode wrapcomment datetimeformat limitdiffs
++ global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
++ global autoselect extdifftool
++
++ if {$stuffsaved} return
++ if {![winfo viewable .]} return
++ catch {
++ set f [open "~/.gitk-new" w]
++ puts $f [list set mainfont $mainfont]
++ puts $f [list set textfont $textfont]
++ puts $f [list set uifont $uifont]
++ puts $f [list set tabstop $tabstop]
++ puts $f [list set findmergefiles $findmergefiles]
++ puts $f [list set maxgraphpct $maxgraphpct]
++ puts $f [list set maxwidth $maxwidth]
++ puts $f [list set cmitmode $cmitmode]
++ puts $f [list set wrapcomment $wrapcomment]
++ puts $f [list set autoselect $autoselect]
++ puts $f [list set showneartags $showneartags]
++ puts $f [list set showlocalchanges $showlocalchanges]
++ puts $f [list set datetimeformat $datetimeformat]
++ puts $f [list set limitdiffs $limitdiffs]
++ puts $f [list set bgcolor $bgcolor]
++ puts $f [list set fgcolor $fgcolor]
++ puts $f [list set colors $colors]
++ puts $f [list set diffcolors $diffcolors]
++ puts $f [list set diffcontext $diffcontext]
++ puts $f [list set selectbgcolor $selectbgcolor]
++ puts $f [list set extdifftool $extdifftool]
++
++ puts $f "set geometry(main) [wm geometry .]"
++ puts $f "set geometry(topwidth) [winfo width .tf]"
++ puts $f "set geometry(topheight) [winfo height .tf]"
++ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
++ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
++ puts $f "set geometry(botwidth) [winfo width .bleft]"
++ puts $f "set geometry(botheight) [winfo height .bleft]"
++
++ puts -nonewline $f "set permviews {"
++ for {set v 0} {$v < $nextviewnum} {incr v} {
++ if {$viewperm($v)} {
++ puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
++ }
++ }
++ puts $f "}"
++ close $f
++ file rename -force "~/.gitk-new" "~/.gitk"
++ }
++ set stuffsaved 1
++}
++
++proc resizeclistpanes {win w} {
++ global oldwidth
++ if {[info exists oldwidth($win)]} {
++ set s0 [$win sash coord 0]
++ set s1 [$win sash coord 1]
++ if {$w < 60} {
++ set sash0 [expr {int($w/2 - 2)}]
++ set sash1 [expr {int($w*5/6 - 2)}]
++ } else {
++ set factor [expr {1.0 * $w / $oldwidth($win)}]
++ set sash0 [expr {int($factor * [lindex $s0 0])}]
++ set sash1 [expr {int($factor * [lindex $s1 0])}]
++ if {$sash0 < 30} {
++ set sash0 30
++ }
++ if {$sash1 < $sash0 + 20} {
++ set sash1 [expr {$sash0 + 20}]
++ }
++ if {$sash1 > $w - 10} {
++ set sash1 [expr {$w - 10}]
++ if {$sash0 > $sash1 - 20} {
++ set sash0 [expr {$sash1 - 20}]
++ }
++ }
++ }
++ $win sash place 0 $sash0 [lindex $s0 1]
++ $win sash place 1 $sash1 [lindex $s1 1]
++ }
++ set oldwidth($win) $w
++}
++
++proc resizecdetpanes {win w} {
++ global oldwidth
++ if {[info exists oldwidth($win)]} {
++ set s0 [$win sash coord 0]
++ if {$w < 60} {
++ set sash0 [expr {int($w*3/4 - 2)}]
++ } else {
++ set factor [expr {1.0 * $w / $oldwidth($win)}]
++ set sash0 [expr {int($factor * [lindex $s0 0])}]
++ if {$sash0 < 45} {
++ set sash0 45
++ }
++ if {$sash0 > $w - 15} {
++ set sash0 [expr {$w - 15}]
++ }
++ }
++ $win sash place 0 $sash0 [lindex $s0 1]
++ }
++ set oldwidth($win) $w
++}
++
++proc allcanvs args {
++ global canv canv2 canv3
++ eval $canv $args
++ eval $canv2 $args
++ eval $canv3 $args
++}
++
++proc bindall {event action} {
++ global canv canv2 canv3
++ bind $canv $event $action
++ bind $canv2 $event $action
++ bind $canv3 $event $action
++}
++
++proc about {} {
++ global uifont
++ set w .about
++ if {[winfo exists $w]} {
++ raise $w
++ return
++ }
++ toplevel $w
++ wm title $w [mc "About gitk"]
++ message $w.m -text [mc "
++Gitk - a commit viewer for git
++
++Copyright © 2005-2008 Paul Mackerras
++
++Use and redistribute under the terms of the GNU General Public License"] \
++ -justify center -aspect 400 -border 2 -bg white -relief groove
++ pack $w.m -side top -fill x -padx 2 -pady 2
++ button $w.ok -text [mc "Close"] -command "destroy $w" -default active
++ pack $w.ok -side bottom
++ bind $w <Visibility> "focus $w.ok"
++ bind $w <Key-Escape> "destroy $w"
++ bind $w <Key-Return> "destroy $w"
++}
++
++proc keys {} {
++ set w .keys
++ if {[winfo exists $w]} {
++ raise $w
++ return
++ }
++ if {[tk windowingsystem] eq {aqua}} {
++ set M1T Cmd
++ } else {
++ set M1T Ctrl
++ }
++ toplevel $w
++ wm title $w [mc "Gitk key bindings"]
++ message $w.m -text "
++[mc "Gitk key bindings:"]
++
++[mc "<%s-Q> Quit" $M1T]
++[mc "<Home> Move to first commit"]
++[mc "<End> Move to last commit"]
++[mc "<Up>, p, i Move up one commit"]
++[mc "<Down>, n, k Move down one commit"]
++[mc "<Left>, z, j Go back in history list"]
++[mc "<Right>, x, l Go forward in history list"]
++[mc "<PageUp> Move up one page in commit list"]
++[mc "<PageDown> Move down one page in commit list"]
++[mc "<%s-Home> Scroll to top of commit list" $M1T]
++[mc "<%s-End> Scroll to bottom of commit list" $M1T]
++[mc "<%s-Up> Scroll commit list up one line" $M1T]
++[mc "<%s-Down> Scroll commit list down one line" $M1T]
++[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
++[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
++[mc "<Shift-Up> Find backwards (upwards, later commits)"]
++[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
++[mc "<Delete>, b Scroll diff view up one page"]
++[mc "<Backspace> Scroll diff view up one page"]
++[mc "<Space> Scroll diff view down one page"]
++[mc "u Scroll diff view up 18 lines"]
++[mc "d Scroll diff view down 18 lines"]
++[mc "<%s-F> Find" $M1T]
++[mc "<%s-G> Move to next find hit" $M1T]
++[mc "<Return> Move to next find hit"]
++[mc "/ Move to next find hit, or redo find"]
++[mc "? Move to previous find hit"]
++[mc "f Scroll diff view to next file"]
++[mc "<%s-S> Search for next hit in diff view" $M1T]
++[mc "<%s-R> Search for previous hit in diff view" $M1T]
++[mc "<%s-KP+> Increase font size" $M1T]
++[mc "<%s-plus> Increase font size" $M1T]
++[mc "<%s-KP-> Decrease font size" $M1T]
++[mc "<%s-minus> Decrease font size" $M1T]
++[mc "<F5> Update"]
++" \
++ -justify left -bg white -border 2 -relief groove
++ pack $w.m -side top -fill both -padx 2 -pady 2
++ button $w.ok -text [mc "Close"] -command "destroy $w" -default active
++ pack $w.ok -side bottom
++ bind $w <Visibility> "focus $w.ok"
++ bind $w <Key-Escape> "destroy $w"
++ bind $w <Key-Return> "destroy $w"
++}
++
++# Procedures for manipulating the file list window at the
++# bottom right of the overall window.
++
++proc treeview {w l openlevs} {
++ global treecontents treediropen treeheight treeparent treeindex
++
++ set ix 0
++ set treeindex() 0
++ set lev 0
++ set prefix {}
++ set prefixend -1
++ set prefendstack {}
++ set htstack {}
++ set ht 0
++ set treecontents() {}
++ $w conf -state normal
++ foreach f $l {
++ while {[string range $f 0 $prefixend] ne $prefix} {
++ if {$lev <= $openlevs} {
++ $w mark set e:$treeindex($prefix) "end -1c"
++ $w mark gravity e:$treeindex($prefix) left
++ }
++ set treeheight($prefix) $ht
++ incr ht [lindex $htstack end]
++ set htstack [lreplace $htstack end end]
++ set prefixend [lindex $prefendstack end]
++ set prefendstack [lreplace $prefendstack end end]
++ set prefix [string range $prefix 0 $prefixend]
++ incr lev -1
++ }
++ set tail [string range $f [expr {$prefixend+1}] end]
++ while {[set slash [string first "/" $tail]] >= 0} {
++ lappend htstack $ht
++ set ht 0
++ lappend prefendstack $prefixend
++ incr prefixend [expr {$slash + 1}]
++ set d [string range $tail 0 $slash]
++ lappend treecontents($prefix) $d
++ set oldprefix $prefix
++ append prefix $d
++ set treecontents($prefix) {}
++ set treeindex($prefix) [incr ix]
++ set treeparent($prefix) $oldprefix
++ set tail [string range $tail [expr {$slash+1}] end]
++ if {$lev <= $openlevs} {
++ set ht 1
++ set treediropen($prefix) [expr {$lev < $openlevs}]
++ set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
++ $w mark set d:$ix "end -1c"
++ $w mark gravity d:$ix left
++ set str "\n"
++ for {set i 0} {$i < $lev} {incr i} {append str "\t"}
++ $w insert end $str
++ $w image create end -align center -image $bm -padx 1 \
++ -name a:$ix
++ $w insert end $d [highlight_tag $prefix]
++ $w mark set s:$ix "end -1c"
++ $w mark gravity s:$ix left
++ }
++ incr lev
++ }
++ if {$tail ne {}} {
++ if {$lev <= $openlevs} {
++ incr ht
++ set str "\n"
++ for {set i 0} {$i < $lev} {incr i} {append str "\t"}
++ $w insert end $str
++ $w insert end $tail [highlight_tag $f]
++ }
++ lappend treecontents($prefix) $tail
++ }
++ }
++ while {$htstack ne {}} {
++ set treeheight($prefix) $ht
++ incr ht [lindex $htstack end]
++ set htstack [lreplace $htstack end end]
++ set prefixend [lindex $prefendstack end]
++ set prefendstack [lreplace $prefendstack end end]
++ set prefix [string range $prefix 0 $prefixend]
++ }
++ $w conf -state disabled
++}
++
++proc linetoelt {l} {
++ global treeheight treecontents
++
++ set y 2
++ set prefix {}
++ while {1} {
++ foreach e $treecontents($prefix) {
++ if {$y == $l} {
++ return "$prefix$e"
++ }
++ set n 1
++ if {[string index $e end] eq "/"} {
++ set n $treeheight($prefix$e)
++ if {$y + $n > $l} {
++ append prefix $e
++ incr y
++ break
++ }
++ }
++ incr y $n
++ }
++ }
++}
++
++proc highlight_tree {y prefix} {
++ global treeheight treecontents cflist
++
++ foreach e $treecontents($prefix) {
++ set path $prefix$e
++ if {[highlight_tag $path] ne {}} {
++ $cflist tag add bold $y.0 "$y.0 lineend"
++ }
++ incr y
++ if {[string index $e end] eq "/" && $treeheight($path) > 1} {
++ set y [highlight_tree $y $path]
++ }
++ }
++ return $y
++}
++
++proc treeclosedir {w dir} {
++ global treediropen treeheight treeparent treeindex
++
++ set ix $treeindex($dir)
++ $w conf -state normal
++ $w delete s:$ix e:$ix
++ set treediropen($dir) 0
++ $w image configure a:$ix -image tri-rt
++ $w conf -state disabled
++ set n [expr {1 - $treeheight($dir)}]
++ while {$dir ne {}} {
++ incr treeheight($dir) $n
++ set dir $treeparent($dir)
++ }
++}
++
++proc treeopendir {w dir} {
++ global treediropen treeheight treeparent treecontents treeindex
++
++ set ix $treeindex($dir)
++ $w conf -state normal
++ $w image configure a:$ix -image tri-dn
++ $w mark set e:$ix s:$ix
++ $w mark gravity e:$ix right
++ set lev 0
++ set str "\n"
++ set n [llength $treecontents($dir)]
++ for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
++ incr lev
++ append str "\t"
++ incr treeheight($x) $n
++ }
++ foreach e $treecontents($dir) {
++ set de $dir$e
++ if {[string index $e end] eq "/"} {
++ set iy $treeindex($de)
++ $w mark set d:$iy e:$ix
++ $w mark gravity d:$iy left
++ $w insert e:$ix $str
++ set treediropen($de) 0
++ $w image create e:$ix -align center -image tri-rt -padx 1 \
++ -name a:$iy
++ $w insert e:$ix $e [highlight_tag $de]
++ $w mark set s:$iy e:$ix
++ $w mark gravity s:$iy left
++ set treeheight($de) 1
++ } else {
++ $w insert e:$ix $str
++ $w insert e:$ix $e [highlight_tag $de]
++ }
++ }
++ $w mark gravity e:$ix left
++ $w conf -state disabled
++ set treediropen($dir) 1
++ set top [lindex [split [$w index @0,0] .] 0]
++ set ht [$w cget -height]
++ set l [lindex [split [$w index s:$ix] .] 0]
++ if {$l < $top} {
++ $w yview $l.0
++ } elseif {$l + $n + 1 > $top + $ht} {
++ set top [expr {$l + $n + 2 - $ht}]
++ if {$l < $top} {
++ set top $l
++ }
++ $w yview $top.0
++ }
++}
++
++proc treeclick {w x y} {
++ global treediropen cmitmode ctext cflist cflist_top
++
++ if {$cmitmode ne "tree"} return
++ if {![info exists cflist_top]} return
++ set l [lindex [split [$w index "@$x,$y"] "."] 0]
++ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
++ $cflist tag add highlight $l.0 "$l.0 lineend"
++ set cflist_top $l
++ if {$l == 1} {
++ $ctext yview 1.0
++ return
++ }
++ set e [linetoelt $l]
++ if {[string index $e end] ne "/"} {
++ showfile $e
++ } elseif {$treediropen($e)} {
++ treeclosedir $w $e
++ } else {
++ treeopendir $w $e
++ }
++}
++
++proc setfilelist {id} {
++ global treefilelist cflist
++
++ treeview $cflist $treefilelist($id) 0
++}
++
++image create bitmap tri-rt -background black -foreground blue -data {
++ #define tri-rt_width 13
++ #define tri-rt_height 13
++ static unsigned char tri-rt_bits[] = {
++ 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
++ 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
++ 0x00, 0x00};
++} -maskdata {
++ #define tri-rt-mask_width 13
++ #define tri-rt-mask_height 13
++ static unsigned char tri-rt-mask_bits[] = {
++ 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
++ 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
++ 0x08, 0x00};
++}
++image create bitmap tri-dn -background black -foreground blue -data {
++ #define tri-dn_width 13
++ #define tri-dn_height 13
++ static unsigned char tri-dn_bits[] = {
++ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
++ 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
++ 0x00, 0x00};
++} -maskdata {
++ #define tri-dn-mask_width 13
++ #define tri-dn-mask_height 13
++ static unsigned char tri-dn-mask_bits[] = {
++ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
++ 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
++ 0x00, 0x00};
++}
++
++image create bitmap reficon-T -background black -foreground yellow -data {
++ #define tagicon_width 13
++ #define tagicon_height 9
++ static unsigned char tagicon_bits[] = {
++ 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
++ 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
++} -maskdata {
++ #define tagicon-mask_width 13
++ #define tagicon-mask_height 9
++ static unsigned char tagicon-mask_bits[] = {
++ 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
++ 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
++}
++set rectdata {
++ #define headicon_width 13
++ #define headicon_height 9
++ static unsigned char headicon_bits[] = {
++ 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
++ 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
++}
++set rectmask {
++ #define headicon-mask_width 13
++ #define headicon-mask_height 9
++ static unsigned char headicon-mask_bits[] = {
++ 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
++ 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
++}
++image create bitmap reficon-H -background black -foreground green \
++ -data $rectdata -maskdata $rectmask
++image create bitmap reficon-o -background black -foreground "#ddddff" \
++ -data $rectdata -maskdata $rectmask
++
++proc init_flist {first} {
++ global cflist cflist_top difffilestart
++
++ $cflist conf -state normal
++ $cflist delete 0.0 end
++ if {$first ne {}} {
++ $cflist insert end $first
++ set cflist_top 1
++ $cflist tag add highlight 1.0 "1.0 lineend"
++ } else {
++ catch {unset cflist_top}
++ }
++ $cflist conf -state disabled
++ set difffilestart {}
++}
++
++proc highlight_tag {f} {
++ global highlight_paths
++
++ foreach p $highlight_paths {
++ if {[string match $p $f]} {
++ return "bold"
++ }
++ }
++ return {}
++}
++
++proc highlight_filelist {} {
++ global cmitmode cflist
++
++ $cflist conf -state normal
++ if {$cmitmode ne "tree"} {
++ set end [lindex [split [$cflist index end] .] 0]
++ for {set l 2} {$l < $end} {incr l} {
++ set line [$cflist get $l.0 "$l.0 lineend"]
++ if {[highlight_tag $line] ne {}} {
++ $cflist tag add bold $l.0 "$l.0 lineend"
++ }
++ }
++ } else {
++ highlight_tree 2 {}
++ }
++ $cflist conf -state disabled
++}
++
++proc unhighlight_filelist {} {
++ global cflist
++
++ $cflist conf -state normal
++ $cflist tag remove bold 1.0 end
++ $cflist conf -state disabled
++}
++
++proc add_flist {fl} {
++ global cflist
++
++ $cflist conf -state normal
++ foreach f $fl {
++ $cflist insert end "\n"
++ $cflist insert end $f [highlight_tag $f]
++ }
++ $cflist conf -state disabled
++}
++
++proc sel_flist {w x y} {
++ global ctext difffilestart cflist cflist_top cmitmode
++
++ if {$cmitmode eq "tree"} return
++ if {![info exists cflist_top]} return
++ set l [lindex [split [$w index "@$x,$y"] "."] 0]
++ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
++ $cflist tag add highlight $l.0 "$l.0 lineend"
++ set cflist_top $l
++ if {$l == 1} {
++ $ctext yview 1.0
++ } else {
++ catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
++ }
++}
++
++proc pop_flist_menu {w X Y x y} {
++ global ctext cflist cmitmode flist_menu flist_menu_file
++ global treediffs diffids
++
++ stopfinding
++ set l [lindex [split [$w index "@$x,$y"] "."] 0]
++ if {$l <= 1} return
++ if {$cmitmode eq "tree"} {
++ set e [linetoelt $l]
++ if {[string index $e end] eq "/"} return
++ } else {
++ set e [lindex $treediffs($diffids) [expr {$l-2}]]
++ }
++ set flist_menu_file $e
++ set xdiffstate "normal"
++ if {$cmitmode eq "tree"} {
++ set xdiffstate "disabled"
++ }
++ # Disable "External diff" item in tree mode
++ $flist_menu entryconf 2 -state $xdiffstate
++ tk_popup $flist_menu $X $Y
++}
++
++proc flist_hl {only} {
++ global flist_menu_file findstring gdttype
++
++ set x [shellquote $flist_menu_file]
++ if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
++ set findstring $x
++ } else {
++ append findstring " " $x
++ }
++ set gdttype [mc "touching paths:"]
++}
++
++proc save_file_from_commit {filename output what} {
++ global nullfile
++
++ if {[catch {exec git show $filename -- > $output} err]} {
++ if {[string match "fatal: bad revision *" $err]} {
++ return $nullfile
++ }
++ error_popup "Error getting \"$filename\" from $what: $err"
++ return {}
++ }
++ return $output
++}
++
++proc external_diff_get_one_file {diffid filename diffdir} {
++ global nullid nullid2 nullfile
++ global gitdir
++
++ if {$diffid == $nullid} {
++ set difffile [file join [file dirname $gitdir] $filename]
++ if {[file exists $difffile]} {
++ return $difffile
++ }
++ return $nullfile
++ }
++ if {$diffid == $nullid2} {
++ set difffile [file join $diffdir "\[index\] [file tail $filename]"]
++ return [save_file_from_commit :$filename $difffile index]
++ }
++ set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
++ return [save_file_from_commit $diffid:$filename $difffile \
++ "revision $diffid"]
++}
++
++proc external_diff {} {
++ global gitktmpdir nullid nullid2
++ global flist_menu_file
++ global diffids
++ global diffnum
++ global gitdir extdifftool
++
++ if {[llength $diffids] == 1} {
++ # no reference commit given
++ set diffidto [lindex $diffids 0]
++ if {$diffidto eq $nullid} {
++ # diffing working copy with index
++ set diffidfrom $nullid2
++ } elseif {$diffidto eq $nullid2} {
++ # diffing index with HEAD
++ set diffidfrom "HEAD"
++ } else {
++ # use first parent commit
++ global parentlist selectedline
++ set diffidfrom [lindex $parentlist $selectedline 0]
++ }
++ } else {
++ set diffidfrom [lindex $diffids 0]
++ set diffidto [lindex $diffids 1]
++ }
++
++ # make sure that several diffs wont collide
++ if {![info exists gitktmpdir]} {
++ set gitktmpdir [file join [file dirname $gitdir] \
++ [format ".gitk-tmp.%s" [pid]]]
++ if {[catch {file mkdir $gitktmpdir} err]} {
++ error_popup "Error creating temporary directory $gitktmpdir: $err"
++ unset gitktmpdir
++ return
++ }
++ set diffnum 0
++ }
++ incr diffnum
++ set diffdir [file join $gitktmpdir $diffnum]
++ if {[catch {file mkdir $diffdir} err]} {
++ error_popup "Error creating temporary directory $diffdir: $err"
++ return
++ }
++
++ # gather files to diff
++ set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
++ set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
++
++ if {$difffromfile ne {} && $difftofile ne {}} {
++ set cmd [concat | [shellsplit $extdifftool] \
++ [list $difffromfile $difftofile]]
++ if {[catch {set fl [open $cmd r]} err]} {
++ file delete -force $diffdir
++ error_popup [mc "$extdifftool: command failed: $err"]
++ } else {
++ fconfigure $fl -blocking 0
++ filerun $fl [list delete_at_eof $fl $diffdir]
++ }
++ }
++}
++
+++proc external_blame {parent_idx} {
+++ global flist_menu_file
+++ global nullid nullid2
+++ global parentlist selectedline currentid
+++
+++ if {$parent_idx > 0} {
+++ set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
+++ } else {
+++ set base_commit $currentid
+++ }
+++
+++ if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
+++ error_popup [mc "No such commit"]
+++ return
+++ }
+++
+++ if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
+++ error_popup [mc "git gui blame: command failed: $err"]
+++ }
+++}
+++
++# delete $dir when we see eof on $f (presumably because the child has exited)
++proc delete_at_eof {f dir} {
++ while {[gets $f line] >= 0} {}
++ if {[eof $f]} {
++ if {[catch {close $f} err]} {
++ error_popup "External diff viewer failed: $err"
++ }
++ file delete -force $dir
++ return 0
++ }
++ return 1
++}
++
++# Functions for adding and removing shell-type quoting
++
++proc shellquote {str} {
++ if {![string match "*\['\"\\ \t]*" $str]} {
++ return $str
++ }
++ if {![string match "*\['\"\\]*" $str]} {
++ return "\"$str\""
++ }
++ if {![string match "*'*" $str]} {
++ return "'$str'"
++ }
++ return "\"[string map {\" \\\" \\ \\\\} $str]\""
++}
++
++proc shellarglist {l} {
++ set str {}
++ foreach a $l {
++ if {$str ne {}} {
++ append str " "
++ }
++ append str [shellquote $a]
++ }
++ return $str
++}
++
++proc shelldequote {str} {
++ set ret {}
++ set used -1
++ while {1} {
++ incr used
++ if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
++ append ret [string range $str $used end]
++ set used [string length $str]
++ break
++ }
++ set first [lindex $first 0]
++ set ch [string index $str $first]
++ if {$first > $used} {
++ append ret [string range $str $used [expr {$first - 1}]]
++ set used $first
++ }
++ if {$ch eq " " || $ch eq "\t"} break
++ incr used
++ if {$ch eq "'"} {
++ set first [string first "'" $str $used]
++ if {$first < 0} {
++ error "unmatched single-quote"
++ }
++ append ret [string range $str $used [expr {$first - 1}]]
++ set used $first
++ continue
++ }
++ if {$ch eq "\\"} {
++ if {$used >= [string length $str]} {
++ error "trailing backslash"
++ }
++ append ret [string index $str $used]
++ continue
++ }
++ # here ch == "\""
++ while {1} {
++ if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
++ error "unmatched double-quote"
++ }
++ set first [lindex $first 0]
++ set ch [string index $str $first]
++ if {$first > $used} {
++ append ret [string range $str $used [expr {$first - 1}]]
++ set used $first
++ }
++ if {$ch eq "\""} break
++ incr used
++ append ret [string index $str $used]
++ incr used
++ }
++ }
++ return [list $used $ret]
++}
++
++proc shellsplit {str} {
++ set l {}
++ while {1} {
++ set str [string trimleft $str]
++ if {$str eq {}} break
++ set dq [shelldequote $str]
++ set n [lindex $dq 0]
++ set word [lindex $dq 1]
++ set str [string range $str $n end]
++ lappend l $word
++ }
++ return $l
++}
++
++# Code to implement multiple views
++
++proc newview {ishighlight} {
++ global nextviewnum newviewname newviewperm newishighlight
++ global newviewargs revtreeargs viewargscmd newviewargscmd curview
++
++ set newishighlight $ishighlight
++ set top .gitkview
++ if {[winfo exists $top]} {
++ raise $top
++ return
++ }
++ set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
++ set newviewperm($nextviewnum) 0
++ set newviewargs($nextviewnum) [shellarglist $revtreeargs]
++ set newviewargscmd($nextviewnum) $viewargscmd($curview)
++ vieweditor $top $nextviewnum [mc "Gitk view definition"]
++}
++
++proc editview {} {
++ global curview
++ global viewname viewperm newviewname newviewperm
++ global viewargs newviewargs viewargscmd newviewargscmd
++
++ set top .gitkvedit-$curview
++ if {[winfo exists $top]} {
++ raise $top
++ return
++ }
++ set newviewname($curview) $viewname($curview)
++ set newviewperm($curview) $viewperm($curview)
++ set newviewargs($curview) [shellarglist $viewargs($curview)]
++ set newviewargscmd($curview) $viewargscmd($curview)
++ vieweditor $top $curview "Gitk: edit view $viewname($curview)"
++}
++
++proc vieweditor {top n title} {
++ global newviewname newviewperm viewfiles bgcolor
++
++ toplevel $top
++ wm title $top $title
++ label $top.nl -text [mc "Name"]
++ entry $top.name -width 20 -textvariable newviewname($n)
++ grid $top.nl $top.name -sticky w -pady 5
++ checkbutton $top.perm -text [mc "Remember this view"] \
++ -variable newviewperm($n)
++ grid $top.perm - -pady 5 -sticky w
++ message $top.al -aspect 1000 \
++ -text [mc "Commits to include (arguments to git log):"]
++ grid $top.al - -sticky w -pady 5
++ entry $top.args -width 50 -textvariable newviewargs($n) \
++ -background $bgcolor
++ grid $top.args - -sticky ew -padx 5
++
++ message $top.ac -aspect 1000 \
++ -text [mc "Command to generate more commits to include:"]
++ grid $top.ac - -sticky w -pady 5
++ entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
++ -background white
++ grid $top.argscmd - -sticky ew -padx 5
++
++ message $top.l -aspect 1000 \
++ -text [mc "Enter files and directories to include, one per line:"]
++ grid $top.l - -sticky w
++ text $top.t -width 40 -height 10 -background $bgcolor -font uifont
++ if {[info exists viewfiles($n)]} {
++ foreach f $viewfiles($n) {
++ $top.t insert end $f
++ $top.t insert end "\n"
++ }
++ $top.t delete {end - 1c} end
++ $top.t mark set insert 0.0
++ }
++ grid $top.t - -sticky ew -padx 5
++ frame $top.buts
++ button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
++ button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
++ grid $top.buts.ok $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - -pady 10 -sticky ew
++ focus $top.t
++}
++
++proc doviewmenu {m first cmd op argv} {
++ set nmenu [$m index end]
++ for {set i $first} {$i <= $nmenu} {incr i} {
++ if {[$m entrycget $i -command] eq $cmd} {
++ eval $m $op $i $argv
++ break
++ }
++ }
++}
++
++proc allviewmenus {n op args} {
++ # global viewhlmenu
++
++ doviewmenu .bar.view 5 [list showview $n] $op $args
++ # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
++}
++
++proc newviewok {top n} {
++ global nextviewnum newviewperm newviewname newishighlight
++ global viewname viewfiles viewperm selectedview curview
++ global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
++
++ if {[catch {
++ set newargs [shellsplit $newviewargs($n)]
++ } err]} {
++ error_popup "[mc "Error in commit selection arguments:"] $err"
++ wm raise $top
++ focus $top
++ return
++ }
++ set files {}
++ foreach f [split [$top.t get 0.0 end] "\n"] {
++ set ft [string trim $f]
++ if {$ft ne {}} {
++ lappend files $ft
++ }
++ }
++ if {![info exists viewfiles($n)]} {
++ # creating a new view
++ incr nextviewnum
++ set viewname($n) $newviewname($n)
++ set viewperm($n) $newviewperm($n)
++ set viewfiles($n) $files
++ set viewargs($n) $newargs
++ set viewargscmd($n) $newviewargscmd($n)
++ addviewmenu $n
++ if {!$newishighlight} {
++ run showview $n
++ } else {
++ run addvhighlight $n
++ }
++ } else {
++ # editing an existing view
++ set viewperm($n) $newviewperm($n)
++ if {$newviewname($n) ne $viewname($n)} {
++ set viewname($n) $newviewname($n)
++ doviewmenu .bar.view 5 [list showview $n] \
++ entryconf [list -label $viewname($n)]
++ # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
++ # entryconf [list -label $viewname($n) -value $viewname($n)]
++ }
++ if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
++ $newviewargscmd($n) ne $viewargscmd($n)} {
++ set viewfiles($n) $files
++ set viewargs($n) $newargs
++ set viewargscmd($n) $newviewargscmd($n)
++ if {$curview == $n} {
++ run reloadcommits
++ }
++ }
++ }
++ catch {destroy $top}
++}
++
++proc delview {} {
++ global curview viewperm hlview selectedhlview
++
++ if {$curview == 0} return
++ if {[info exists hlview] && $hlview == $curview} {
++ set selectedhlview [mc "None"]
++ unset hlview
++ }
++ allviewmenus $curview delete
++ set viewperm($curview) 0
++ showview 0
++}
++
++proc addviewmenu {n} {
++ global viewname viewhlmenu
++
++ .bar.view add radiobutton -label $viewname($n) \
++ -command [list showview $n] -variable selectedview -value $n
++ #$viewhlmenu add radiobutton -label $viewname($n) \
++ # -command [list addvhighlight $n] -variable selectedhlview
++}
++
++proc showview {n} {
++ global curview cached_commitrow ordertok
++ global displayorder parentlist rowidlist rowisopt rowfinal
++ global colormap rowtextx nextcolor canvxmax
++ global numcommits viewcomplete
++ global selectedline currentid canv canvy0
++ global treediffs
++ global pending_select mainheadid
++ global commitidx
++ global selectedview
++ global hlview selectedhlview commitinterest
++
++ if {$n == $curview} return
++ set selid {}
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ set span [$canv yview]
++ set ytop [expr {[lindex $span 0] * $ymax}]
++ set ybot [expr {[lindex $span 1] * $ymax}]
++ set yscreen [expr {($ybot - $ytop) / 2}]
++ if {$selectedline ne {}} {
++ set selid $currentid
++ set y [yc $selectedline]
++ if {$ytop < $y && $y < $ybot} {
++ set yscreen [expr {$y - $ytop}]
++ }
++ } elseif {[info exists pending_select]} {
++ set selid $pending_select
++ unset pending_select
++ }
++ unselectline
++ normalline
++ catch {unset treediffs}
++ clear_display
++ if {[info exists hlview] && $hlview == $n} {
++ unset hlview
++ set selectedhlview [mc "None"]
++ }
++ catch {unset commitinterest}
++ catch {unset cached_commitrow}
++ catch {unset ordertok}
++
++ set curview $n
++ set selectedview $n
++ .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
++ .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
++
++ run refill_reflist
++ if {![info exists viewcomplete($n)]} {
++ getcommits $selid
++ return
++ }
++
++ set displayorder {}
++ set parentlist {}
++ set rowidlist {}
++ set rowisopt {}
++ set rowfinal {}
++ set numcommits $commitidx($n)
++
++ catch {unset colormap}
++ catch {unset rowtextx}
++ set nextcolor 0
++ set canvxmax [$canv cget -width]
++ set curview $n
++ set row 0
++ setcanvscroll
++ set yf 0
++ set row {}
++ if {$selid ne {} && [commitinview $selid $n]} {
++ set row [rowofcommit $selid]
++ # try to get the selected row in the same position on the screen
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ set ytop [expr {[yc $row] - $yscreen}]
++ if {$ytop < 0} {
++ set ytop 0
++ }
++ set yf [expr {$ytop * 1.0 / $ymax}]
++ }
++ allcanvs yview moveto $yf
++ drawvisible
++ if {$row ne {}} {
++ selectline $row 0
++ } elseif {!$viewcomplete($n)} {
++ reset_pending_select $selid
++ } else {
++ reset_pending_select {}
++
++ if {[commitinview $pending_select $curview]} {
++ selectline [rowofcommit $pending_select] 1
++ } else {
++ set row [first_real_row]
++ if {$row < $numcommits} {
++ selectline $row 0
++ }
++ }
++ }
++ if {!$viewcomplete($n)} {
++ if {$numcommits == 0} {
++ show_status [mc "Reading commits..."]
++ }
++ } elseif {$numcommits == 0} {
++ show_status [mc "No commits selected"]
++ }
++}
++
++# Stuff relating to the highlighting facility
++
++proc ishighlighted {id} {
++ global vhighlights fhighlights nhighlights rhighlights
++
++ if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
++ return $nhighlights($id)
++ }
++ if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
++ return $vhighlights($id)
++ }
++ if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
++ return $fhighlights($id)
++ }
++ if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
++ return $rhighlights($id)
++ }
++ return 0
++}
++
++proc bolden {row font} {
++ global canv linehtag selectedline boldrows
++
++ lappend boldrows $row
++ $canv itemconf $linehtag($row) -font $font
++ if {$row == $selectedline} {
++ $canv delete secsel
++ set t [eval $canv create rect [$canv bbox $linehtag($row)] \
++ -outline {{}} -tags secsel \
++ -fill [$canv cget -selectbackground]]
++ $canv lower $t
++ }
++}
++
++proc bolden_name {row font} {
++ global canv2 linentag selectedline boldnamerows
++
++ lappend boldnamerows $row
++ $canv2 itemconf $linentag($row) -font $font
++ if {$row == $selectedline} {
++ $canv2 delete secsel
++ set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
++ -outline {{}} -tags secsel \
++ -fill [$canv2 cget -selectbackground]]
++ $canv2 lower $t
++ }
++}
++
++proc unbolden {} {
++ global boldrows
++
++ set stillbold {}
++ foreach row $boldrows {
++ if {![ishighlighted [commitonrow $row]]} {
++ bolden $row mainfont
++ } else {
++ lappend stillbold $row
++ }
++ }
++ set boldrows $stillbold
++}
++
++proc addvhighlight {n} {
++ global hlview viewcomplete curview vhl_done commitidx
++
++ if {[info exists hlview]} {
++ delvhighlight
++ }
++ set hlview $n
++ if {$n != $curview && ![info exists viewcomplete($n)]} {
++ start_rev_list $n
++ }
++ set vhl_done $commitidx($hlview)
++ if {$vhl_done > 0} {
++ drawvisible
++ }
++}
++
++proc delvhighlight {} {
++ global hlview vhighlights
++
++ if {![info exists hlview]} return
++ unset hlview
++ catch {unset vhighlights}
++ unbolden
++}
++
++proc vhighlightmore {} {
++ global hlview vhl_done commitidx vhighlights curview
++
++ set max $commitidx($hlview)
++ set vr [visiblerows]
++ set r0 [lindex $vr 0]
++ set r1 [lindex $vr 1]
++ for {set i $vhl_done} {$i < $max} {incr i} {
++ set id [commitonrow $i $hlview]
++ if {[commitinview $id $curview]} {
++ set row [rowofcommit $id]
++ if {$r0 <= $row && $row <= $r1} {
++ if {![highlighted $row]} {
++ bolden $row mainfontbold
++ }
++ set vhighlights($id) 1
++ }
++ }
++ }
++ set vhl_done $max
++ return 0
++}
++
++proc askvhighlight {row id} {
++ global hlview vhighlights iddrawn
++
++ if {[commitinview $id $hlview]} {
++ if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
++ bolden $row mainfontbold
++ }
++ set vhighlights($id) 1
++ } else {
++ set vhighlights($id) 0
++ }
++}
++
++proc hfiles_change {} {
++ global highlight_files filehighlight fhighlights fh_serial
++ global highlight_paths gdttype
++
++ if {[info exists filehighlight]} {
++ # delete previous highlights
++ catch {close $filehighlight}
++ unset filehighlight
++ catch {unset fhighlights}
++ unbolden
++ unhighlight_filelist
++ }
++ set highlight_paths {}
++ after cancel do_file_hl $fh_serial
++ incr fh_serial
++ if {$highlight_files ne {}} {
++ after 300 do_file_hl $fh_serial
++ }
++}
++
++proc gdttype_change {name ix op} {
++ global gdttype highlight_files findstring findpattern
++
++ stopfinding
++ if {$findstring ne {}} {
++ if {$gdttype eq [mc "containing:"]} {
++ if {$highlight_files ne {}} {
++ set highlight_files {}
++ hfiles_change
++ }
++ findcom_change
++ } else {
++ if {$findpattern ne {}} {
++ set findpattern {}
++ findcom_change
++ }
++ set highlight_files $findstring
++ hfiles_change
++ }
++ drawvisible
++ }
++ # enable/disable findtype/findloc menus too
++}
++
++proc find_change {name ix op} {
++ global gdttype findstring highlight_files
++
++ stopfinding
++ if {$gdttype eq [mc "containing:"]} {
++ findcom_change
++ } else {
++ if {$highlight_files ne $findstring} {
++ set highlight_files $findstring
++ hfiles_change
++ }
++ }
++ drawvisible
++}
++
++proc findcom_change args {
++ global nhighlights boldnamerows
++ global findpattern findtype findstring gdttype
++
++ stopfinding
++ # delete previous highlights, if any
++ foreach row $boldnamerows {
++ bolden_name $row mainfont
++ }
++ set boldnamerows {}
++ catch {unset nhighlights}
++ unbolden
++ unmarkmatches
++ if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
++ set findpattern {}
++ } elseif {$findtype eq [mc "Regexp"]} {
++ set findpattern $findstring
++ } else {
++ set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
++ $findstring]
++ set findpattern "*$e*"
++ }
++}
++
++proc makepatterns {l} {
++ set ret {}
++ foreach e $l {
++ set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
++ if {[string index $ee end] eq "/"} {
++ lappend ret "$ee*"
++ } else {
++ lappend ret $ee
++ lappend ret "$ee/*"
++ }
++ }
++ return $ret
++}
++
++proc do_file_hl {serial} {
++ global highlight_files filehighlight highlight_paths gdttype fhl_list
++
++ if {$gdttype eq [mc "touching paths:"]} {
++ if {[catch {set paths [shellsplit $highlight_files]}]} return
++ set highlight_paths [makepatterns $paths]
++ highlight_filelist
++ set gdtargs [concat -- $paths]
++ } elseif {$gdttype eq [mc "adding/removing string:"]} {
++ set gdtargs [list "-S$highlight_files"]
++ } else {
++ # must be "containing:", i.e. we're searching commit info
++ return
++ }
++ set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
++ set filehighlight [open $cmd r+]
++ fconfigure $filehighlight -blocking 0
++ filerun $filehighlight readfhighlight
++ set fhl_list {}
++ drawvisible
++ flushhighlights
++}
++
++proc flushhighlights {} {
++ global filehighlight fhl_list
++
++ if {[info exists filehighlight]} {
++ lappend fhl_list {}
++ puts $filehighlight ""
++ flush $filehighlight
++ }
++}
++
++proc askfilehighlight {row id} {
++ global filehighlight fhighlights fhl_list
++
++ lappend fhl_list $id
++ set fhighlights($id) -1
++ puts $filehighlight $id
++}
++
++proc readfhighlight {} {
++ global filehighlight fhighlights curview iddrawn
++ global fhl_list find_dirn
++
++ if {![info exists filehighlight]} {
++ return 0
++ }
++ set nr 0
++ while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
++ set line [string trim $line]
++ set i [lsearch -exact $fhl_list $line]
++ if {$i < 0} continue
++ for {set j 0} {$j < $i} {incr j} {
++ set id [lindex $fhl_list $j]
++ set fhighlights($id) 0
++ }
++ set fhl_list [lrange $fhl_list [expr {$i+1}] end]
++ if {$line eq {}} continue
++ if {![commitinview $line $curview]} continue
++ set row [rowofcommit $line]
++ if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
++ bolden $row mainfontbold
++ }
++ set fhighlights($line) 1
++ }
++ if {[eof $filehighlight]} {
++ # strange...
++ puts "oops, git diff-tree died"
++ catch {close $filehighlight}
++ unset filehighlight
++ return 0
++ }
++ if {[info exists find_dirn]} {
++ run findmore
++ }
++ return 1
++}
++
++proc doesmatch {f} {
++ global findtype findpattern
++
++ if {$findtype eq [mc "Regexp"]} {
++ return [regexp $findpattern $f]
++ } elseif {$findtype eq [mc "IgnCase"]} {
++ return [string match -nocase $findpattern $f]
++ } else {
++ return [string match $findpattern $f]
++ }
++}
++
++proc askfindhighlight {row id} {
++ global nhighlights commitinfo iddrawn
++ global findloc
++ global markingmatches
++
++ if {![info exists commitinfo($id)]} {
++ getcommit $id
++ }
++ set info $commitinfo($id)
++ set isbold 0
++ set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
++ foreach f $info ty $fldtypes {
++ if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
++ [doesmatch $f]} {
++ if {$ty eq [mc "Author"]} {
++ set isbold 2
++ break
++ }
++ set isbold 1
++ }
++ }
++ if {$isbold && [info exists iddrawn($id)]} {
++ if {![ishighlighted $id]} {
++ bolden $row mainfontbold
++ if {$isbold > 1} {
++ bolden_name $row mainfontbold
++ }
++ }
++ if {$markingmatches} {
++ markrowmatches $row $id
++ }
++ }
++ set nhighlights($id) $isbold
++}
++
++proc markrowmatches {row id} {
++ global canv canv2 linehtag linentag commitinfo findloc
++
++ set headline [lindex $commitinfo($id) 0]
++ set author [lindex $commitinfo($id) 1]
++ $canv delete match$row
++ $canv2 delete match$row
++ if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
++ set m [findmatches $headline]
++ if {$m ne {}} {
++ markmatches $canv $row $headline $linehtag($row) $m \
++ [$canv itemcget $linehtag($row) -font] $row
++ }
++ }
++ if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
++ set m [findmatches $author]
++ if {$m ne {}} {
++ markmatches $canv2 $row $author $linentag($row) $m \
++ [$canv2 itemcget $linentag($row) -font] $row
++ }
++ }
++}
++
++proc vrel_change {name ix op} {
++ global highlight_related
++
++ rhighlight_none
++ if {$highlight_related ne [mc "None"]} {
++ run drawvisible
++ }
++}
++
++# prepare for testing whether commits are descendents or ancestors of a
++proc rhighlight_sel {a} {
++ global descendent desc_todo ancestor anc_todo
++ global highlight_related
++
++ catch {unset descendent}
++ set desc_todo [list $a]
++ catch {unset ancestor}
++ set anc_todo [list $a]
++ if {$highlight_related ne [mc "None"]} {
++ rhighlight_none
++ run drawvisible
++ }
++}
++
++proc rhighlight_none {} {
++ global rhighlights
++
++ catch {unset rhighlights}
++ unbolden
++}
++
++proc is_descendent {a} {
++ global curview children descendent desc_todo
++
++ set v $curview
++ set la [rowofcommit $a]
++ set todo $desc_todo
++ set leftover {}
++ set done 0
++ for {set i 0} {$i < [llength $todo]} {incr i} {
++ set do [lindex $todo $i]
++ if {[rowofcommit $do] < $la} {
++ lappend leftover $do
++ continue
++ }
++ foreach nk $children($v,$do) {
++ if {![info exists descendent($nk)]} {
++ set descendent($nk) 1
++ lappend todo $nk
++ if {$nk eq $a} {
++ set done 1
++ }
++ }
++ }
++ if {$done} {
++ set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
++ return
++ }
++ }
++ set descendent($a) 0
++ set desc_todo $leftover
++}
++
++proc is_ancestor {a} {
++ global curview parents ancestor anc_todo
++
++ set v $curview
++ set la [rowofcommit $a]
++ set todo $anc_todo
++ set leftover {}
++ set done 0
++ for {set i 0} {$i < [llength $todo]} {incr i} {
++ set do [lindex $todo $i]
++ if {![commitinview $do $v] || [rowofcommit $do] > $la} {
++ lappend leftover $do
++ continue
++ }
++ foreach np $parents($v,$do) {
++ if {![info exists ancestor($np)]} {
++ set ancestor($np) 1
++ lappend todo $np
++ if {$np eq $a} {
++ set done 1
++ }
++ }
++ }
++ if {$done} {
++ set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
++ return
++ }
++ }
++ set ancestor($a) 0
++ set anc_todo $leftover
++}
++
++proc askrelhighlight {row id} {
++ global descendent highlight_related iddrawn rhighlights
++ global selectedline ancestor
++
++ if {$selectedline eq {}} return
++ set isbold 0
++ if {$highlight_related eq [mc "Descendant"] ||
++ $highlight_related eq [mc "Not descendant"]} {
++ if {![info exists descendent($id)]} {
++ is_descendent $id
++ }
++ if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
++ set isbold 1
++ }
++ } elseif {$highlight_related eq [mc "Ancestor"] ||
++ $highlight_related eq [mc "Not ancestor"]} {
++ if {![info exists ancestor($id)]} {
++ is_ancestor $id
++ }
++ if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
++ set isbold 1
++ }
++ }
++ if {[info exists iddrawn($id)]} {
++ if {$isbold && ![ishighlighted $id]} {
++ bolden $row mainfontbold
++ }
++ }
++ set rhighlights($id) $isbold
++}
++
++# Graph layout functions
++
++proc shortids {ids} {
++ set res {}
++ foreach id $ids {
++ if {[llength $id] > 1} {
++ lappend res [shortids $id]
++ } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
++ lappend res [string range $id 0 7]
++ } else {
++ lappend res $id
++ }
++ }
++ return $res
++}
++
++proc ntimes {n o} {
++ set ret {}
++ set o [list $o]
++ for {set mask 1} {$mask <= $n} {incr mask $mask} {
++ if {($n & $mask) != 0} {
++ set ret [concat $ret $o]
++ }
++ set o [concat $o $o]
++ }
++ return $ret
++}
++
++proc ordertoken {id} {
++ global ordertok curview varcid varcstart varctok curview parents children
++ global nullid nullid2
++
++ if {[info exists ordertok($id)]} {
++ return $ordertok($id)
++ }
++ set origid $id
++ set todo {}
++ while {1} {
++ if {[info exists varcid($curview,$id)]} {
++ set a $varcid($curview,$id)
++ set p [lindex $varcstart($curview) $a]
++ } else {
++ set p [lindex $children($curview,$id) 0]
++ }
++ if {[info exists ordertok($p)]} {
++ set tok $ordertok($p)
++ break
++ }
++ set id [first_real_child $curview,$p]
++ if {$id eq {}} {
++ # it's a root
++ set tok [lindex $varctok($curview) $varcid($curview,$p)]
++ break
++ }
++ if {[llength $parents($curview,$id)] == 1} {
++ lappend todo [list $p {}]
++ } else {
++ set j [lsearch -exact $parents($curview,$id) $p]
++ if {$j < 0} {
++ puts "oops didn't find [shortids $p] in parents of [shortids $id]"
++ }
++ lappend todo [list $p [strrep $j]]
++ }
++ }
++ for {set i [llength $todo]} {[incr i -1] >= 0} {} {
++ set p [lindex $todo $i 0]
++ append tok [lindex $todo $i 1]
++ set ordertok($p) $tok
++ }
++ set ordertok($origid) $tok
++ return $tok
++}
++
++# Work out where id should go in idlist so that order-token
++# values increase from left to right
++proc idcol {idlist id {i 0}} {
++ set t [ordertoken $id]
++ if {$i < 0} {
++ set i 0
++ }
++ if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
++ if {$i > [llength $idlist]} {
++ set i [llength $idlist]
++ }
++ while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
++ incr i
++ } else {
++ if {$t > [ordertoken [lindex $idlist $i]]} {
++ while {[incr i] < [llength $idlist] &&
++ $t >= [ordertoken [lindex $idlist $i]]} {}
++ }
++ }
++ return $i
++}
++
++proc initlayout {} {
++ global rowidlist rowisopt rowfinal displayorder parentlist
++ global numcommits canvxmax canv
++ global nextcolor
++ global colormap rowtextx
++
++ set numcommits 0
++ set displayorder {}
++ set parentlist {}
++ set nextcolor 0
++ set rowidlist {}
++ set rowisopt {}
++ set rowfinal {}
++ set canvxmax [$canv cget -width]
++ catch {unset colormap}
++ catch {unset rowtextx}
++ setcanvscroll
++}
++
++proc setcanvscroll {} {
++ global canv canv2 canv3 numcommits linespc canvxmax canvy0
++ global lastscrollset lastscrollrows
++
++ set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
++ $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
++ $canv2 conf -scrollregion [list 0 0 0 $ymax]
++ $canv3 conf -scrollregion [list 0 0 0 $ymax]
++ set lastscrollset [clock clicks -milliseconds]
++ set lastscrollrows $numcommits
++}
++
++proc visiblerows {} {
++ global canv numcommits linespc
++
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax eq {} || $ymax == 0} return
++ set f [$canv yview]
++ set y0 [expr {int([lindex $f 0] * $ymax)}]
++ set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
++ if {$r0 < 0} {
++ set r0 0
++ }
++ set y1 [expr {int([lindex $f 1] * $ymax)}]
++ set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
++ if {$r1 >= $numcommits} {
++ set r1 [expr {$numcommits - 1}]
++ }
++ return [list $r0 $r1]
++}
++
++proc layoutmore {} {
++ global commitidx viewcomplete curview
++ global numcommits pending_select curview
++ global lastscrollset lastscrollrows commitinterest
++
++ if {$lastscrollrows < 100 || $viewcomplete($curview) ||
++ [clock clicks -milliseconds] - $lastscrollset > 500} {
++ setcanvscroll
++ }
++ if {[info exists pending_select] &&
++ [commitinview $pending_select $curview]} {
++ update
++ selectline [rowofcommit $pending_select] 1
++ }
++ drawvisible
++}
++
++proc doshowlocalchanges {} {
++ global curview mainheadid
++
++ if {$mainheadid eq {}} return
++ if {[commitinview $mainheadid $curview]} {
++ dodiffindex
++ } else {
++ lappend commitinterest($mainheadid) {dodiffindex}
++ }
++}
++
++proc dohidelocalchanges {} {
++ global nullid nullid2 lserial curview
++
++ if {[commitinview $nullid $curview]} {
++ removefakerow $nullid
++ }
++ if {[commitinview $nullid2 $curview]} {
++ removefakerow $nullid2
++ }
++ incr lserial
++}
++
++# spawn off a process to do git diff-index --cached HEAD
++proc dodiffindex {} {
++ global lserial showlocalchanges
++ global isworktree
++
++ if {!$showlocalchanges || !$isworktree} return
++ incr lserial
++ set fd [open "|git diff-index --cached HEAD" r]
++ fconfigure $fd -blocking 0
++ set i [reg_instance $fd]
++ filerun $fd [list readdiffindex $fd $lserial $i]
++}
++
++proc readdiffindex {fd serial inst} {
++ global mainheadid nullid nullid2 curview commitinfo commitdata lserial
++
++ set isdiff 1
++ if {[gets $fd line] < 0} {
++ if {![eof $fd]} {
++ return 1
++ }
++ set isdiff 0
++ }
++ # we only need to see one line and we don't really care what it says...
++ stop_instance $inst
++
++ if {$serial != $lserial} {
++ return 0
++ }
++
++ # now see if there are any local changes not checked in to the index
++ set fd [open "|git diff-files" r]
++ fconfigure $fd -blocking 0
++ set i [reg_instance $fd]
++ filerun $fd [list readdifffiles $fd $serial $i]
++
++ if {$isdiff && ![commitinview $nullid2 $curview]} {
++ # add the line for the changes in the index to the graph
++ set hl [mc "Local changes checked in to index but not committed"]
++ set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
++ set commitdata($nullid2) "\n $hl\n"
++ if {[commitinview $nullid $curview]} {
++ removefakerow $nullid
++ }
++ insertfakerow $nullid2 $mainheadid
++ } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
++ removefakerow $nullid2
++ }
++ return 0
++}
++
++proc readdifffiles {fd serial inst} {
++ global mainheadid nullid nullid2 curview
++ global commitinfo commitdata lserial
++
++ set isdiff 1
++ if {[gets $fd line] < 0} {
++ if {![eof $fd]} {
++ return 1
++ }
++ set isdiff 0
++ }
++ # we only need to see one line and we don't really care what it says...
++ stop_instance $inst
++
++ if {$serial != $lserial} {
++ return 0
++ }
++
++ if {$isdiff && ![commitinview $nullid $curview]} {
++ # add the line for the local diff to the graph
++ set hl [mc "Local uncommitted changes, not checked in to index"]
++ set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
++ set commitdata($nullid) "\n $hl\n"
++ if {[commitinview $nullid2 $curview]} {
++ set p $nullid2
++ } else {
++ set p $mainheadid
++ }
++ insertfakerow $nullid $p
++ } elseif {!$isdiff && [commitinview $nullid $curview]} {
++ removefakerow $nullid
++ }
++ return 0
++}
++
++proc nextuse {id row} {
++ global curview children
++
++ if {[info exists children($curview,$id)]} {
++ foreach kid $children($curview,$id) {
++ if {![commitinview $kid $curview]} {
++ return -1
++ }
++ if {[rowofcommit $kid] > $row} {
++ return [rowofcommit $kid]
++ }
++ }
++ }
++ if {[commitinview $id $curview]} {
++ return [rowofcommit $id]
++ }
++ return -1
++}
++
++proc prevuse {id row} {
++ global curview children
++
++ set ret -1
++ if {[info exists children($curview,$id)]} {
++ foreach kid $children($curview,$id) {
++ if {![commitinview $kid $curview]} break
++ if {[rowofcommit $kid] < $row} {
++ set ret [rowofcommit $kid]
++ }
++ }
++ }
++ return $ret
++}
++
++proc make_idlist {row} {
++ global displayorder parentlist uparrowlen downarrowlen mingaplen
++ global commitidx curview children
++
++ set r [expr {$row - $mingaplen - $downarrowlen - 1}]
++ if {$r < 0} {
++ set r 0
++ }
++ set ra [expr {$row - $downarrowlen}]
++ if {$ra < 0} {
++ set ra 0
++ }
++ set rb [expr {$row + $uparrowlen}]
++ if {$rb > $commitidx($curview)} {
++ set rb $commitidx($curview)
++ }
++ make_disporder $r [expr {$rb + 1}]
++ set ids {}
++ for {} {$r < $ra} {incr r} {
++ set nextid [lindex $displayorder [expr {$r + 1}]]
++ foreach p [lindex $parentlist $r] {
++ if {$p eq $nextid} continue
++ set rn [nextuse $p $r]
++ if {$rn >= $row &&
++ $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
++ lappend ids [list [ordertoken $p] $p]
++ }
++ }
++ }
++ for {} {$r < $row} {incr r} {
++ set nextid [lindex $displayorder [expr {$r + 1}]]
++ foreach p [lindex $parentlist $r] {
++ if {$p eq $nextid} continue
++ set rn [nextuse $p $r]
++ if {$rn < 0 || $rn >= $row} {
++ lappend ids [list [ordertoken $p] $p]
++ }
++ }
++ }
++ set id [lindex $displayorder $row]
++ lappend ids [list [ordertoken $id] $id]
++ while {$r < $rb} {
++ foreach p [lindex $parentlist $r] {
++ set firstkid [lindex $children($curview,$p) 0]
++ if {[rowofcommit $firstkid] < $row} {
++ lappend ids [list [ordertoken $p] $p]
++ }
++ }
++ incr r
++ set id [lindex $displayorder $r]
++ if {$id ne {}} {
++ set firstkid [lindex $children($curview,$id) 0]
++ if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
++ lappend ids [list [ordertoken $id] $id]
++ }
++ }
++ }
++ set idlist {}
++ foreach idx [lsort -unique $ids] {
++ lappend idlist [lindex $idx 1]
++ }
++ return $idlist
++}
++
++proc rowsequal {a b} {
++ while {[set i [lsearch -exact $a {}]] >= 0} {
++ set a [lreplace $a $i $i]
++ }
++ while {[set i [lsearch -exact $b {}]] >= 0} {
++ set b [lreplace $b $i $i]
++ }
++ return [expr {$a eq $b}]
++}
++
++proc makeupline {id row rend col} {
++ global rowidlist uparrowlen downarrowlen mingaplen
++
++ for {set r $rend} {1} {set r $rstart} {
++ set rstart [prevuse $id $r]
++ if {$rstart < 0} return
++ if {$rstart < $row} break
++ }
++ if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
++ set rstart [expr {$rend - $uparrowlen - 1}]
++ }
++ for {set r $rstart} {[incr r] <= $row} {} {
++ set idlist [lindex $rowidlist $r]
++ if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
++ set col [idcol $idlist $id $col]
++ lset rowidlist $r [linsert $idlist $col $id]
++ changedrow $r
++ }
++ }
++}
++
++proc layoutrows {row endrow} {
++ global rowidlist rowisopt rowfinal displayorder
++ global uparrowlen downarrowlen maxwidth mingaplen
++ global children parentlist
++ global commitidx viewcomplete curview
++
++ make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
++ set idlist {}
++ if {$row > 0} {
++ set rm1 [expr {$row - 1}]
++ foreach id [lindex $rowidlist $rm1] {
++ if {$id ne {}} {
++ lappend idlist $id
++ }
++ }
++ set final [lindex $rowfinal $rm1]
++ }
++ for {} {$row < $endrow} {incr row} {
++ set rm1 [expr {$row - 1}]
++ if {$rm1 < 0 || $idlist eq {}} {
++ set idlist [make_idlist $row]
++ set final 1
++ } else {
++ set id [lindex $displayorder $rm1]
++ set col [lsearch -exact $idlist $id]
++ set idlist [lreplace $idlist $col $col]
++ foreach p [lindex $parentlist $rm1] {
++ if {[lsearch -exact $idlist $p] < 0} {
++ set col [idcol $idlist $p $col]
++ set idlist [linsert $idlist $col $p]
++ # if not the first child, we have to insert a line going up
++ if {$id ne [lindex $children($curview,$p) 0]} {
++ makeupline $p $rm1 $row $col
++ }
++ }
++ }
++ set id [lindex $displayorder $row]
++ if {$row > $downarrowlen} {
++ set termrow [expr {$row - $downarrowlen - 1}]
++ foreach p [lindex $parentlist $termrow] {
++ set i [lsearch -exact $idlist $p]
++ if {$i < 0} continue
++ set nr [nextuse $p $termrow]
++ if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
++ set idlist [lreplace $idlist $i $i]
++ }
++ }
++ }
++ set col [lsearch -exact $idlist $id]
++ if {$col < 0} {
++ set col [idcol $idlist $id]
++ set idlist [linsert $idlist $col $id]
++ if {$children($curview,$id) ne {}} {
++ makeupline $id $rm1 $row $col
++ }
++ }
++ set r [expr {$row + $uparrowlen - 1}]
++ if {$r < $commitidx($curview)} {
++ set x $col
++ foreach p [lindex $parentlist $r] {
++ if {[lsearch -exact $idlist $p] >= 0} continue
++ set fk [lindex $children($curview,$p) 0]
++ if {[rowofcommit $fk] < $row} {
++ set x [idcol $idlist $p $x]
++ set idlist [linsert $idlist $x $p]
++ }
++ }
++ if {[incr r] < $commitidx($curview)} {
++ set p [lindex $displayorder $r]
++ if {[lsearch -exact $idlist $p] < 0} {
++ set fk [lindex $children($curview,$p) 0]
++ if {$fk ne {} && [rowofcommit $fk] < $row} {
++ set x [idcol $idlist $p $x]
++ set idlist [linsert $idlist $x $p]
++ }
++ }
++ }
++ }
++ }
++ if {$final && !$viewcomplete($curview) &&
++ $row + $uparrowlen + $mingaplen + $downarrowlen
++ >= $commitidx($curview)} {
++ set final 0
++ }
++ set l [llength $rowidlist]
++ if {$row == $l} {
++ lappend rowidlist $idlist
++ lappend rowisopt 0
++ lappend rowfinal $final
++ } elseif {$row < $l} {
++ if {![rowsequal $idlist [lindex $rowidlist $row]]} {
++ lset rowidlist $row $idlist
++ changedrow $row
++ }
++ lset rowfinal $row $final
++ } else {
++ set pad [ntimes [expr {$row - $l}] {}]
++ set rowidlist [concat $rowidlist $pad]
++ lappend rowidlist $idlist
++ set rowfinal [concat $rowfinal $pad]
++ lappend rowfinal $final
++ set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
++ }
++ }
++ return $row
++}
++
++proc changedrow {row} {
++ global displayorder iddrawn rowisopt need_redisplay
++
++ set l [llength $rowisopt]
++ if {$row < $l} {
++ lset rowisopt $row 0
++ if {$row + 1 < $l} {
++ lset rowisopt [expr {$row + 1}] 0
++ if {$row + 2 < $l} {
++ lset rowisopt [expr {$row + 2}] 0
++ }
++ }
++ }
++ set id [lindex $displayorder $row]
++ if {[info exists iddrawn($id)]} {
++ set need_redisplay 1
++ }
++}
++
++proc insert_pad {row col npad} {
++ global rowidlist
++
++ set pad [ntimes $npad {}]
++ set idlist [lindex $rowidlist $row]
++ set bef [lrange $idlist 0 [expr {$col - 1}]]
++ set aft [lrange $idlist $col end]
++ set i [lsearch -exact $aft {}]
++ if {$i > 0} {
++ set aft [lreplace $aft $i $i]
++ }
++ lset rowidlist $row [concat $bef $pad $aft]
++ changedrow $row
++}
++
++proc optimize_rows {row col endrow} {
++ global rowidlist rowisopt displayorder curview children
++
++ if {$row < 1} {
++ set row 1
++ }
++ for {} {$row < $endrow} {incr row; set col 0} {
++ if {[lindex $rowisopt $row]} continue
++ set haspad 0
++ set y0 [expr {$row - 1}]
++ set ym [expr {$row - 2}]
++ set idlist [lindex $rowidlist $row]
++ set previdlist [lindex $rowidlist $y0]
++ if {$idlist eq {} || $previdlist eq {}} continue
++ if {$ym >= 0} {
++ set pprevidlist [lindex $rowidlist $ym]
++ if {$pprevidlist eq {}} continue
++ } else {
++ set pprevidlist {}
++ }
++ set x0 -1
++ set xm -1
++ for {} {$col < [llength $idlist]} {incr col} {
++ set id [lindex $idlist $col]
++ if {[lindex $previdlist $col] eq $id} continue
++ if {$id eq {}} {
++ set haspad 1
++ continue
++ }
++ set x0 [lsearch -exact $previdlist $id]
++ if {$x0 < 0} continue
++ set z [expr {$x0 - $col}]
++ set isarrow 0
++ set z0 {}
++ if {$ym >= 0} {
++ set xm [lsearch -exact $pprevidlist $id]
++ if {$xm >= 0} {
++ set z0 [expr {$xm - $x0}]
++ }
++ }
++ if {$z0 eq {}} {
++ # if row y0 is the first child of $id then it's not an arrow
++ if {[lindex $children($curview,$id) 0] ne
++ [lindex $displayorder $y0]} {
++ set isarrow 1
++ }
++ }
++ if {!$isarrow && $id ne [lindex $displayorder $row] &&
++ [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
++ set isarrow 1
++ }
++ # Looking at lines from this row to the previous row,
++ # make them go straight up if they end in an arrow on
++ # the previous row; otherwise make them go straight up
++ # or at 45 degrees.
++ if {$z < -1 || ($z < 0 && $isarrow)} {
++ # Line currently goes left too much;
++ # insert pads in the previous row, then optimize it
++ set npad [expr {-1 - $z + $isarrow}]
++ insert_pad $y0 $x0 $npad
++ if {$y0 > 0} {
++ optimize_rows $y0 $x0 $row
++ }
++ set previdlist [lindex $rowidlist $y0]
++ set x0 [lsearch -exact $previdlist $id]
++ set z [expr {$x0 - $col}]
++ if {$z0 ne {}} {
++ set pprevidlist [lindex $rowidlist $ym]
++ set xm [lsearch -exact $pprevidlist $id]
++ set z0 [expr {$xm - $x0}]
++ }
++ } elseif {$z > 1 || ($z > 0 && $isarrow)} {
++ # Line currently goes right too much;
++ # insert pads in this line
++ set npad [expr {$z - 1 + $isarrow}]
++ insert_pad $row $col $npad
++ set idlist [lindex $rowidlist $row]
++ incr col $npad
++ set z [expr {$x0 - $col}]
++ set haspad 1
++ }
++ if {$z0 eq {} && !$isarrow && $ym >= 0} {
++ # this line links to its first child on row $row-2
++ set id [lindex $displayorder $ym]
++ set xc [lsearch -exact $pprevidlist $id]
++ if {$xc >= 0} {
++ set z0 [expr {$xc - $x0}]
++ }
++ }
++ # avoid lines jigging left then immediately right
++ if {$z0 ne {} && $z < 0 && $z0 > 0} {
++ insert_pad $y0 $x0 1
++ incr x0
++ optimize_rows $y0 $x0 $row
++ set previdlist [lindex $rowidlist $y0]
++ }
++ }
++ if {!$haspad} {
++ # Find the first column that doesn't have a line going right
++ for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
++ set id [lindex $idlist $col]
++ if {$id eq {}} break
++ set x0 [lsearch -exact $previdlist $id]
++ if {$x0 < 0} {
++ # check if this is the link to the first child
++ set kid [lindex $displayorder $y0]
++ if {[lindex $children($curview,$id) 0] eq $kid} {
++ # it is, work out offset to child
++ set x0 [lsearch -exact $previdlist $kid]
++ }
++ }
++ if {$x0 <= $col} break
++ }
++ # Insert a pad at that column as long as it has a line and
++ # isn't the last column
++ if {$x0 >= 0 && [incr col] < [llength $idlist]} {
++ set idlist [linsert $idlist $col {}]
++ lset rowidlist $row $idlist
++ changedrow $row
++ }
++ }
++ }
++}
++
++proc xc {row col} {
++ global canvx0 linespc
++ return [expr {$canvx0 + $col * $linespc}]
++}
++
++proc yc {row} {
++ global canvy0 linespc
++ return [expr {$canvy0 + $row * $linespc}]
++}
++
++proc linewidth {id} {
++ global thickerline lthickness
++
++ set wid $lthickness
++ if {[info exists thickerline] && $id eq $thickerline} {
++ set wid [expr {2 * $lthickness}]
++ }
++ return $wid
++}
++
++proc rowranges {id} {
++ global curview children uparrowlen downarrowlen
++ global rowidlist
++
++ set kids $children($curview,$id)
++ if {$kids eq {}} {
++ return {}
++ }
++ set ret {}
++ lappend kids $id
++ foreach child $kids {
++ if {![commitinview $child $curview]} break
++ set row [rowofcommit $child]
++ if {![info exists prev]} {
++ lappend ret [expr {$row + 1}]
++ } else {
++ if {$row <= $prevrow} {
++ puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
++ }
++ # see if the line extends the whole way from prevrow to row
++ if {$row > $prevrow + $uparrowlen + $downarrowlen &&
++ [lsearch -exact [lindex $rowidlist \
++ [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
++ # it doesn't, see where it ends
++ set r [expr {$prevrow + $downarrowlen}]
++ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
++ while {[incr r -1] > $prevrow &&
++ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
++ } else {
++ while {[incr r] <= $row &&
++ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
++ incr r -1
++ }
++ lappend ret $r
++ # see where it starts up again
++ set r [expr {$row - $uparrowlen}]
++ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
++ while {[incr r] < $row &&
++ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
++ } else {
++ while {[incr r -1] >= $prevrow &&
++ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
++ incr r
++ }
++ lappend ret $r
++ }
++ }
++ if {$child eq $id} {
++ lappend ret $row
++ }
++ set prev $child
++ set prevrow $row
++ }
++ return $ret
++}
++
++proc drawlineseg {id row endrow arrowlow} {
++ global rowidlist displayorder iddrawn linesegs
++ global canv colormap linespc curview maxlinelen parentlist
++
++ set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
++ set le [expr {$row + 1}]
++ set arrowhigh 1
++ while {1} {
++ set c [lsearch -exact [lindex $rowidlist $le] $id]
++ if {$c < 0} {
++ incr le -1
++ break
++ }
++ lappend cols $c
++ set x [lindex $displayorder $le]
++ if {$x eq $id} {
++ set arrowhigh 0
++ break
++ }
++ if {[info exists iddrawn($x)] || $le == $endrow} {
++ set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
++ if {$c >= 0} {
++ lappend cols $c
++ set arrowhigh 0
++ }
++ break
++ }
++ incr le
++ }
++ if {$le <= $row} {
++ return $row
++ }
++
++ set lines {}
++ set i 0
++ set joinhigh 0
++ if {[info exists linesegs($id)]} {
++ set lines $linesegs($id)
++ foreach li $lines {
++ set r0 [lindex $li 0]
++ if {$r0 > $row} {
++ if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
++ set joinhigh 1
++ }
++ break
++ }
++ incr i
++ }
++ }
++ set joinlow 0
++ if {$i > 0} {
++ set li [lindex $lines [expr {$i-1}]]
++ set r1 [lindex $li 1]
++ if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
++ set joinlow 1
++ }
++ }
++
++ set x [lindex $cols [expr {$le - $row}]]
++ set xp [lindex $cols [expr {$le - 1 - $row}]]
++ set dir [expr {$xp - $x}]
++ if {$joinhigh} {
++ set ith [lindex $lines $i 2]
++ set coords [$canv coords $ith]
++ set ah [$canv itemcget $ith -arrow]
++ set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
++ set x2 [lindex $cols [expr {$le + 1 - $row}]]
++ if {$x2 ne {} && $x - $x2 == $dir} {
++ set coords [lrange $coords 0 end-2]
++ }
++ } else {
++ set coords [list [xc $le $x] [yc $le]]
++ }
++ if {$joinlow} {
++ set itl [lindex $lines [expr {$i-1}] 2]
++ set al [$canv itemcget $itl -arrow]
++ set arrowlow [expr {$al eq "last" || $al eq "both"}]
++ } elseif {$arrowlow} {
++ if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
++ [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
++ set arrowlow 0
++ }
++ }
++ set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
++ for {set y $le} {[incr y -1] > $row} {} {
++ set x $xp
++ set xp [lindex $cols [expr {$y - 1 - $row}]]
++ set ndir [expr {$xp - $x}]
++ if {$dir != $ndir || $xp < 0} {
++ lappend coords [xc $y $x] [yc $y]
++ }
++ set dir $ndir
++ }
++ if {!$joinlow} {
++ if {$xp < 0} {
++ # join parent line to first child
++ set ch [lindex $displayorder $row]
++ set xc [lsearch -exact [lindex $rowidlist $row] $ch]
++ if {$xc < 0} {
++ puts "oops: drawlineseg: child $ch not on row $row"
++ } elseif {$xc != $x} {
++ if {($arrowhigh && $le == $row + 1) || $dir == 0} {
++ set d [expr {int(0.5 * $linespc)}]
++ set x1 [xc $row $x]
++ if {$xc < $x} {
++ set x2 [expr {$x1 - $d}]
++ } else {
++ set x2 [expr {$x1 + $d}]
++ }
++ set y2 [yc $row]
++ set y1 [expr {$y2 + $d}]
++ lappend coords $x1 $y1 $x2 $y2
++ } elseif {$xc < $x - 1} {
++ lappend coords [xc $row [expr {$x-1}]] [yc $row]
++ } elseif {$xc > $x + 1} {
++ lappend coords [xc $row [expr {$x+1}]] [yc $row]
++ }
++ set x $xc
++ }
++ lappend coords [xc $row $x] [yc $row]
++ } else {
++ set xn [xc $row $xp]
++ set yn [yc $row]
++ lappend coords $xn $yn
++ }
++ if {!$joinhigh} {
++ assigncolor $id
++ set t [$canv create line $coords -width [linewidth $id] \
++ -fill $colormap($id) -tags lines.$id -arrow $arrow]
++ $canv lower $t
++ bindline $t $id
++ set lines [linsert $lines $i [list $row $le $t]]
++ } else {
++ $canv coords $ith $coords
++ if {$arrow ne $ah} {
++ $canv itemconf $ith -arrow $arrow
++ }
++ lset lines $i 0 $row
++ }
++ } else {
++ set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
++ set ndir [expr {$xo - $xp}]
++ set clow [$canv coords $itl]
++ if {$dir == $ndir} {
++ set clow [lrange $clow 2 end]
++ }
++ set coords [concat $coords $clow]
++ if {!$joinhigh} {
++ lset lines [expr {$i-1}] 1 $le
++ } else {
++ # coalesce two pieces
++ $canv delete $ith
++ set b [lindex $lines [expr {$i-1}] 0]
++ set e [lindex $lines $i 1]
++ set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
++ }
++ $canv coords $itl $coords
++ if {$arrow ne $al} {
++ $canv itemconf $itl -arrow $arrow
++ }
++ }
++
++ set linesegs($id) $lines
++ return $le
++}
++
++proc drawparentlinks {id row} {
++ global rowidlist canv colormap curview parentlist
++ global idpos linespc
++
++ set rowids [lindex $rowidlist $row]
++ set col [lsearch -exact $rowids $id]
++ if {$col < 0} return
++ set olds [lindex $parentlist $row]
++ set row2 [expr {$row + 1}]
++ set x [xc $row $col]
++ set y [yc $row]
++ set y2 [yc $row2]
++ set d [expr {int(0.5 * $linespc)}]
++ set ymid [expr {$y + $d}]
++ set ids [lindex $rowidlist $row2]
++ # rmx = right-most X coord used
++ set rmx 0
++ foreach p $olds {
++ set i [lsearch -exact $ids $p]
++ if {$i < 0} {
++ puts "oops, parent $p of $id not in list"
++ continue
++ }
++ set x2 [xc $row2 $i]
++ if {$x2 > $rmx} {
++ set rmx $x2
++ }
++ set j [lsearch -exact $rowids $p]
++ if {$j < 0} {
++ # drawlineseg will do this one for us
++ continue
++ }
++ assigncolor $p
++ # should handle duplicated parents here...
++ set coords [list $x $y]
++ if {$i != $col} {
++ # if attaching to a vertical segment, draw a smaller
++ # slant for visual distinctness
++ if {$i == $j} {
++ if {$i < $col} {
++ lappend coords [expr {$x2 + $d}] $y $x2 $ymid
++ } else {
++ lappend coords [expr {$x2 - $d}] $y $x2 $ymid
++ }
++ } elseif {$i < $col && $i < $j} {
++ # segment slants towards us already
++ lappend coords [xc $row $j] $y
++ } else {
++ if {$i < $col - 1} {
++ lappend coords [expr {$x2 + $linespc}] $y
++ } elseif {$i > $col + 1} {
++ lappend coords [expr {$x2 - $linespc}] $y
++ }
++ lappend coords $x2 $y2
++ }
++ } else {
++ lappend coords $x2 $y2
++ }
++ set t [$canv create line $coords -width [linewidth $p] \
++ -fill $colormap($p) -tags lines.$p]
++ $canv lower $t
++ bindline $t $p
++ }
++ if {$rmx > [lindex $idpos($id) 1]} {
++ lset idpos($id) 1 $rmx
++ redrawtags $id
++ }
++}
++
++proc drawlines {id} {
++ global canv
++
++ $canv itemconf lines.$id -width [linewidth $id]
++}
++
++proc drawcmittext {id row col} {
++ global linespc canv canv2 canv3 fgcolor curview
++ global cmitlisted commitinfo rowidlist parentlist
++ global rowtextx idpos idtags idheads idotherrefs
++ global linehtag linentag linedtag selectedline
++ global canvxmax boldrows boldnamerows fgcolor
++ global mainheadid nullid nullid2 circleitem circlecolors
++
++ # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
++ set listed $cmitlisted($curview,$id)
++ if {$id eq $nullid} {
++ set ofill red
++ } elseif {$id eq $nullid2} {
++ set ofill green
++ } elseif {$id eq $mainheadid} {
++ set ofill yellow
++ } else {
++ set ofill [lindex $circlecolors $listed]
++ }
++ set x [xc $row $col]
++ set y [yc $row]
++ set orad [expr {$linespc / 3}]
++ if {$listed <= 2} {
++ set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
++ [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
++ -fill $ofill -outline $fgcolor -width 1 -tags circle]
++ } elseif {$listed == 3} {
++ # triangle pointing left for left-side commits
++ set t [$canv create polygon \
++ [expr {$x - $orad}] $y \
++ [expr {$x + $orad - 1}] [expr {$y - $orad}] \
++ [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
++ -fill $ofill -outline $fgcolor -width 1 -tags circle]
++ } else {
++ # triangle pointing right for right-side commits
++ set t [$canv create polygon \
++ [expr {$x + $orad - 1}] $y \
++ [expr {$x - $orad}] [expr {$y - $orad}] \
++ [expr {$x - $orad}] [expr {$y + $orad - 1}] \
++ -fill $ofill -outline $fgcolor -width 1 -tags circle]
++ }
++ set circleitem($row) $t
++ $canv raise $t
++ $canv bind $t <1> {selcanvline {} %x %y}
++ set rmx [llength [lindex $rowidlist $row]]
++ set olds [lindex $parentlist $row]
++ if {$olds ne {}} {
++ set nextids [lindex $rowidlist [expr {$row + 1}]]
++ foreach p $olds {
++ set i [lsearch -exact $nextids $p]
++ if {$i > $rmx} {
++ set rmx $i
++ }
++ }
++ }
++ set xt [xc $row $rmx]
++ set rowtextx($row) $xt
++ set idpos($id) [list $x $xt $y]
++ if {[info exists idtags($id)] || [info exists idheads($id)]
++ || [info exists idotherrefs($id)]} {
++ set xt [drawtags $id $x $xt $y]
++ }
++ set headline [lindex $commitinfo($id) 0]
++ set name [lindex $commitinfo($id) 1]
++ set date [lindex $commitinfo($id) 2]
++ set date [formatdate $date]
++ set font mainfont
++ set nfont mainfont
++ set isbold [ishighlighted $id]
++ if {$isbold > 0} {
++ lappend boldrows $row
++ set font mainfontbold
++ if {$isbold > 1} {
++ lappend boldnamerows $row
++ set nfont mainfontbold
++ }
++ }
++ set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
++ -text $headline -font $font -tags text]
++ $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
++ set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
++ -text $name -font $nfont -tags text]
++ set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
++ -text $date -font mainfont -tags text]
++ if {$selectedline == $row} {
++ make_secsel $row
++ }
++ set xr [expr {$xt + [font measure $font $headline]}]
++ if {$xr > $canvxmax} {
++ set canvxmax $xr
++ setcanvscroll
++ }
++}
++
++proc drawcmitrow {row} {
++ global displayorder rowidlist nrows_drawn
++ global iddrawn markingmatches
++ global commitinfo numcommits
++ global filehighlight fhighlights findpattern nhighlights
++ global hlview vhighlights
++ global highlight_related rhighlights
++
++ if {$row >= $numcommits} return
++
++ set id [lindex $displayorder $row]
++ if {[info exists hlview] && ![info exists vhighlights($id)]} {
++ askvhighlight $row $id
++ }
++ if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
++ askfilehighlight $row $id
++ }
++ if {$findpattern ne {} && ![info exists nhighlights($id)]} {
++ askfindhighlight $row $id
++ }
++ if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
++ askrelhighlight $row $id
++ }
++ if {![info exists iddrawn($id)]} {
++ set col [lsearch -exact [lindex $rowidlist $row] $id]
++ if {$col < 0} {
++ puts "oops, row $row id $id not in list"
++ return
++ }
++ if {![info exists commitinfo($id)]} {
++ getcommit $id
++ }
++ assigncolor $id
++ drawcmittext $id $row $col
++ set iddrawn($id) 1
++ incr nrows_drawn
++ }
++ if {$markingmatches} {
++ markrowmatches $row $id
++ }
++}
++
++proc drawcommits {row {endrow {}}} {
++ global numcommits iddrawn displayorder curview need_redisplay
++ global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
++
++ if {$row < 0} {
++ set row 0
++ }
++ if {$endrow eq {}} {
++ set endrow $row
++ }
++ if {$endrow >= $numcommits} {
++ set endrow [expr {$numcommits - 1}]
++ }
++
++ set rl1 [expr {$row - $downarrowlen - 3}]
++ if {$rl1 < 0} {
++ set rl1 0
++ }
++ set ro1 [expr {$row - 3}]
++ if {$ro1 < 0} {
++ set ro1 0
++ }
++ set r2 [expr {$endrow + $uparrowlen + 3}]
++ if {$r2 > $numcommits} {
++ set r2 $numcommits
++ }
++ for {set r $rl1} {$r < $r2} {incr r} {
++ if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
++ if {$rl1 < $r} {
++ layoutrows $rl1 $r
++ }
++ set rl1 [expr {$r + 1}]
++ }
++ }
++ if {$rl1 < $r} {
++ layoutrows $rl1 $r
++ }
++ optimize_rows $ro1 0 $r2
++ if {$need_redisplay || $nrows_drawn > 2000} {
++ clear_display
++ drawvisible
++ }
++
++ # make the lines join to already-drawn rows either side
++ set r [expr {$row - 1}]
++ if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
++ set r $row
++ }
++ set er [expr {$endrow + 1}]
++ if {$er >= $numcommits ||
++ ![info exists iddrawn([lindex $displayorder $er])]} {
++ set er $endrow
++ }
++ for {} {$r <= $er} {incr r} {
++ set id [lindex $displayorder $r]
++ set wasdrawn [info exists iddrawn($id)]
++ drawcmitrow $r
++ if {$r == $er} break
++ set nextid [lindex $displayorder [expr {$r + 1}]]
++ if {$wasdrawn && [info exists iddrawn($nextid)]} continue
++ drawparentlinks $id $r
++
++ set rowids [lindex $rowidlist $r]
++ foreach lid $rowids {
++ if {$lid eq {}} continue
++ if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
++ if {$lid eq $id} {
++ # see if this is the first child of any of its parents
++ foreach p [lindex $parentlist $r] {
++ if {[lsearch -exact $rowids $p] < 0} {
++ # make this line extend up to the child
++ set lineend($p) [drawlineseg $p $r $er 0]
++ }
++ }
++ } else {
++ set lineend($lid) [drawlineseg $lid $r $er 1]
++ }
++ }
++ }
++}
++
++proc undolayout {row} {
++ global uparrowlen mingaplen downarrowlen
++ global rowidlist rowisopt rowfinal need_redisplay
++
++ set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
++ if {$r < 0} {
++ set r 0
++ }
++ if {[llength $rowidlist] > $r} {
++ incr r -1
++ set rowidlist [lrange $rowidlist 0 $r]
++ set rowfinal [lrange $rowfinal 0 $r]
++ set rowisopt [lrange $rowisopt 0 $r]
++ set need_redisplay 1
++ run drawvisible
++ }
++}
++
++proc drawvisible {} {
++ global canv linespc curview vrowmod selectedline targetrow targetid
++ global need_redisplay cscroll numcommits
++
++ set fs [$canv yview]
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
++ set f0 [lindex $fs 0]
++ set f1 [lindex $fs 1]
++ set y0 [expr {int($f0 * $ymax)}]
++ set y1 [expr {int($f1 * $ymax)}]
++
++ if {[info exists targetid]} {
++ if {[commitinview $targetid $curview]} {
++ set r [rowofcommit $targetid]
++ if {$r != $targetrow} {
++ # Fix up the scrollregion and change the scrolling position
++ # now that our target row has moved.
++ set diff [expr {($r - $targetrow) * $linespc}]
++ set targetrow $r
++ setcanvscroll
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ incr y0 $diff
++ incr y1 $diff
++ set f0 [expr {$y0 / $ymax}]
++ set f1 [expr {$y1 / $ymax}]
++ allcanvs yview moveto $f0
++ $cscroll set $f0 $f1
++ set need_redisplay 1
++ }
++ } else {
++ unset targetid
++ }
++ }
++
++ set row [expr {int(($y0 - 3) / $linespc) - 1}]
++ set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
++ if {$endrow >= $vrowmod($curview)} {
++ update_arcrows $curview
++ }
++ if {$selectedline ne {} &&
++ $row <= $selectedline && $selectedline <= $endrow} {
++ set targetrow $selectedline
++ } elseif {[info exists targetid]} {
++ set targetrow [expr {int(($row + $endrow) / 2)}]
++ }
++ if {[info exists targetrow]} {
++ if {$targetrow >= $numcommits} {
++ set targetrow [expr {$numcommits - 1}]
++ }
++ set targetid [commitonrow $targetrow]
++ }
++ drawcommits $row $endrow
++}
++
++proc clear_display {} {
++ global iddrawn linesegs need_redisplay nrows_drawn
++ global vhighlights fhighlights nhighlights rhighlights
++ global linehtag linentag linedtag boldrows boldnamerows
++
++ allcanvs delete all
++ catch {unset iddrawn}
++ catch {unset linesegs}
++ catch {unset linehtag}
++ catch {unset linentag}
++ catch {unset linedtag}
++ set boldrows {}
++ set boldnamerows {}
++ catch {unset vhighlights}
++ catch {unset fhighlights}
++ catch {unset nhighlights}
++ catch {unset rhighlights}
++ set need_redisplay 0
++ set nrows_drawn 0
++}
++
++proc findcrossings {id} {
++ global rowidlist parentlist numcommits displayorder
++
++ set cross {}
++ set ccross {}
++ foreach {s e} [rowranges $id] {
++ if {$e >= $numcommits} {
++ set e [expr {$numcommits - 1}]
++ }
++ if {$e <= $s} continue
++ for {set row $e} {[incr row -1] >= $s} {} {
++ set x [lsearch -exact [lindex $rowidlist $row] $id]
++ if {$x < 0} break
++ set olds [lindex $parentlist $row]
++ set kid [lindex $displayorder $row]
++ set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
++ if {$kidx < 0} continue
++ set nextrow [lindex $rowidlist [expr {$row + 1}]]
++ foreach p $olds {
++ set px [lsearch -exact $nextrow $p]
++ if {$px < 0} continue
++ if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
++ if {[lsearch -exact $ccross $p] >= 0} continue
++ if {$x == $px + ($kidx < $px? -1: 1)} {
++ lappend ccross $p
++ } elseif {[lsearch -exact $cross $p] < 0} {
++ lappend cross $p
++ }
++ }
++ }
++ }
++ }
++ return [concat $ccross {{}} $cross]
++}
++
++proc assigncolor {id} {
++ global colormap colors nextcolor
++ global parents children children curview
++
++ if {[info exists colormap($id)]} return
++ set ncolors [llength $colors]
++ if {[info exists children($curview,$id)]} {
++ set kids $children($curview,$id)
++ } else {
++ set kids {}
++ }
++ if {[llength $kids] == 1} {
++ set child [lindex $kids 0]
++ if {[info exists colormap($child)]
++ && [llength $parents($curview,$child)] == 1} {
++ set colormap($id) $colormap($child)
++ return
++ }
++ }
++ set badcolors {}
++ set origbad {}
++ foreach x [findcrossings $id] {
++ if {$x eq {}} {
++ # delimiter between corner crossings and other crossings
++ if {[llength $badcolors] >= $ncolors - 1} break
++ set origbad $badcolors
++ }
++ if {[info exists colormap($x)]
++ && [lsearch -exact $badcolors $colormap($x)] < 0} {
++ lappend badcolors $colormap($x)
++ }
++ }
++ if {[llength $badcolors] >= $ncolors} {
++ set badcolors $origbad
++ }
++ set origbad $badcolors
++ if {[llength $badcolors] < $ncolors - 1} {
++ foreach child $kids {
++ if {[info exists colormap($child)]
++ && [lsearch -exact $badcolors $colormap($child)] < 0} {
++ lappend badcolors $colormap($child)
++ }
++ foreach p $parents($curview,$child) {
++ if {[info exists colormap($p)]
++ && [lsearch -exact $badcolors $colormap($p)] < 0} {
++ lappend badcolors $colormap($p)
++ }
++ }
++ }
++ if {[llength $badcolors] >= $ncolors} {
++ set badcolors $origbad
++ }
++ }
++ for {set i 0} {$i <= $ncolors} {incr i} {
++ set c [lindex $colors $nextcolor]
++ if {[incr nextcolor] >= $ncolors} {
++ set nextcolor 0
++ }
++ if {[lsearch -exact $badcolors $c]} break
++ }
++ set colormap($id) $c
++}
++
++proc bindline {t id} {
++ global canv
++
++ $canv bind $t <Enter> "lineenter %x %y $id"
++ $canv bind $t <Motion> "linemotion %x %y $id"
++ $canv bind $t <Leave> "lineleave $id"
++ $canv bind $t <Button-1> "lineclick %x %y $id 1"
++}
++
++proc drawtags {id x xt y1} {
++ global idtags idheads idotherrefs mainhead
++ global linespc lthickness
++ global canv rowtextx curview fgcolor bgcolor
++
++ set marks {}
++ set ntags 0
++ set nheads 0
++ if {[info exists idtags($id)]} {
++ set marks $idtags($id)
++ set ntags [llength $marks]
++ }
++ if {[info exists idheads($id)]} {
++ set marks [concat $marks $idheads($id)]
++ set nheads [llength $idheads($id)]
++ }
++ if {[info exists idotherrefs($id)]} {
++ set marks [concat $marks $idotherrefs($id)]
++ }
++ if {$marks eq {}} {
++ return $xt
++ }
++
++ set delta [expr {int(0.5 * ($linespc - $lthickness))}]
++ set yt [expr {$y1 - 0.5 * $linespc}]
++ set yb [expr {$yt + $linespc - 1}]
++ set xvals {}
++ set wvals {}
++ set i -1
++ foreach tag $marks {
++ incr i
++ if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
++ set wid [font measure mainfontbold $tag]
++ } else {
++ set wid [font measure mainfont $tag]
++ }
++ lappend xvals $xt
++ lappend wvals $wid
++ set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
++ }
++ set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
++ -width $lthickness -fill black -tags tag.$id]
++ $canv lower $t
++ foreach tag $marks x $xvals wid $wvals {
++ set xl [expr {$x + $delta}]
++ set xr [expr {$x + $delta + $wid + $lthickness}]
++ set font mainfont
++ if {[incr ntags -1] >= 0} {
++ # draw a tag
++ set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
++ $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
++ -width 1 -outline black -fill yellow -tags tag.$id]
++ $canv bind $t <1> [list showtag $tag 1]
++ set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
++ } else {
++ # draw a head or other ref
++ if {[incr nheads -1] >= 0} {
++ set col green
++ if {$tag eq $mainhead} {
++ set font mainfontbold
++ }
++ } else {
++ set col "#ddddff"
++ }
++ set xl [expr {$xl - $delta/2}]
++ $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
++ -width 1 -outline black -fill $col -tags tag.$id
++ if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
++ set rwid [font measure mainfont $remoteprefix]
++ set xi [expr {$x + 1}]
++ set yti [expr {$yt + 1}]
++ set xri [expr {$x + $rwid}]
++ $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
++ -width 0 -fill "#ffddaa" -tags tag.$id
++ }
++ }
++ set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
++ -font $font -tags [list tag.$id text]]
++ if {$ntags >= 0} {
++ $canv bind $t <1> [list showtag $tag 1]
++ } elseif {$nheads >= 0} {
++ $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
++ }
++ }
++ return $xt
++}
++
++proc xcoord {i level ln} {
++ global canvx0 xspc1 xspc2
++
++ set x [expr {$canvx0 + $i * $xspc1($ln)}]
++ if {$i > 0 && $i == $level} {
++ set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
++ } elseif {$i > $level} {
++ set x [expr {$x + $xspc2 - $xspc1($ln)}]
++ }
++ return $x
++}
++
++proc show_status {msg} {
++ global canv fgcolor
++
++ clear_display
++ $canv create text 3 3 -anchor nw -text $msg -font mainfont \
++ -tags text -fill $fgcolor
++}
++
++# Don't change the text pane cursor if it is currently the hand cursor,
++# showing that we are over a sha1 ID link.
++proc settextcursor {c} {
++ global ctext curtextcursor
++
++ if {[$ctext cget -cursor] == $curtextcursor} {
++ $ctext config -cursor $c
++ }
++ set curtextcursor $c
++}
++
++proc nowbusy {what {name {}}} {
++ global isbusy busyname statusw
++
++ if {[array names isbusy] eq {}} {
++ . config -cursor watch
++ settextcursor watch
++ }
++ set isbusy($what) 1
++ set busyname($what) $name
++ if {$name ne {}} {
++ $statusw conf -text $name
++ }
++}
++
++proc notbusy {what} {
++ global isbusy maincursor textcursor busyname statusw
++
++ catch {
++ unset isbusy($what)
++ if {$busyname($what) ne {} &&
++ [$statusw cget -text] eq $busyname($what)} {
++ $statusw conf -text {}
++ }
++ }
++ if {[array names isbusy] eq {}} {
++ . config -cursor $maincursor
++ settextcursor $textcursor
++ }
++}
++
++proc findmatches {f} {
++ global findtype findstring
++ if {$findtype == [mc "Regexp"]} {
++ set matches [regexp -indices -all -inline $findstring $f]
++ } else {
++ set fs $findstring
++ if {$findtype == [mc "IgnCase"]} {
++ set f [string tolower $f]
++ set fs [string tolower $fs]
++ }
++ set matches {}
++ set i 0
++ set l [string length $fs]
++ while {[set j [string first $fs $f $i]] >= 0} {
++ lappend matches [list $j [expr {$j+$l-1}]]
++ set i [expr {$j + $l}]
++ }
++ }
++ return $matches
++}
++
++proc dofind {{dirn 1} {wrap 1}} {
++ global findstring findstartline findcurline selectedline numcommits
++ global gdttype filehighlight fh_serial find_dirn findallowwrap
++
++ if {[info exists find_dirn]} {
++ if {$find_dirn == $dirn} return
++ stopfinding
++ }
++ focus .
++ if {$findstring eq {} || $numcommits == 0} return
++ if {$selectedline eq {}} {
++ set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
++ } else {
++ set findstartline $selectedline
++ }
++ set findcurline $findstartline
++ nowbusy finding [mc "Searching"]
++ if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
++ after cancel do_file_hl $fh_serial
++ do_file_hl $fh_serial
++ }
++ set find_dirn $dirn
++ set findallowwrap $wrap
++ run findmore
++}
++
++proc stopfinding {} {
++ global find_dirn findcurline fprogcoord
++
++ if {[info exists find_dirn]} {
++ unset find_dirn
++ unset findcurline
++ notbusy finding
++ set fprogcoord 0
++ adjustprogress
++ }
++}
++
++proc findmore {} {
++ global commitdata commitinfo numcommits findpattern findloc
++ global findstartline findcurline findallowwrap
++ global find_dirn gdttype fhighlights fprogcoord
++ global curview varcorder vrownum varccommits vrowmod
++
++ if {![info exists find_dirn]} {
++ return 0
++ }
++ set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
++ set l $findcurline
++ set moretodo 0
++ if {$find_dirn > 0} {
++ incr l
++ if {$l >= $numcommits} {
++ set l 0
++ }
++ if {$l <= $findstartline} {
++ set lim [expr {$findstartline + 1}]
++ } else {
++ set lim $numcommits
++ set moretodo $findallowwrap
++ }
++ } else {
++ if {$l == 0} {
++ set l $numcommits
++ }
++ incr l -1
++ if {$l >= $findstartline} {
++ set lim [expr {$findstartline - 1}]
++ } else {
++ set lim -1
++ set moretodo $findallowwrap
++ }
++ }
++ set n [expr {($lim - $l) * $find_dirn}]
++ if {$n > 500} {
++ set n 500
++ set moretodo 1
++ }
++ if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
++ update_arcrows $curview
++ }
++ set found 0
++ set domore 1
++ set ai [bsearch $vrownum($curview) $l]
++ set a [lindex $varcorder($curview) $ai]
++ set arow [lindex $vrownum($curview) $ai]
++ set ids [lindex $varccommits($curview,$a)]
++ set arowend [expr {$arow + [llength $ids]}]
++ if {$gdttype eq [mc "containing:"]} {
++ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
++ if {$l < $arow || $l >= $arowend} {
++ incr ai $find_dirn
++ set a [lindex $varcorder($curview) $ai]
++ set arow [lindex $vrownum($curview) $ai]
++ set ids [lindex $varccommits($curview,$a)]
++ set arowend [expr {$arow + [llength $ids]}]
++ }
++ set id [lindex $ids [expr {$l - $arow}]]
++ # shouldn't happen unless git log doesn't give all the commits...
++ if {![info exists commitdata($id)] ||
++ ![doesmatch $commitdata($id)]} {
++ continue
++ }
++ if {![info exists commitinfo($id)]} {
++ getcommit $id
++ }
++ set info $commitinfo($id)
++ foreach f $info ty $fldtypes {
++ if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
++ [doesmatch $f]} {
++ set found 1
++ break
++ }
++ }
++ if {$found} break
++ }
++ } else {
++ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
++ if {$l < $arow || $l >= $arowend} {
++ incr ai $find_dirn
++ set a [lindex $varcorder($curview) $ai]
++ set arow [lindex $vrownum($curview) $ai]
++ set ids [lindex $varccommits($curview,$a)]
++ set arowend [expr {$arow + [llength $ids]}]
++ }
++ set id [lindex $ids [expr {$l - $arow}]]
++ if {![info exists fhighlights($id)]} {
++ # this sets fhighlights($id) to -1
++ askfilehighlight $l $id
++ }
++ if {$fhighlights($id) > 0} {
++ set found $domore
++ break
++ }
++ if {$fhighlights($id) < 0} {
++ if {$domore} {
++ set domore 0
++ set findcurline [expr {$l - $find_dirn}]
++ }
++ }
++ }
++ }
++ if {$found || ($domore && !$moretodo)} {
++ unset findcurline
++ unset find_dirn
++ notbusy finding
++ set fprogcoord 0
++ adjustprogress
++ if {$found} {
++ findselectline $l
++ } else {
++ bell
++ }
++ return 0
++ }
++ if {!$domore} {
++ flushhighlights
++ } else {
++ set findcurline [expr {$l - $find_dirn}]
++ }
++ set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
++ if {$n < 0} {
++ incr n $numcommits
++ }
++ set fprogcoord [expr {$n * 1.0 / $numcommits}]
++ adjustprogress
++ return $domore
++}
++
++proc findselectline {l} {
++ global findloc commentend ctext findcurline markingmatches gdttype
++
++ set markingmatches 1
++ set findcurline $l
++ selectline $l 1
++ if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
++ # highlight the matches in the comments
++ set f [$ctext get 1.0 $commentend]
++ set matches [findmatches $f]
++ foreach match $matches {
++ set start [lindex $match 0]
++ set end [expr {[lindex $match 1] + 1}]
++ $ctext tag add found "1.0 + $start c" "1.0 + $end c"
++ }
++ }
++ drawvisible
++}
++
++# mark the bits of a headline or author that match a find string
++proc markmatches {canv l str tag matches font row} {
++ global selectedline
++
++ set bbox [$canv bbox $tag]
++ set x0 [lindex $bbox 0]
++ set y0 [lindex $bbox 1]
++ set y1 [lindex $bbox 3]
++ foreach match $matches {
++ set start [lindex $match 0]
++ set end [lindex $match 1]
++ if {$start > $end} continue
++ set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
++ set xlen [font measure $font [string range $str 0 [expr {$end}]]]
++ set t [$canv create rect [expr {$x0+$xoff}] $y0 \
++ [expr {$x0+$xlen+2}] $y1 \
++ -outline {} -tags [list match$l matches] -fill yellow]
++ $canv lower $t
++ if {$row == $selectedline} {
++ $canv raise $t secsel
++ }
++ }
++}
++
++proc unmarkmatches {} {
++ global markingmatches
++
++ allcanvs delete matches
++ set markingmatches 0
++ stopfinding
++}
++
++proc selcanvline {w x y} {
++ global canv canvy0 ctext linespc
++ global rowtextx
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax == {}} return
++ set yfrac [lindex [$canv yview] 0]
++ set y [expr {$y + $yfrac * $ymax}]
++ set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
++ if {$l < 0} {
++ set l 0
++ }
++ if {$w eq $canv} {
++ set xmax [lindex [$canv cget -scrollregion] 2]
++ set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
++ if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
++ }
++ unmarkmatches
++ selectline $l 1
++}
++
++proc commit_descriptor {p} {
++ global commitinfo
++ if {![info exists commitinfo($p)]} {
++ getcommit $p
++ }
++ set l "..."
++ if {[llength $commitinfo($p)] > 1} {
++ set l [lindex $commitinfo($p) 0]
++ }
++ return "$p ($l)\n"
++}
++
++# append some text to the ctext widget, and make any SHA1 ID
++# that we know about be a clickable link.
++proc appendwithlinks {text tags} {
++ global ctext linknum curview pendinglinks
++
++ set start [$ctext index "end - 1c"]
++ $ctext insert end $text $tags
++ set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
++ foreach l $links {
++ set s [lindex $l 0]
++ set e [lindex $l 1]
++ set linkid [string range $text $s $e]
++ incr e
++ $ctext tag delete link$linknum
++ $ctext tag add link$linknum "$start + $s c" "$start + $e c"
++ setlink $linkid link$linknum
++ incr linknum
++ }
++}
++
++proc setlink {id lk} {
++ global curview ctext pendinglinks commitinterest
++
++ if {[commitinview $id $curview]} {
++ $ctext tag conf $lk -foreground blue -underline 1
++ $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
++ $ctext tag bind $lk <Enter> {linkcursor %W 1}
++ $ctext tag bind $lk <Leave> {linkcursor %W -1}
++ } else {
++ lappend pendinglinks($id) $lk
++ lappend commitinterest($id) {makelink %I}
++ }
++}
++
++proc makelink {id} {
++ global pendinglinks
++
++ if {![info exists pendinglinks($id)]} return
++ foreach lk $pendinglinks($id) {
++ setlink $id $lk
++ }
++ unset pendinglinks($id)
++}
++
++proc linkcursor {w inc} {
++ global linkentercount curtextcursor
++
++ if {[incr linkentercount $inc] > 0} {
++ $w configure -cursor hand2
++ } else {
++ $w configure -cursor $curtextcursor
++ if {$linkentercount < 0} {
++ set linkentercount 0
++ }
++ }
++}
++
++proc viewnextline {dir} {
++ global canv linespc
++
++ $canv delete hover
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ set wnow [$canv yview]
++ set wtop [expr {[lindex $wnow 0] * $ymax}]
++ set newtop [expr {$wtop + $dir * $linespc}]
++ if {$newtop < 0} {
++ set newtop 0
++ } elseif {$newtop > $ymax} {
++ set newtop $ymax
++ }
++ allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
++}
++
++# add a list of tag or branch names at position pos
++# returns the number of names inserted
++proc appendrefs {pos ids var} {
++ global ctext linknum curview $var maxrefs
++
++ if {[catch {$ctext index $pos}]} {
++ return 0
++ }
++ $ctext conf -state normal
++ $ctext delete $pos "$pos lineend"
++ set tags {}
++ foreach id $ids {
++ foreach tag [set $var\($id\)] {
++ lappend tags [list $tag $id]
++ }
++ }
++ if {[llength $tags] > $maxrefs} {
++ $ctext insert $pos "many ([llength $tags])"
++ } else {
++ set tags [lsort -index 0 -decreasing $tags]
++ set sep {}
++ foreach ti $tags {
++ set id [lindex $ti 1]
++ set lk link$linknum
++ incr linknum
++ $ctext tag delete $lk
++ $ctext insert $pos $sep
++ $ctext insert $pos [lindex $ti 0] $lk
++ setlink $id $lk
++ set sep ", "
++ }
++ }
++ $ctext conf -state disabled
++ return [llength $tags]
++}
++
++# called when we have finished computing the nearby tags
++proc dispneartags {delay} {
++ global selectedline currentid showneartags tagphase
++
++ if {$selectedline eq {} || !$showneartags} return
++ after cancel dispnexttag
++ if {$delay} {
++ after 200 dispnexttag
++ set tagphase -1
++ } else {
++ after idle dispnexttag
++ set tagphase 0
++ }
++}
++
++proc dispnexttag {} {
++ global selectedline currentid showneartags tagphase ctext
++
++ if {$selectedline eq {} || !$showneartags} return
++ switch -- $tagphase {
++ 0 {
++ set dtags [desctags $currentid]
++ if {$dtags ne {}} {
++ appendrefs precedes $dtags idtags
++ }
++ }
++ 1 {
++ set atags [anctags $currentid]
++ if {$atags ne {}} {
++ appendrefs follows $atags idtags
++ }
++ }
++ 2 {
++ set dheads [descheads $currentid]
++ if {$dheads ne {}} {
++ if {[appendrefs branch $dheads idheads] > 1
++ && [$ctext get "branch -3c"] eq "h"} {
++ # turn "Branch" into "Branches"
++ $ctext conf -state normal
++ $ctext insert "branch -2c" "es"
++ $ctext conf -state disabled
++ }
++ }
++ }
++ }
++ if {[incr tagphase] <= 2} {
++ after idle dispnexttag
++ }
++}
++
++proc make_secsel {l} {
++ global linehtag linentag linedtag canv canv2 canv3
++
++ if {![info exists linehtag($l)]} return
++ $canv delete secsel
++ set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
++ -tags secsel -fill [$canv cget -selectbackground]]
++ $canv lower $t
++ $canv2 delete secsel
++ set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
++ -tags secsel -fill [$canv2 cget -selectbackground]]
++ $canv2 lower $t
++ $canv3 delete secsel
++ set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
++ -tags secsel -fill [$canv3 cget -selectbackground]]
++ $canv3 lower $t
++}
++
++proc selectline {l isnew} {
++ global canv ctext commitinfo selectedline
++ global canvy0 linespc parents children curview
++ global currentid sha1entry
++ global commentend idtags linknum
++ global mergemax numcommits pending_select
++ global cmitmode showneartags allcommits
++ global targetrow targetid lastscrollrows
++ global autoselect
++
++ catch {unset pending_select}
++ $canv delete hover
++ normalline
++ unsel_reflist
++ stopfinding
++ if {$l < 0 || $l >= $numcommits} return
++ set id [commitonrow $l]
++ set targetid $id
++ set targetrow $l
++ set selectedline $l
++ set currentid $id
++ if {$lastscrollrows < $numcommits} {
++ setcanvscroll
++ }
++
++ set y [expr {$canvy0 + $l * $linespc}]
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ set ytop [expr {$y - $linespc - 1}]
++ set ybot [expr {$y + $linespc + 1}]
++ set wnow [$canv yview]
++ set wtop [expr {[lindex $wnow 0] * $ymax}]
++ set wbot [expr {[lindex $wnow 1] * $ymax}]
++ set wh [expr {$wbot - $wtop}]
++ set newtop $wtop
++ if {$ytop < $wtop} {
++ if {$ybot < $wtop} {
++ set newtop [expr {$y - $wh / 2.0}]
++ } else {
++ set newtop $ytop
++ if {$newtop > $wtop - $linespc} {
++ set newtop [expr {$wtop - $linespc}]
++ }
++ }
++ } elseif {$ybot > $wbot} {
++ if {$ytop > $wbot} {
++ set newtop [expr {$y - $wh / 2.0}]
++ } else {
++ set newtop [expr {$ybot - $wh}]
++ if {$newtop < $wtop + $linespc} {
++ set newtop [expr {$wtop + $linespc}]
++ }
++ }
++ }
++ if {$newtop != $wtop} {
++ if {$newtop < 0} {
++ set newtop 0
++ }
++ allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
++ drawvisible
++ }
++
++ make_secsel $l
++
++ if {$isnew} {
++ addtohistory [list selbyid $id]
++ }
++
++ $sha1entry delete 0 end
++ $sha1entry insert 0 $id
++ if {$autoselect} {
++ $sha1entry selection from 0
++ $sha1entry selection to end
++ }
++ rhighlight_sel $id
++
++ $ctext conf -state normal
++ clear_ctext
++ set linknum 0
++ if {![info exists commitinfo($id)]} {
++ getcommit $id
++ }
++ set info $commitinfo($id)
++ set date [formatdate [lindex $info 2]]
++ $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
++ set date [formatdate [lindex $info 4]]
++ $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
++ if {[info exists idtags($id)]} {
++ $ctext insert end [mc "Tags:"]
++ foreach tag $idtags($id) {
++ $ctext insert end " $tag"
++ }
++ $ctext insert end "\n"
++ }
++
++ set headers {}
++ set olds $parents($curview,$id)
++ if {[llength $olds] > 1} {
++ set np 0
++ foreach p $olds {
++ if {$np >= $mergemax} {
++ set tag mmax
++ } else {
++ set tag m$np
++ }
++ $ctext insert end "[mc "Parent"]: " $tag
++ appendwithlinks [commit_descriptor $p] {}
++ incr np
++ }
++ } else {
++ foreach p $olds {
++ append headers "[mc "Parent"]: [commit_descriptor $p]"
++ }
++ }
++
++ foreach c $children($curview,$id) {
++ append headers "[mc "Child"]: [commit_descriptor $c]"
++ }
++
++ # make anything that looks like a SHA1 ID be a clickable link
++ appendwithlinks $headers {}
++ if {$showneartags} {
++ if {![info exists allcommits]} {
++ getallcommits
++ }
++ $ctext insert end "[mc "Branch"]: "
++ $ctext mark set branch "end -1c"
++ $ctext mark gravity branch left
++ $ctext insert end "\n[mc "Follows"]: "
++ $ctext mark set follows "end -1c"
++ $ctext mark gravity follows left
++ $ctext insert end "\n[mc "Precedes"]: "
++ $ctext mark set precedes "end -1c"
++ $ctext mark gravity precedes left
++ $ctext insert end "\n"
++ dispneartags 1
++ }
++ $ctext insert end "\n"
++ set comment [lindex $info 5]
++ if {[string first "\r" $comment] >= 0} {
++ set comment [string map {"\r" "\n "} $comment]
++ }
++ appendwithlinks $comment {comment}
++
++ $ctext tag remove found 1.0 end
++ $ctext conf -state disabled
++ set commentend [$ctext index "end - 1c"]
++
++ init_flist [mc "Comments"]
++ if {$cmitmode eq "tree"} {
++ gettree $id
++ } elseif {[llength $olds] <= 1} {
++ startdiff $id
++ } else {
++ mergediff $id
++ }
++}
++
++proc selfirstline {} {
++ unmarkmatches
++ selectline 0 1
++}
++
++proc sellastline {} {
++ global numcommits
++ unmarkmatches
++ set l [expr {$numcommits - 1}]
++ selectline $l 1
++}
++
++proc selnextline {dir} {
++ global selectedline
++ focus .
++ if {$selectedline eq {}} return
++ set l [expr {$selectedline + $dir}]
++ unmarkmatches
++ selectline $l 1
++}
++
++proc selnextpage {dir} {
++ global canv linespc selectedline numcommits
++
++ set lpp [expr {([winfo height $canv] - 2) / $linespc}]
++ if {$lpp < 1} {
++ set lpp 1
++ }
++ allcanvs yview scroll [expr {$dir * $lpp}] units
++ drawvisible
++ if {$selectedline eq {}} return
++ set l [expr {$selectedline + $dir * $lpp}]
++ if {$l < 0} {
++ set l 0
++ } elseif {$l >= $numcommits} {
++ set l [expr $numcommits - 1]
++ }
++ unmarkmatches
++ selectline $l 1
++}
++
++proc unselectline {} {
++ global selectedline currentid
++
++ set selectedline {}
++ catch {unset currentid}
++ allcanvs delete secsel
++ rhighlight_none
++}
++
++proc reselectline {} {
++ global selectedline
++
++ if {$selectedline ne {}} {
++ selectline $selectedline 0
++ }
++}
++
++proc addtohistory {cmd} {
++ global history historyindex curview
++
++ set elt [list $curview $cmd]
++ if {$historyindex > 0
++ && [lindex $history [expr {$historyindex - 1}]] == $elt} {
++ return
++ }
++
++ if {$historyindex < [llength $history]} {
++ set history [lreplace $history $historyindex end $elt]
++ } else {
++ lappend history $elt
++ }
++ incr historyindex
++ if {$historyindex > 1} {
++ .tf.bar.leftbut conf -state normal
++ } else {
++ .tf.bar.leftbut conf -state disabled
++ }
++ .tf.bar.rightbut conf -state disabled
++}
++
++proc godo {elt} {
++ global curview
++
++ set view [lindex $elt 0]
++ set cmd [lindex $elt 1]
++ if {$curview != $view} {
++ showview $view
++ }
++ eval $cmd
++}
++
++proc goback {} {
++ global history historyindex
++ focus .
++
++ if {$historyindex > 1} {
++ incr historyindex -1
++ godo [lindex $history [expr {$historyindex - 1}]]
++ .tf.bar.rightbut conf -state normal
++ }
++ if {$historyindex <= 1} {
++ .tf.bar.leftbut conf -state disabled
++ }
++}
++
++proc goforw {} {
++ global history historyindex
++ focus .
++
++ if {$historyindex < [llength $history]} {
++ set cmd [lindex $history $historyindex]
++ incr historyindex
++ godo $cmd
++ .tf.bar.leftbut conf -state normal
++ }
++ if {$historyindex >= [llength $history]} {
++ .tf.bar.rightbut conf -state disabled
++ }
++}
++
++proc gettree {id} {
++ global treefilelist treeidlist diffids diffmergeid treepending
++ global nullid nullid2
++
++ set diffids $id
++ catch {unset diffmergeid}
++ if {![info exists treefilelist($id)]} {
++ if {![info exists treepending]} {
++ if {$id eq $nullid} {
++ set cmd [list | git ls-files]
++ } elseif {$id eq $nullid2} {
++ set cmd [list | git ls-files --stage -t]
++ } else {
++ set cmd [list | git ls-tree -r $id]
++ }
++ if {[catch {set gtf [open $cmd r]}]} {
++ return
++ }
++ set treepending $id
++ set treefilelist($id) {}
++ set treeidlist($id) {}
++ fconfigure $gtf -blocking 0
++ filerun $gtf [list gettreeline $gtf $id]
++ }
++ } else {
++ setfilelist $id
++ }
++}
++
++proc gettreeline {gtf id} {
++ global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
++
++ set nl 0
++ while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
++ if {$diffids eq $nullid} {
++ set fname $line
++ } else {
++ set i [string first "\t" $line]
++ if {$i < 0} continue
++ set fname [string range $line [expr {$i+1}] end]
++ set line [string range $line 0 [expr {$i-1}]]
++ if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
++ set sha1 [lindex $line 2]
++ if {[string index $fname 0] eq "\""} {
++ set fname [lindex $fname 0]
++ }
++ lappend treeidlist($id) $sha1
++ }
++ lappend treefilelist($id) $fname
++ }
++ if {![eof $gtf]} {
++ return [expr {$nl >= 1000? 2: 1}]
++ }
++ close $gtf
++ unset treepending
++ if {$cmitmode ne "tree"} {
++ if {![info exists diffmergeid]} {
++ gettreediffs $diffids
++ }
++ } elseif {$id ne $diffids} {
++ gettree $diffids
++ } else {
++ setfilelist $id
++ }
++ return 0
++}
++
++proc showfile {f} {
++ global treefilelist treeidlist diffids nullid nullid2
++ global ctext commentend
++
++ set i [lsearch -exact $treefilelist($diffids) $f]
++ if {$i < 0} {
++ puts "oops, $f not in list for id $diffids"
++ return
++ }
++ if {$diffids eq $nullid} {
++ if {[catch {set bf [open $f r]} err]} {
++ puts "oops, can't read $f: $err"
++ return
++ }
++ } else {
++ set blob [lindex $treeidlist($diffids) $i]
++ if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
++ puts "oops, error reading blob $blob: $err"
++ return
++ }
++ }
++ fconfigure $bf -blocking 0
++ filerun $bf [list getblobline $bf $diffids]
++ $ctext config -state normal
++ clear_ctext $commentend
++ $ctext insert end "\n"
++ $ctext insert end "$f\n" filesep
++ $ctext config -state disabled
++ $ctext yview $commentend
++ settabs 0
++}
++
++proc getblobline {bf id} {
++ global diffids cmitmode ctext
++
++ if {$id ne $diffids || $cmitmode ne "tree"} {
++ catch {close $bf}
++ return 0
++ }
++ $ctext config -state normal
++ set nl 0
++ while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
++ $ctext insert end "$line\n"
++ }
++ if {[eof $bf]} {
++ # delete last newline
++ $ctext delete "end - 2c" "end - 1c"
++ close $bf
++ return 0
++ }
++ $ctext config -state disabled
++ return [expr {$nl >= 1000? 2: 1}]
++}
++
++proc mergediff {id} {
++ global diffmergeid mdifffd
++ global diffids
++ global parents
++ global diffcontext
++ global limitdiffs vfilelimit curview
++
++ set diffmergeid $id
++ set diffids $id
++ # this doesn't seem to actually affect anything...
++ set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
++ if {$limitdiffs && $vfilelimit($curview) ne {}} {
++ set cmd [concat $cmd -- $vfilelimit($curview)]
++ }
++ if {[catch {set mdf [open $cmd r]} err]} {
++ error_popup "[mc "Error getting merge diffs:"] $err"
++ return
++ }
++ fconfigure $mdf -blocking 0
++ set mdifffd($id) $mdf
++ set np [llength $parents($curview,$id)]
++ settabs $np
++ filerun $mdf [list getmergediffline $mdf $id $np]
++}
++
++proc getmergediffline {mdf id np} {
++ global diffmergeid ctext cflist mergemax
++ global difffilestart mdifffd
++
++ $ctext conf -state normal
++ set nr 0
++ while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
++ if {![info exists diffmergeid] || $id != $diffmergeid
++ || $mdf != $mdifffd($id)} {
++ close $mdf
++ return 0
++ }
++ if {[regexp {^diff --cc (.*)} $line match fname]} {
++ # start of a new file
++ $ctext insert end "\n"
++ set here [$ctext index "end - 1c"]
++ lappend difffilestart $here
++ add_flist [list $fname]
++ set l [expr {(78 - [string length $fname]) / 2}]
++ set pad [string range "----------------------------------------" 1 $l]
++ $ctext insert end "$pad $fname $pad\n" filesep
++ } elseif {[regexp {^@@} $line]} {
++ $ctext insert end "$line\n" hunksep
++ } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
++ # do nothing
++ } else {
++ # parse the prefix - one ' ', '-' or '+' for each parent
++ set spaces {}
++ set minuses {}
++ set pluses {}
++ set isbad 0
++ for {set j 0} {$j < $np} {incr j} {
++ set c [string range $line $j $j]
++ if {$c == " "} {
++ lappend spaces $j
++ } elseif {$c == "-"} {
++ lappend minuses $j
++ } elseif {$c == "+"} {
++ lappend pluses $j
++ } else {
++ set isbad 1
++ break
++ }
++ }
++ set tags {}
++ set num {}
++ if {!$isbad && $minuses ne {} && $pluses eq {}} {
++ # line doesn't appear in result, parents in $minuses have the line
++ set num [lindex $minuses 0]
++ } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
++ # line appears in result, parents in $pluses don't have the line
++ lappend tags mresult
++ set num [lindex $spaces 0]
++ }
++ if {$num ne {}} {
++ if {$num >= $mergemax} {
++ set num "max"
++ }
++ lappend tags m$num
++ }
++ $ctext insert end "$line\n" $tags
++ }
++ }
++ $ctext conf -state disabled
++ if {[eof $mdf]} {
++ close $mdf
++ return 0
++ }
++ return [expr {$nr >= 1000? 2: 1}]
++}
++
++proc startdiff {ids} {
++ global treediffs diffids treepending diffmergeid nullid nullid2
++
++ settabs 1
++ set diffids $ids
++ catch {unset diffmergeid}
++ if {![info exists treediffs($ids)] ||
++ [lsearch -exact $ids $nullid] >= 0 ||
++ [lsearch -exact $ids $nullid2] >= 0} {
++ if {![info exists treepending]} {
++ gettreediffs $ids
++ }
++ } else {
++ addtocflist $ids
++ }
++}
++
++proc path_filter {filter name} {
++ foreach p $filter {
++ set l [string length $p]
++ if {[string index $p end] eq "/"} {
++ if {[string compare -length $l $p $name] == 0} {
++ return 1
++ }
++ } else {
++ if {[string compare -length $l $p $name] == 0 &&
++ ([string length $name] == $l ||
++ [string index $name $l] eq "/")} {
++ return 1
++ }
++ }
++ }
++ return 0
++}
++
++proc addtocflist {ids} {
++ global treediffs
++
++ add_flist $treediffs($ids)
++ getblobdiffs $ids
++}
++
++proc diffcmd {ids flags} {
++ global nullid nullid2
++
++ set i [lsearch -exact $ids $nullid]
++ set j [lsearch -exact $ids $nullid2]
++ if {$i >= 0} {
++ if {[llength $ids] > 1 && $j < 0} {
++ # comparing working directory with some specific revision
++ set cmd [concat | git diff-index $flags]
++ if {$i == 0} {
++ lappend cmd -R [lindex $ids 1]
++ } else {
++ lappend cmd [lindex $ids 0]
++ }
++ } else {
++ # comparing working directory with index
++ set cmd [concat | git diff-files $flags]
++ if {$j == 1} {
++ lappend cmd -R
++ }
++ }
++ } elseif {$j >= 0} {
++ set cmd [concat | git diff-index --cached $flags]
++ if {[llength $ids] > 1} {
++ # comparing index with specific revision
++ if {$i == 0} {
++ lappend cmd -R [lindex $ids 1]
++ } else {
++ lappend cmd [lindex $ids 0]
++ }
++ } else {
++ # comparing index with HEAD
++ lappend cmd HEAD
++ }
++ } else {
++ set cmd [concat | git diff-tree -r $flags $ids]
++ }
++ return $cmd
++}
++
++proc gettreediffs {ids} {
++ global treediff treepending
++
++ if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
++
++ set treepending $ids
++ set treediff {}
++ fconfigure $gdtf -blocking 0
++ filerun $gdtf [list gettreediffline $gdtf $ids]
++}
++
++proc gettreediffline {gdtf ids} {
++ global treediff treediffs treepending diffids diffmergeid
++ global cmitmode vfilelimit curview limitdiffs
++
++ set nr 0
++ while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
++ set i [string first "\t" $line]
++ if {$i >= 0} {
++ set file [string range $line [expr {$i+1}] end]
++ if {[string index $file 0] eq "\""} {
++ set file [lindex $file 0]
++ }
++ lappend treediff $file
++ }
++ }
++ if {![eof $gdtf]} {
++ return [expr {$nr >= 1000? 2: 1}]
++ }
++ close $gdtf
++ if {$limitdiffs && $vfilelimit($curview) ne {}} {
++ set flist {}
++ foreach f $treediff {
++ if {[path_filter $vfilelimit($curview) $f]} {
++ lappend flist $f
++ }
++ }
++ set treediffs($ids) $flist
++ } else {
++ set treediffs($ids) $treediff
++ }
++ unset treepending
++ if {$cmitmode eq "tree"} {
++ gettree $diffids
++ } elseif {$ids != $diffids} {
++ if {![info exists diffmergeid]} {
++ gettreediffs $diffids
++ }
++ } else {
++ addtocflist $ids
++ }
++ return 0
++}
++
++# empty string or positive integer
++proc diffcontextvalidate {v} {
++ return [regexp {^(|[1-9][0-9]*)$} $v]
++}
++
++proc diffcontextchange {n1 n2 op} {
++ global diffcontextstring diffcontext
++
++ if {[string is integer -strict $diffcontextstring]} {
++ if {$diffcontextstring > 0} {
++ set diffcontext $diffcontextstring
++ reselectline
++ }
++ }
++}
++
++proc changeignorespace {} {
++ reselectline
++}
++
++proc getblobdiffs {ids} {
++ global blobdifffd diffids env
++ global diffinhdr treediffs
++ global diffcontext
++ global ignorespace
++ global limitdiffs vfilelimit curview
++
++ set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
++ if {$ignorespace} {
++ append cmd " -w"
++ }
++ if {$limitdiffs && $vfilelimit($curview) ne {}} {
++ set cmd [concat $cmd -- $vfilelimit($curview)]
++ }
++ if {[catch {set bdf [open $cmd r]} err]} {
++ puts "error getting diffs: $err"
++ return
++ }
++ set diffinhdr 0
++ fconfigure $bdf -blocking 0
++ set blobdifffd($ids) $bdf
++ filerun $bdf [list getblobdiffline $bdf $diffids]
++}
++
++proc setinlist {var i val} {
++ global $var
++
++ while {[llength [set $var]] < $i} {
++ lappend $var {}
++ }
++ if {[llength [set $var]] == $i} {
++ lappend $var $val
++ } else {
++ lset $var $i $val
++ }
++}
++
++proc makediffhdr {fname ids} {
++ global ctext curdiffstart treediffs
++
++ set i [lsearch -exact $treediffs($ids) $fname]
++ if {$i >= 0} {
++ setinlist difffilestart $i $curdiffstart
++ }
++ set l [expr {(78 - [string length $fname]) / 2}]
++ set pad [string range "----------------------------------------" 1 $l]
++ $ctext insert $curdiffstart "$pad $fname $pad" filesep
++}
++
++proc getblobdiffline {bdf ids} {
++ global diffids blobdifffd ctext curdiffstart
++ global diffnexthead diffnextnote difffilestart
++ global diffinhdr treediffs
++
++ set nr 0
++ $ctext conf -state normal
++ while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
++ if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
++ close $bdf
++ return 0
++ }
++ if {![string compare -length 11 "diff --git " $line]} {
++ # trim off "diff --git "
++ set line [string range $line 11 end]
++ set diffinhdr 1
++ # start of a new file
++ $ctext insert end "\n"
++ set curdiffstart [$ctext index "end - 1c"]
++ $ctext insert end "\n" filesep
++ # If the name hasn't changed the length will be odd,
++ # the middle char will be a space, and the two bits either
++ # side will be a/name and b/name, or "a/name" and "b/name".
++ # If the name has changed we'll get "rename from" and
++ # "rename to" or "copy from" and "copy to" lines following this,
++ # and we'll use them to get the filenames.
++ # This complexity is necessary because spaces in the filename(s)
++ # don't get escaped.
++ set l [string length $line]
++ set i [expr {$l / 2}]
++ if {!(($l & 1) && [string index $line $i] eq " " &&
++ [string range $line 2 [expr {$i - 1}]] eq \
++ [string range $line [expr {$i + 3}] end])} {
++ continue
++ }
++ # unescape if quoted and chop off the a/ from the front
++ if {[string index $line 0] eq "\""} {
++ set fname [string range [lindex $line 0] 2 end]
++ } else {
++ set fname [string range $line 2 [expr {$i - 1}]]
++ }
++ makediffhdr $fname $ids
++
++ } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
++ $line match f1l f1c f2l f2c rest]} {
++ $ctext insert end "$line\n" hunksep
++ set diffinhdr 0
++
++ } elseif {$diffinhdr} {
++ if {![string compare -length 12 "rename from " $line]} {
++ set fname [string range $line [expr 6 + [string first " from " $line] ] end]
++ if {[string index $fname 0] eq "\""} {
++ set fname [lindex $fname 0]
++ }
++ set i [lsearch -exact $treediffs($ids) $fname]
++ if {$i >= 0} {
++ setinlist difffilestart $i $curdiffstart
++ }
++ } elseif {![string compare -length 10 $line "rename to "] ||
++ ![string compare -length 8 $line "copy to "]} {
++ set fname [string range $line [expr 4 + [string first " to " $line] ] end]
++ if {[string index $fname 0] eq "\""} {
++ set fname [lindex $fname 0]
++ }
++ makediffhdr $fname $ids
++ } elseif {[string compare -length 3 $line "---"] == 0} {
++ # do nothing
++ continue
++ } elseif {[string compare -length 3 $line "+++"] == 0} {
++ set diffinhdr 0
++ continue
++ }
++ $ctext insert end "$line\n" filesep
++
++ } else {
++ set x [string range $line 0 0]
++ if {$x == "-" || $x == "+"} {
++ set tag [expr {$x == "+"}]
++ $ctext insert end "$line\n" d$tag
++ } elseif {$x == " "} {
++ $ctext insert end "$line\n"
++ } else {
++ # "\ No newline at end of file",
++ # or something else we don't recognize
++ $ctext insert end "$line\n" hunksep
++ }
++ }
++ }
++ $ctext conf -state disabled
++ if {[eof $bdf]} {
++ close $bdf
++ return 0
++ }
++ return [expr {$nr >= 1000? 2: 1}]
++}
++
++proc changediffdisp {} {
++ global ctext diffelide
++
++ $ctext tag conf d0 -elide [lindex $diffelide 0]
++ $ctext tag conf d1 -elide [lindex $diffelide 1]
++}
++
++proc highlightfile {loc cline} {
++ global ctext cflist cflist_top
++
++ $ctext yview $loc
++ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
++ $cflist tag add highlight $cline.0 "$cline.0 lineend"
++ $cflist see $cline.0
++ set cflist_top $cline
++}
++
++proc prevfile {} {
++ global difffilestart ctext cmitmode
++
++ if {$cmitmode eq "tree"} return
++ set prev 0.0
++ set prevline 1
++ set here [$ctext index @0,0]
++ foreach loc $difffilestart {
++ if {[$ctext compare $loc >= $here]} {
++ highlightfile $prev $prevline
++ return
++ }
++ set prev $loc
++ incr prevline
++ }
++ highlightfile $prev $prevline
++}
++
++proc nextfile {} {
++ global difffilestart ctext cmitmode
++
++ if {$cmitmode eq "tree"} return
++ set here [$ctext index @0,0]
++ set line 1
++ foreach loc $difffilestart {
++ incr line
++ if {[$ctext compare $loc > $here]} {
++ highlightfile $loc $line
++ return
++ }
++ }
++}
++
++proc clear_ctext {{first 1.0}} {
++ global ctext smarktop smarkbot
++ global pendinglinks
++
++ set l [lindex [split $first .] 0]
++ if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
++ set smarktop $l
++ }
++ if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
++ set smarkbot $l
++ }
++ $ctext delete $first end
++ if {$first eq "1.0"} {
++ catch {unset pendinglinks}
++ }
++}
++
++proc settabs {{firstab {}}} {
++ global firsttabstop tabstop ctext have_tk85
++
++ if {$firstab ne {} && $have_tk85} {
++ set firsttabstop $firstab
++ }
++ set w [font measure textfont "0"]
++ if {$firsttabstop != 0} {
++ $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
++ [expr {($firsttabstop + 2 * $tabstop) * $w}]]
++ } elseif {$have_tk85 || $tabstop != 8} {
++ $ctext conf -tabs [expr {$tabstop * $w}]
++ } else {
++ $ctext conf -tabs {}
++ }
++}
++
++proc incrsearch {name ix op} {
++ global ctext searchstring searchdirn
++
++ $ctext tag remove found 1.0 end
++ if {[catch {$ctext index anchor}]} {
++ # no anchor set, use start of selection, or of visible area
++ set sel [$ctext tag ranges sel]
++ if {$sel ne {}} {
++ $ctext mark set anchor [lindex $sel 0]
++ } elseif {$searchdirn eq "-forwards"} {
++ $ctext mark set anchor @0,0
++ } else {
++ $ctext mark set anchor @0,[winfo height $ctext]
++ }
++ }
++ if {$searchstring ne {}} {
++ set here [$ctext search $searchdirn -- $searchstring anchor]
++ if {$here ne {}} {
++ $ctext see $here
++ }
++ searchmarkvisible 1
++ }
++}
++
++proc dosearch {} {
++ global sstring ctext searchstring searchdirn
++
++ focus $sstring
++ $sstring icursor end
++ set searchdirn -forwards
++ if {$searchstring ne {}} {
++ set sel [$ctext tag ranges sel]
++ if {$sel ne {}} {
++ set start "[lindex $sel 0] + 1c"
++ } elseif {[catch {set start [$ctext index anchor]}]} {
++ set start "@0,0"
++ }
++ set match [$ctext search -count mlen -- $searchstring $start]
++ $ctext tag remove sel 1.0 end
++ if {$match eq {}} {
++ bell
++ return
++ }
++ $ctext see $match
++ set mend "$match + $mlen c"
++ $ctext tag add sel $match $mend
++ $ctext mark unset anchor
++ }
++}
++
++proc dosearchback {} {
++ global sstring ctext searchstring searchdirn
++
++ focus $sstring
++ $sstring icursor end
++ set searchdirn -backwards
++ if {$searchstring ne {}} {
++ set sel [$ctext tag ranges sel]
++ if {$sel ne {}} {
++ set start [lindex $sel 0]
++ } elseif {[catch {set start [$ctext index anchor]}]} {
++ set start @0,[winfo height $ctext]
++ }
++ set match [$ctext search -backwards -count ml -- $searchstring $start]
++ $ctext tag remove sel 1.0 end
++ if {$match eq {}} {
++ bell
++ return
++ }
++ $ctext see $match
++ set mend "$match + $ml c"
++ $ctext tag add sel $match $mend
++ $ctext mark unset anchor
++ }
++}
++
++proc searchmark {first last} {
++ global ctext searchstring
++
++ set mend $first.0
++ while {1} {
++ set match [$ctext search -count mlen -- $searchstring $mend $last.end]
++ if {$match eq {}} break
++ set mend "$match + $mlen c"
++ $ctext tag add found $match $mend
++ }
++}
++
++proc searchmarkvisible {doall} {
++ global ctext smarktop smarkbot
++
++ set topline [lindex [split [$ctext index @0,0] .] 0]
++ set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
++ if {$doall || $botline < $smarktop || $topline > $smarkbot} {
++ # no overlap with previous
++ searchmark $topline $botline
++ set smarktop $topline
++ set smarkbot $botline
++ } else {
++ if {$topline < $smarktop} {
++ searchmark $topline [expr {$smarktop-1}]
++ set smarktop $topline
++ }
++ if {$botline > $smarkbot} {
++ searchmark [expr {$smarkbot+1}] $botline
++ set smarkbot $botline
++ }
++ }
++}
++
++proc scrolltext {f0 f1} {
++ global searchstring
++
++ .bleft.bottom.sb set $f0 $f1
++ if {$searchstring ne {}} {
++ searchmarkvisible 0
++ }
++}
++
++proc setcoords {} {
++ global linespc charspc canvx0 canvy0
++ global xspc1 xspc2 lthickness
++
++ set linespc [font metrics mainfont -linespace]
++ set charspc [font measure mainfont "m"]
++ set canvy0 [expr {int(3 + 0.5 * $linespc)}]
++ set canvx0 [expr {int(3 + 0.5 * $linespc)}]
++ set lthickness [expr {int($linespc / 9) + 1}]
++ set xspc1(0) $linespc
++ set xspc2 $linespc
++}
++
++proc redisplay {} {
++ global canv
++ global selectedline
++
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax eq {} || $ymax == 0} return
++ set span [$canv yview]
++ clear_display
++ setcanvscroll
++ allcanvs yview moveto [lindex $span 0]
++ drawvisible
++ if {$selectedline ne {}} {
++ selectline $selectedline 0
++ allcanvs yview moveto [lindex $span 0]
++ }
++}
++
++proc parsefont {f n} {
++ global fontattr
++
++ set fontattr($f,family) [lindex $n 0]
++ set s [lindex $n 1]
++ if {$s eq {} || $s == 0} {
++ set s 10
++ } elseif {$s < 0} {
++ set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
++ }
++ set fontattr($f,size) $s
++ set fontattr($f,weight) normal
++ set fontattr($f,slant) roman
++ foreach style [lrange $n 2 end] {
++ switch -- $style {
++ "normal" -
++ "bold" {set fontattr($f,weight) $style}
++ "roman" -
++ "italic" {set fontattr($f,slant) $style}
++ }
++ }
++}
++
++proc fontflags {f {isbold 0}} {
++ global fontattr
++
++ return [list -family $fontattr($f,family) -size $fontattr($f,size) \
++ -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
++ -slant $fontattr($f,slant)]
++}
++
++proc fontname {f} {
++ global fontattr
++
++ set n [list $fontattr($f,family) $fontattr($f,size)]
++ if {$fontattr($f,weight) eq "bold"} {
++ lappend n "bold"
++ }
++ if {$fontattr($f,slant) eq "italic"} {
++ lappend n "italic"
++ }
++ return $n
++}
++
++proc incrfont {inc} {
++ global mainfont textfont ctext canv cflist showrefstop
++ global stopped entries fontattr
++
++ unmarkmatches
++ set s $fontattr(mainfont,size)
++ incr s $inc
++ if {$s < 1} {
++ set s 1
++ }
++ set fontattr(mainfont,size) $s
++ font config mainfont -size $s
++ font config mainfontbold -size $s
++ set mainfont [fontname mainfont]
++ set s $fontattr(textfont,size)
++ incr s $inc
++ if {$s < 1} {
++ set s 1
++ }
++ set fontattr(textfont,size) $s
++ font config textfont -size $s
++ font config textfontbold -size $s
++ set textfont [fontname textfont]
++ setcoords
++ settabs
++ redisplay
++}
++
++proc clearsha1 {} {
++ global sha1entry sha1string
++ if {[string length $sha1string] == 40} {
++ $sha1entry delete 0 end
++ }
++}
++
++proc sha1change {n1 n2 op} {
++ global sha1string currentid sha1but
++ if {$sha1string == {}
++ || ([info exists currentid] && $sha1string == $currentid)} {
++ set state disabled
++ } else {
++ set state normal
++ }
++ if {[$sha1but cget -state] == $state} return
++ if {$state == "normal"} {
++ $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
++ } else {
++ $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
++ }
++}
++
++proc gotocommit {} {
++ global sha1string tagids headids curview varcid
++
++ if {$sha1string == {}
++ || ([info exists currentid] && $sha1string == $currentid)} return
++ if {[info exists tagids($sha1string)]} {
++ set id $tagids($sha1string)
++ } elseif {[info exists headids($sha1string)]} {
++ set id $headids($sha1string)
++ } else {
++ set id [string tolower $sha1string]
++ if {[regexp {^[0-9a-f]{4,39}$} $id]} {
++ set matches [array names varcid "$curview,$id*"]
++ if {$matches ne {}} {
++ if {[llength $matches] > 1} {
++ error_popup [mc "Short SHA1 id %s is ambiguous" $id]
++ return
++ }
++ set id [lindex [split [lindex $matches 0] ","] 1]
++ }
++ }
++ }
++ if {[commitinview $id $curview]} {
++ selectline [rowofcommit $id] 1
++ return
++ }
++ if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
++ set msg [mc "SHA1 id %s is not known" $sha1string]
++ } else {
++ set msg [mc "Tag/Head %s is not known" $sha1string]
++ }
++ error_popup $msg
++}
++
++proc lineenter {x y id} {
++ global hoverx hovery hoverid hovertimer
++ global commitinfo canv
++
++ if {![info exists commitinfo($id)] && ![getcommit $id]} return
++ set hoverx $x
++ set hovery $y
++ set hoverid $id
++ if {[info exists hovertimer]} {
++ after cancel $hovertimer
++ }
++ set hovertimer [after 500 linehover]
++ $canv delete hover
++}
++
++proc linemotion {x y id} {
++ global hoverx hovery hoverid hovertimer
++
++ if {[info exists hoverid] && $id == $hoverid} {
++ set hoverx $x
++ set hovery $y
++ if {[info exists hovertimer]} {
++ after cancel $hovertimer
++ }
++ set hovertimer [after 500 linehover]
++ }
++}
++
++proc lineleave {id} {
++ global hoverid hovertimer canv
++
++ if {[info exists hoverid] && $id == $hoverid} {
++ $canv delete hover
++ if {[info exists hovertimer]} {
++ after cancel $hovertimer
++ unset hovertimer
++ }
++ unset hoverid
++ }
++}
++
++proc linehover {} {
++ global hoverx hovery hoverid hovertimer
++ global canv linespc lthickness
++ global commitinfo
++
++ set text [lindex $commitinfo($hoverid) 0]
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax == {}} return
++ set yfrac [lindex [$canv yview] 0]
++ set x [expr {$hoverx + 2 * $linespc}]
++ set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
++ set x0 [expr {$x - 2 * $lthickness}]
++ set y0 [expr {$y - 2 * $lthickness}]
++ set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
++ set y1 [expr {$y + $linespc + 2 * $lthickness}]
++ set t [$canv create rectangle $x0 $y0 $x1 $y1 \
++ -fill \#ffff80 -outline black -width 1 -tags hover]
++ $canv raise $t
++ set t [$canv create text $x $y -anchor nw -text $text -tags hover \
++ -font mainfont]
++ $canv raise $t
++}
++
++proc clickisonarrow {id y} {
++ global lthickness
++
++ set ranges [rowranges $id]
++ set thresh [expr {2 * $lthickness + 6}]
++ set n [expr {[llength $ranges] - 1}]
++ for {set i 1} {$i < $n} {incr i} {
++ set row [lindex $ranges $i]
++ if {abs([yc $row] - $y) < $thresh} {
++ return $i
++ }
++ }
++ return {}
++}
++
++proc arrowjump {id n y} {
++ global canv
++
++ # 1 <-> 2, 3 <-> 4, etc...
++ set n [expr {(($n - 1) ^ 1) + 1}]
++ set row [lindex [rowranges $id] $n]
++ set yt [yc $row]
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax eq {} || $ymax <= 0} return
++ set view [$canv yview]
++ set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
++ set yfrac [expr {$yt / $ymax - $yspan / 2}]
++ if {$yfrac < 0} {
++ set yfrac 0
++ }
++ allcanvs yview moveto $yfrac
++}
++
++proc lineclick {x y id isnew} {
++ global ctext commitinfo children canv thickerline curview
++
++ if {![info exists commitinfo($id)] && ![getcommit $id]} return
++ unmarkmatches
++ unselectline
++ normalline
++ $canv delete hover
++ # draw this line thicker than normal
++ set thickerline $id
++ drawlines $id
++ if {$isnew} {
++ set ymax [lindex [$canv cget -scrollregion] 3]
++ if {$ymax eq {}} return
++ set yfrac [lindex [$canv yview] 0]
++ set y [expr {$y + $yfrac * $ymax}]
++ }
++ set dirn [clickisonarrow $id $y]
++ if {$dirn ne {}} {
++ arrowjump $id $dirn $y
++ return
++ }
++
++ if {$isnew} {
++ addtohistory [list lineclick $x $y $id 0]
++ }
++ # fill the details pane with info about this line
++ $ctext conf -state normal
++ clear_ctext
++ settabs 0
++ $ctext insert end "[mc "Parent"]:\t"
++ $ctext insert end $id link0
++ setlink $id link0
++ set info $commitinfo($id)
++ $ctext insert end "\n\t[lindex $info 0]\n"
++ $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
++ set date [formatdate [lindex $info 2]]
++ $ctext insert end "\t[mc "Date"]:\t$date\n"
++ set kids $children($curview,$id)
++ if {$kids ne {}} {
++ $ctext insert end "\n[mc "Children"]:"
++ set i 0
++ foreach child $kids {
++ incr i
++ if {![info exists commitinfo($child)] && ![getcommit $child]} continue
++ set info $commitinfo($child)
++ $ctext insert end "\n\t"
++ $ctext insert end $child link$i
++ setlink $child link$i
++ $ctext insert end "\n\t[lindex $info 0]"
++ $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
++ set date [formatdate [lindex $info 2]]
++ $ctext insert end "\n\t[mc "Date"]:\t$date\n"
++ }
++ }
++ $ctext conf -state disabled
++ init_flist {}
++}
++
++proc normalline {} {
++ global thickerline
++ if {[info exists thickerline]} {
++ set id $thickerline
++ unset thickerline
++ drawlines $id
++ }
++}
++
++proc selbyid {id} {
++ global curview
++ if {[commitinview $id $curview]} {
++ selectline [rowofcommit $id] 1
++ }
++}
++
++proc mstime {} {
++ global startmstime
++ if {![info exists startmstime]} {
++ set startmstime [clock clicks -milliseconds]
++ }
++ return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
++}
++
++proc rowmenu {x y id} {
++ global rowctxmenu selectedline rowmenuid curview
++ global nullid nullid2 fakerowmenu mainhead
++
++ stopfinding
++ set rowmenuid $id
++ if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
++ set state disabled
++ } else {
++ set state normal
++ }
++ if {$id ne $nullid && $id ne $nullid2} {
++ set menu $rowctxmenu
++ if {$mainhead ne {}} {
++ $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
++ } else {
++ $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
++ }
++ } else {
++ set menu $fakerowmenu
++ }
++ $menu entryconfigure [mc "Diff this -> selected"] -state $state
++ $menu entryconfigure [mc "Diff selected -> this"] -state $state
++ $menu entryconfigure [mc "Make patch"] -state $state
++ tk_popup $menu $x $y
++}
++
++proc diffvssel {dirn} {
++ global rowmenuid selectedline
++
++ if {$selectedline eq {}} return
++ if {$dirn} {
++ set oldid [commitonrow $selectedline]
++ set newid $rowmenuid
++ } else {
++ set oldid $rowmenuid
++ set newid [commitonrow $selectedline]
++ }
++ addtohistory [list doseldiff $oldid $newid]
++ doseldiff $oldid $newid
++}
++
++proc doseldiff {oldid newid} {
++ global ctext
++ global commitinfo
++
++ $ctext conf -state normal
++ clear_ctext
++ init_flist [mc "Top"]
++ $ctext insert end "[mc "From"] "
++ $ctext insert end $oldid link0
++ setlink $oldid link0
++ $ctext insert end "\n "
++ $ctext insert end [lindex $commitinfo($oldid) 0]
++ $ctext insert end "\n\n[mc "To"] "
++ $ctext insert end $newid link1
++ setlink $newid link1
++ $ctext insert end "\n "
++ $ctext insert end [lindex $commitinfo($newid) 0]
++ $ctext insert end "\n"
++ $ctext conf -state disabled
++ $ctext tag remove found 1.0 end
++ startdiff [list $oldid $newid]
++}
++
++proc mkpatch {} {
++ global rowmenuid currentid commitinfo patchtop patchnum
++
++ if {![info exists currentid]} return
++ set oldid $currentid
++ set oldhead [lindex $commitinfo($oldid) 0]
++ set newid $rowmenuid
++ set newhead [lindex $commitinfo($newid) 0]
++ set top .patch
++ set patchtop $top
++ catch {destroy $top}
++ toplevel $top
++ label $top.title -text [mc "Generate patch"]
++ grid $top.title - -pady 10
++ label $top.from -text [mc "From:"]
++ entry $top.fromsha1 -width 40 -relief flat
++ $top.fromsha1 insert 0 $oldid
++ $top.fromsha1 conf -state readonly
++ grid $top.from $top.fromsha1 -sticky w
++ entry $top.fromhead -width 60 -relief flat
++ $top.fromhead insert 0 $oldhead
++ $top.fromhead conf -state readonly
++ grid x $top.fromhead -sticky w
++ label $top.to -text [mc "To:"]
++ entry $top.tosha1 -width 40 -relief flat
++ $top.tosha1 insert 0 $newid
++ $top.tosha1 conf -state readonly
++ grid $top.to $top.tosha1 -sticky w
++ entry $top.tohead -width 60 -relief flat
++ $top.tohead insert 0 $newhead
++ $top.tohead conf -state readonly
++ grid x $top.tohead -sticky w
++ button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
++ grid $top.rev x -pady 10
++ label $top.flab -text [mc "Output file:"]
++ entry $top.fname -width 60
++ $top.fname insert 0 [file normalize "patch$patchnum.patch"]
++ incr patchnum
++ grid $top.flab $top.fname -sticky w
++ frame $top.buts
++ button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
++ button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
++ grid $top.buts.gen $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - -pady 10 -sticky ew
++ focus $top.fname
++}
++
++proc mkpatchrev {} {
++ global patchtop
++
++ set oldid [$patchtop.fromsha1 get]
++ set oldhead [$patchtop.fromhead get]
++ set newid [$patchtop.tosha1 get]
++ set newhead [$patchtop.tohead get]
++ foreach e [list fromsha1 fromhead tosha1 tohead] \
++ v [list $newid $newhead $oldid $oldhead] {
++ $patchtop.$e conf -state normal
++ $patchtop.$e delete 0 end
++ $patchtop.$e insert 0 $v
++ $patchtop.$e conf -state readonly
++ }
++}
++
++proc mkpatchgo {} {
++ global patchtop nullid nullid2
++
++ set oldid [$patchtop.fromsha1 get]
++ set newid [$patchtop.tosha1 get]
++ set fname [$patchtop.fname get]
++ set cmd [diffcmd [list $oldid $newid] -p]
++ # trim off the initial "|"
++ set cmd [lrange $cmd 1 end]
++ lappend cmd >$fname &
++ if {[catch {eval exec $cmd} err]} {
++ error_popup "[mc "Error creating patch:"] $err"
++ }
++ catch {destroy $patchtop}
++ unset patchtop
++}
++
++proc mkpatchcan {} {
++ global patchtop
++
++ catch {destroy $patchtop}
++ unset patchtop
++}
++
++proc mktag {} {
++ global rowmenuid mktagtop commitinfo
++
++ set top .maketag
++ set mktagtop $top
++ catch {destroy $top}
++ toplevel $top
++ label $top.title -text [mc "Create tag"]
++ grid $top.title - -pady 10
++ label $top.id -text [mc "ID:"]
++ entry $top.sha1 -width 40 -relief flat
++ $top.sha1 insert 0 $rowmenuid
++ $top.sha1 conf -state readonly
++ grid $top.id $top.sha1 -sticky w
++ entry $top.head -width 60 -relief flat
++ $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
++ $top.head conf -state readonly
++ grid x $top.head -sticky w
++ label $top.tlab -text [mc "Tag name:"]
++ entry $top.tag -width 60
++ grid $top.tlab $top.tag -sticky w
++ frame $top.buts
++ button $top.buts.gen -text [mc "Create"] -command mktaggo
++ button $top.buts.can -text [mc "Cancel"] -command mktagcan
++ grid $top.buts.gen $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - -pady 10 -sticky ew
++ focus $top.tag
++}
++
++proc domktag {} {
++ global mktagtop env tagids idtags
++
++ set id [$mktagtop.sha1 get]
++ set tag [$mktagtop.tag get]
++ if {$tag == {}} {
++ error_popup [mc "No tag name specified"]
++ return
++ }
++ if {[info exists tagids($tag)]} {
++ error_popup [mc "Tag \"%s\" already exists" $tag]
++ return
++ }
++ if {[catch {
++ exec git tag $tag $id
++ } err]} {
++ error_popup "[mc "Error creating tag:"] $err"
++ return
++ }
++
++ set tagids($tag) $id
++ lappend idtags($id) $tag
++ redrawtags $id
++ addedtag $id
++ dispneartags 0
++ run refill_reflist
++}
++
++proc redrawtags {id} {
++ global canv linehtag idpos currentid curview cmitlisted
++ global canvxmax iddrawn circleitem mainheadid circlecolors
++
++ if {![commitinview $id $curview]} return
++ if {![info exists iddrawn($id)]} return
++ set row [rowofcommit $id]
++ if {$id eq $mainheadid} {
++ set ofill yellow
++ } else {
++ set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
++ }
++ $canv itemconf $circleitem($row) -fill $ofill
++ $canv delete tag.$id
++ set xt [eval drawtags $id $idpos($id)]
++ $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
++ set text [$canv itemcget $linehtag($row) -text]
++ set font [$canv itemcget $linehtag($row) -font]
++ set xr [expr {$xt + [font measure $font $text]}]
++ if {$xr > $canvxmax} {
++ set canvxmax $xr
++ setcanvscroll
++ }
++ if {[info exists currentid] && $currentid == $id} {
++ make_secsel $row
++ }
++}
++
++proc mktagcan {} {
++ global mktagtop
++
++ catch {destroy $mktagtop}
++ unset mktagtop
++}
++
++proc mktaggo {} {
++ domktag
++ mktagcan
++}
++
++proc writecommit {} {
++ global rowmenuid wrcomtop commitinfo wrcomcmd
++
++ set top .writecommit
++ set wrcomtop $top
++ catch {destroy $top}
++ toplevel $top
++ label $top.title -text [mc "Write commit to file"]
++ grid $top.title - -pady 10
++ label $top.id -text [mc "ID:"]
++ entry $top.sha1 -width 40 -relief flat
++ $top.sha1 insert 0 $rowmenuid
++ $top.sha1 conf -state readonly
++ grid $top.id $top.sha1 -sticky w
++ entry $top.head -width 60 -relief flat
++ $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
++ $top.head conf -state readonly
++ grid x $top.head -sticky w
++ label $top.clab -text [mc "Command:"]
++ entry $top.cmd -width 60 -textvariable wrcomcmd
++ grid $top.clab $top.cmd -sticky w -pady 10
++ label $top.flab -text [mc "Output file:"]
++ entry $top.fname -width 60
++ $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
++ grid $top.flab $top.fname -sticky w
++ frame $top.buts
++ button $top.buts.gen -text [mc "Write"] -command wrcomgo
++ button $top.buts.can -text [mc "Cancel"] -command wrcomcan
++ grid $top.buts.gen $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - -pady 10 -sticky ew
++ focus $top.fname
++}
++
++proc wrcomgo {} {
++ global wrcomtop
++
++ set id [$wrcomtop.sha1 get]
++ set cmd "echo $id | [$wrcomtop.cmd get]"
++ set fname [$wrcomtop.fname get]
++ if {[catch {exec sh -c $cmd >$fname &} err]} {
++ error_popup "[mc "Error writing commit:"] $err"
++ }
++ catch {destroy $wrcomtop}
++ unset wrcomtop
++}
++
++proc wrcomcan {} {
++ global wrcomtop
++
++ catch {destroy $wrcomtop}
++ unset wrcomtop
++}
++
++proc mkbranch {} {
++ global rowmenuid mkbrtop
++
++ set top .makebranch
++ catch {destroy $top}
++ toplevel $top
++ label $top.title -text [mc "Create new branch"]
++ grid $top.title - -pady 10
++ label $top.id -text [mc "ID:"]
++ entry $top.sha1 -width 40 -relief flat
++ $top.sha1 insert 0 $rowmenuid
++ $top.sha1 conf -state readonly
++ grid $top.id $top.sha1 -sticky w
++ label $top.nlab -text [mc "Name:"]
++ entry $top.name -width 40
++ grid $top.nlab $top.name -sticky w
++ frame $top.buts
++ button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
++ button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
++ grid $top.buts.go $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - -pady 10 -sticky ew
++ focus $top.name
++}
++
++proc mkbrgo {top} {
++ global headids idheads
++
++ set name [$top.name get]
++ set id [$top.sha1 get]
++ if {$name eq {}} {
++ error_popup [mc "Please specify a name for the new branch"]
++ return
++ }
++ catch {destroy $top}
++ nowbusy newbranch
++ update
++ if {[catch {
++ exec git branch $name $id
++ } err]} {
++ notbusy newbranch
++ error_popup $err
++ } else {
++ set headids($name) $id
++ lappend idheads($id) $name
++ addedhead $id $name
++ notbusy newbranch
++ redrawtags $id
++ dispneartags 0
++ run refill_reflist
++ }
++}
++
++proc cherrypick {} {
++ global rowmenuid curview
++ global mainhead mainheadid
++
++ set oldhead [exec git rev-parse HEAD]
++ set dheads [descheads $rowmenuid]
++ if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
++ set ok [confirm_popup [mc "Commit %s is already\
++ included in branch %s -- really re-apply it?" \
++ [string range $rowmenuid 0 7] $mainhead]]
++ if {!$ok} return
++ }
++ nowbusy cherrypick [mc "Cherry-picking"]
++ update
++ # Unfortunately git-cherry-pick writes stuff to stderr even when
++ # no error occurs, and exec takes that as an indication of error...
++ if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
++ notbusy cherrypick
++ error_popup $err
++ return
++ }
++ set newhead [exec git rev-parse HEAD]
++ if {$newhead eq $oldhead} {
++ notbusy cherrypick
++ error_popup [mc "No changes committed"]
++ return
++ }
++ addnewchild $newhead $oldhead
++ if {[commitinview $oldhead $curview]} {
++ insertrow $newhead $oldhead $curview
++ if {$mainhead ne {}} {
++ movehead $newhead $mainhead
++ movedhead $newhead $mainhead
++ }
++ set mainheadid $newhead
++ redrawtags $oldhead
++ redrawtags $newhead
++ selbyid $newhead
++ }
++ notbusy cherrypick
++}
++
++proc resethead {} {
++ global mainhead rowmenuid confirm_ok resettype
++
++ set confirm_ok 0
++ set w ".confirmreset"
++ toplevel $w
++ wm transient $w .
++ wm title $w [mc "Confirm reset"]
++ message $w.m -text \
++ [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
++ -justify center -aspect 1000
++ pack $w.m -side top -fill x -padx 20 -pady 20
++ frame $w.f -relief sunken -border 2
++ message $w.f.rt -text [mc "Reset type:"] -aspect 1000
++ grid $w.f.rt -sticky w
++ set resettype mixed
++ radiobutton $w.f.soft -value soft -variable resettype -justify left \
++ -text [mc "Soft: Leave working tree and index untouched"]
++ grid $w.f.soft -sticky w
++ radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
++ -text [mc "Mixed: Leave working tree untouched, reset index"]
++ grid $w.f.mixed -sticky w
++ radiobutton $w.f.hard -value hard -variable resettype -justify left \
++ -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
++ grid $w.f.hard -sticky w
++ pack $w.f -side top -fill x
++ button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
++ pack $w.ok -side left -fill x -padx 20 -pady 20
++ button $w.cancel -text [mc Cancel] -command "destroy $w"
++ pack $w.cancel -side right -fill x -padx 20 -pady 20
++ bind $w <Visibility> "grab $w; focus $w"
++ tkwait window $w
++ if {!$confirm_ok} return
++ if {[catch {set fd [open \
++ [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
++ error_popup $err
++ } else {
++ dohidelocalchanges
++ filerun $fd [list readresetstat $fd]
++ nowbusy reset [mc "Resetting"]
++ selbyid $rowmenuid
++ }
++}
++
++proc readresetstat {fd} {
++ global mainhead mainheadid showlocalchanges rprogcoord
++
++ if {[gets $fd line] >= 0} {
++ if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
++ set rprogcoord [expr {1.0 * $m / $n}]
++ adjustprogress
++ }
++ return 1
++ }
++ set rprogcoord 0
++ adjustprogress
++ notbusy reset
++ if {[catch {close $fd} err]} {
++ error_popup $err
++ }
++ set oldhead $mainheadid
++ set newhead [exec git rev-parse HEAD]
++ if {$newhead ne $oldhead} {
++ movehead $newhead $mainhead
++ movedhead $newhead $mainhead
++ set mainheadid $newhead
++ redrawtags $oldhead
++ redrawtags $newhead
++ }
++ if {$showlocalchanges} {
++ doshowlocalchanges
++ }
++ return 0
++}
++
++# context menu for a head
++proc headmenu {x y id head} {
++ global headmenuid headmenuhead headctxmenu mainhead
++
++ stopfinding
++ set headmenuid $id
++ set headmenuhead $head
++ set state normal
++ if {$head eq $mainhead} {
++ set state disabled
++ }
++ $headctxmenu entryconfigure 0 -state $state
++ $headctxmenu entryconfigure 1 -state $state
++ tk_popup $headctxmenu $x $y
++}
++
++proc cobranch {} {
++ global headmenuid headmenuhead headids
++ global showlocalchanges mainheadid
++
++ # check the tree is clean first??
++ nowbusy checkout [mc "Checking out"]
++ update
++ dohidelocalchanges
++ if {[catch {
++ set fd [open [list | git checkout $headmenuhead 2>@1] r]
++ } err]} {
++ notbusy checkout
++ error_popup $err
++ if {$showlocalchanges} {
++ dodiffindex
++ }
++ } else {
++ filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
++ }
++}
++
++proc readcheckoutstat {fd newhead newheadid} {
++ global mainhead mainheadid headids showlocalchanges progresscoords
++
++ if {[gets $fd line] >= 0} {
++ if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
++ set progresscoords [list 0 [expr {1.0 * $m / $n}]]
++ adjustprogress
++ }
++ return 1
++ }
++ set progresscoords {0 0}
++ adjustprogress
++ notbusy checkout
++ if {[catch {close $fd} err]} {
++ error_popup $err
++ }
++ set oldmainid $mainheadid
++ set mainhead $newhead
++ set mainheadid $newheadid
++ redrawtags $oldmainid
++ redrawtags $newheadid
++ selbyid $newheadid
++ if {$showlocalchanges} {
++ dodiffindex
++ }
++}
++
++proc rmbranch {} {
++ global headmenuid headmenuhead mainhead
++ global idheads
++
++ set head $headmenuhead
++ set id $headmenuid
++ # this check shouldn't be needed any more...
++ if {$head eq $mainhead} {
++ error_popup [mc "Cannot delete the currently checked-out branch"]
++ return
++ }
++ set dheads [descheads $id]
++ if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
++ # the stuff on this branch isn't on any other branch
++ if {![confirm_popup [mc "The commits on branch %s aren't on any other\
++ branch.\nReally delete branch %s?" $head $head]]} return
++ }
++ nowbusy rmbranch
++ update
++ if {[catch {exec git branch -D $head} err]} {
++ notbusy rmbranch
++ error_popup $err
++ return
++ }
++ removehead $id $head
++ removedhead $id $head
++ redrawtags $id
++ notbusy rmbranch
++ dispneartags 0
++ run refill_reflist
++}
++
++# Display a list of tags and heads
++proc showrefs {} {
++ global showrefstop bgcolor fgcolor selectbgcolor
++ global bglist fglist reflistfilter reflist maincursor
++
++ set top .showrefs
++ set showrefstop $top
++ if {[winfo exists $top]} {
++ raise $top
++ refill_reflist
++ return
++ }
++ toplevel $top
++ wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
++ text $top.list -background $bgcolor -foreground $fgcolor \
++ -selectbackground $selectbgcolor -font mainfont \
++ -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
++ -width 30 -height 20 -cursor $maincursor \
++ -spacing1 1 -spacing3 1 -state disabled
++ $top.list tag configure highlight -background $selectbgcolor
++ lappend bglist $top.list
++ lappend fglist $top.list
++ scrollbar $top.ysb -command "$top.list yview" -orient vertical
++ scrollbar $top.xsb -command "$top.list xview" -orient horizontal
++ grid $top.list $top.ysb -sticky nsew
++ grid $top.xsb x -sticky ew
++ frame $top.f
++ label $top.f.l -text "[mc "Filter"]: "
++ entry $top.f.e -width 20 -textvariable reflistfilter
++ set reflistfilter "*"
++ trace add variable reflistfilter write reflistfilter_change
++ pack $top.f.e -side right -fill x -expand 1
++ pack $top.f.l -side left
++ grid $top.f - -sticky ew -pady 2
++ button $top.close -command [list destroy $top] -text [mc "Close"]
++ grid $top.close -
++ grid columnconfigure $top 0 -weight 1
++ grid rowconfigure $top 0 -weight 1
++ bind $top.list <1> {break}
++ bind $top.list <B1-Motion> {break}
++ bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
++ set reflist {}
++ refill_reflist
++}
++
++proc sel_reflist {w x y} {
++ global showrefstop reflist headids tagids otherrefids
++
++ if {![winfo exists $showrefstop]} return
++ set l [lindex [split [$w index "@$x,$y"] "."] 0]
++ set ref [lindex $reflist [expr {$l-1}]]
++ set n [lindex $ref 0]
++ switch -- [lindex $ref 1] {
++ "H" {selbyid $headids($n)}
++ "T" {selbyid $tagids($n)}
++ "o" {selbyid $otherrefids($n)}
++ }
++ $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
++}
++
++proc unsel_reflist {} {
++ global showrefstop
++
++ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
++ $showrefstop.list tag remove highlight 0.0 end
++}
++
++proc reflistfilter_change {n1 n2 op} {
++ global reflistfilter
++
++ after cancel refill_reflist
++ after 200 refill_reflist
++}
++
++proc refill_reflist {} {
++ global reflist reflistfilter showrefstop headids tagids otherrefids
++ global curview commitinterest
++
++ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
++ set refs {}
++ foreach n [array names headids] {
++ if {[string match $reflistfilter $n]} {
++ if {[commitinview $headids($n) $curview]} {
++ lappend refs [list $n H]
++ } else {
++ set commitinterest($headids($n)) {run refill_reflist}
++ }
++ }
++ }
++ foreach n [array names tagids] {
++ if {[string match $reflistfilter $n]} {
++ if {[commitinview $tagids($n) $curview]} {
++ lappend refs [list $n T]
++ } else {
++ set commitinterest($tagids($n)) {run refill_reflist}
++ }
++ }
++ }
++ foreach n [array names otherrefids] {
++ if {[string match $reflistfilter $n]} {
++ if {[commitinview $otherrefids($n) $curview]} {
++ lappend refs [list $n o]
++ } else {
++ set commitinterest($otherrefids($n)) {run refill_reflist}
++ }
++ }
++ }
++ set refs [lsort -index 0 $refs]
++ if {$refs eq $reflist} return
++
++ # Update the contents of $showrefstop.list according to the
++ # differences between $reflist (old) and $refs (new)
++ $showrefstop.list conf -state normal
++ $showrefstop.list insert end "\n"
++ set i 0
++ set j 0
++ while {$i < [llength $reflist] || $j < [llength $refs]} {
++ if {$i < [llength $reflist]} {
++ if {$j < [llength $refs]} {
++ set cmp [string compare [lindex $reflist $i 0] \
++ [lindex $refs $j 0]]
++ if {$cmp == 0} {
++ set cmp [string compare [lindex $reflist $i 1] \
++ [lindex $refs $j 1]]
++ }
++ } else {
++ set cmp -1
++ }
++ } else {
++ set cmp 1
++ }
++ switch -- $cmp {
++ -1 {
++ $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
++ incr i
++ }
++ 0 {
++ incr i
++ incr j
++ }
++ 1 {
++ set l [expr {$j + 1}]
++ $showrefstop.list image create $l.0 -align baseline \
++ -image reficon-[lindex $refs $j 1] -padx 2
++ $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
++ incr j
++ }
++ }
++ }
++ set reflist $refs
++ # delete last newline
++ $showrefstop.list delete end-2c end-1c
++ $showrefstop.list conf -state disabled
++}
++
++# Stuff for finding nearby tags
++proc getallcommits {} {
++ global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
++ global idheads idtags idotherrefs allparents tagobjid
++
++ if {![info exists allcommits]} {
++ set nextarc 0
++ set allcommits 0
++ set seeds {}
++ set allcwait 0
++ set cachedarcs 0
++ set allccache [file join [gitdir] "gitk.cache"]
++ if {![catch {
++ set f [open $allccache r]
++ set allcwait 1
++ getcache $f
++ }]} return
++ }
++
++ if {$allcwait} {
++ return
++ }
++ set cmd [list | git rev-list --parents]
++ set allcupdate [expr {$seeds ne {}}]
++ if {!$allcupdate} {
++ set ids "--all"
++ } else {
++ set refs [concat [array names idheads] [array names idtags] \
++ [array names idotherrefs]]
++ set ids {}
++ set tagobjs {}
++ foreach name [array names tagobjid] {
++ lappend tagobjs $tagobjid($name)
++ }
++ foreach id [lsort -unique $refs] {
++ if {![info exists allparents($id)] &&
++ [lsearch -exact $tagobjs $id] < 0} {
++ lappend ids $id
++ }
++ }
++ if {$ids ne {}} {
++ foreach id $seeds {
++ lappend ids "^$id"
++ }
++ }
++ }
++ if {$ids ne {}} {
++ set fd [open [concat $cmd $ids] r]
++ fconfigure $fd -blocking 0
++ incr allcommits
++ nowbusy allcommits
++ filerun $fd [list getallclines $fd]
++ } else {
++ dispneartags 0
++ }
++}
++
++# Since most commits have 1 parent and 1 child, we group strings of
++# such commits into "arcs" joining branch/merge points (BMPs), which
++# are commits that either don't have 1 parent or don't have 1 child.
++#
++# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
++# arcout(id) - outgoing arcs for BMP
++# arcids(a) - list of IDs on arc including end but not start
++# arcstart(a) - BMP ID at start of arc
++# arcend(a) - BMP ID at end of arc
++# growing(a) - arc a is still growing
++# arctags(a) - IDs out of arcids (excluding end) that have tags
++# archeads(a) - IDs out of arcids (excluding end) that have heads
++# The start of an arc is at the descendent end, so "incoming" means
++# coming from descendents, and "outgoing" means going towards ancestors.
++
++proc getallclines {fd} {
++ global allparents allchildren idtags idheads nextarc
++ global arcnos arcids arctags arcout arcend arcstart archeads growing
++ global seeds allcommits cachedarcs allcupdate
++
++ set nid 0
++ while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
++ set id [lindex $line 0]
++ if {[info exists allparents($id)]} {
++ # seen it already
++ continue
++ }
++ set cachedarcs 0
++ set olds [lrange $line 1 end]
++ set allparents($id) $olds
++ if {![info exists allchildren($id)]} {
++ set allchildren($id) {}
++ set arcnos($id) {}
++ lappend seeds $id
++ } else {
++ set a $arcnos($id)
++ if {[llength $olds] == 1 && [llength $a] == 1} {
++ lappend arcids($a) $id
++ if {[info exists idtags($id)]} {
++ lappend arctags($a) $id
++ }
++ if {[info exists idheads($id)]} {
++ lappend archeads($a) $id
++ }
++ if {[info exists allparents($olds)]} {
++ # seen parent already
++ if {![info exists arcout($olds)]} {
++ splitarc $olds
++ }
++ lappend arcids($a) $olds
++ set arcend($a) $olds
++ unset growing($a)
++ }
++ lappend allchildren($olds) $id
++ lappend arcnos($olds) $a
++ continue
++ }
++ }
++ foreach a $arcnos($id) {
++ lappend arcids($a) $id
++ set arcend($a) $id
++ unset growing($a)
++ }
++
++ set ao {}
++ foreach p $olds {
++ lappend allchildren($p) $id
++ set a [incr nextarc]
++ set arcstart($a) $id
++ set archeads($a) {}
++ set arctags($a) {}
++ set archeads($a) {}
++ set arcids($a) {}
++ lappend ao $a
++ set growing($a) 1
++ if {[info exists allparents($p)]} {
++ # seen it already, may need to make a new branch
++ if {![info exists arcout($p)]} {
++ splitarc $p
++ }
++ lappend arcids($a) $p
++ set arcend($a) $p
++ unset growing($a)
++ }
++ lappend arcnos($p) $a
++ }
++ set arcout($id) $ao
++ }
++ if {$nid > 0} {
++ global cached_dheads cached_dtags cached_atags
++ catch {unset cached_dheads}
++ catch {unset cached_dtags}
++ catch {unset cached_atags}
++ }
++ if {![eof $fd]} {
++ return [expr {$nid >= 1000? 2: 1}]
++ }
++ set cacheok 1
++ if {[catch {
++ fconfigure $fd -blocking 1
++ close $fd
++ } err]} {
++ # got an error reading the list of commits
++ # if we were updating, try rereading the whole thing again
++ if {$allcupdate} {
++ incr allcommits -1
++ dropcache $err
++ return
++ }
++ error_popup "[mc "Error reading commit topology information;\
++ branch and preceding/following tag information\
++ will be incomplete."]\n($err)"
++ set cacheok 0
++ }
++ if {[incr allcommits -1] == 0} {
++ notbusy allcommits
++ if {$cacheok} {
++ run savecache
++ }
++ }
++ dispneartags 0
++ return 0
++}
++
++proc recalcarc {a} {
++ global arctags archeads arcids idtags idheads
++
++ set at {}
++ set ah {}
++ foreach id [lrange $arcids($a) 0 end-1] {
++ if {[info exists idtags($id)]} {
++ lappend at $id
++ }
++ if {[info exists idheads($id)]} {
++ lappend ah $id
++ }
++ }
++ set arctags($a) $at
++ set archeads($a) $ah
++}
++
++proc splitarc {p} {
++ global arcnos arcids nextarc arctags archeads idtags idheads
++ global arcstart arcend arcout allparents growing
++
++ set a $arcnos($p)
++ if {[llength $a] != 1} {
++ puts "oops splitarc called but [llength $a] arcs already"
++ return
++ }
++ set a [lindex $a 0]
++ set i [lsearch -exact $arcids($a) $p]
++ if {$i < 0} {
++ puts "oops splitarc $p not in arc $a"
++ return
++ }
++ set na [incr nextarc]
++ if {[info exists arcend($a)]} {
++ set arcend($na) $arcend($a)
++ } else {
++ set l [lindex $allparents([lindex $arcids($a) end]) 0]
++ set j [lsearch -exact $arcnos($l) $a]
++ set arcnos($l) [lreplace $arcnos($l) $j $j $na]
++ }
++ set tail [lrange $arcids($a) [expr {$i+1}] end]
++ set arcids($a) [lrange $arcids($a) 0 $i]
++ set arcend($a) $p
++ set arcstart($na) $p
++ set arcout($p) $na
++ set arcids($na) $tail
++ if {[info exists growing($a)]} {
++ set growing($na) 1
++ unset growing($a)
++ }
++
++ foreach id $tail {
++ if {[llength $arcnos($id)] == 1} {
++ set arcnos($id) $na
++ } else {
++ set j [lsearch -exact $arcnos($id) $a]
++ set arcnos($id) [lreplace $arcnos($id) $j $j $na]
++ }
++ }
++
++ # reconstruct tags and heads lists
++ if {$arctags($a) ne {} || $archeads($a) ne {}} {
++ recalcarc $a
++ recalcarc $na
++ } else {
++ set arctags($na) {}
++ set archeads($na) {}
++ }
++}
++
++# Update things for a new commit added that is a child of one
++# existing commit. Used when cherry-picking.
++proc addnewchild {id p} {
++ global allparents allchildren idtags nextarc
++ global arcnos arcids arctags arcout arcend arcstart archeads growing
++ global seeds allcommits
++
++ if {![info exists allcommits] || ![info exists arcnos($p)]} return
++ set allparents($id) [list $p]
++ set allchildren($id) {}
++ set arcnos($id) {}
++ lappend seeds $id
++ lappend allchildren($p) $id
++ set a [incr nextarc]
++ set arcstart($a) $id
++ set archeads($a) {}
++ set arctags($a) {}
++ set arcids($a) [list $p]
++ set arcend($a) $p
++ if {![info exists arcout($p)]} {
++ splitarc $p
++ }
++ lappend arcnos($p) $a
++ set arcout($id) [list $a]
++}
++
++# This implements a cache for the topology information.
++# The cache saves, for each arc, the start and end of the arc,
++# the ids on the arc, and the outgoing arcs from the end.
++proc readcache {f} {
++ global arcnos arcids arcout arcstart arcend arctags archeads nextarc
++ global idtags idheads allparents cachedarcs possible_seeds seeds growing
++ global allcwait
++
++ set a $nextarc
++ set lim $cachedarcs
++ if {$lim - $a > 500} {
++ set lim [expr {$a + 500}]
++ }
++ if {[catch {
++ if {$a == $lim} {
++ # finish reading the cache and setting up arctags, etc.
++ set line [gets $f]
++ if {$line ne "1"} {error "bad final version"}
++ close $f
++ foreach id [array names idtags] {
++ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
++ [llength $allparents($id)] == 1} {
++ set a [lindex $arcnos($id) 0]
++ if {$arctags($a) eq {}} {
++ recalcarc $a
++ }
++ }
++ }
++ foreach id [array names idheads] {
++ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
++ [llength $allparents($id)] == 1} {
++ set a [lindex $arcnos($id) 0]
++ if {$archeads($a) eq {}} {
++ recalcarc $a
++ }
++ }
++ }
++ foreach id [lsort -unique $possible_seeds] {
++ if {$arcnos($id) eq {}} {
++ lappend seeds $id
++ }
++ }
++ set allcwait 0
++ } else {
++ while {[incr a] <= $lim} {
++ set line [gets $f]
++ if {[llength $line] != 3} {error "bad line"}
++ set s [lindex $line 0]
++ set arcstart($a) $s
++ lappend arcout($s) $a
++ if {![info exists arcnos($s)]} {
++ lappend possible_seeds $s
++ set arcnos($s) {}
++ }
++ set e [lindex $line 1]
++ if {$e eq {}} {
++ set growing($a) 1
++ } else {
++ set arcend($a) $e
++ if {![info exists arcout($e)]} {
++ set arcout($e) {}
++ }
++ }
++ set arcids($a) [lindex $line 2]
++ foreach id $arcids($a) {
++ lappend allparents($s) $id
++ set s $id
++ lappend arcnos($id) $a
++ }
++ if {![info exists allparents($s)]} {
++ set allparents($s) {}
++ }
++ set arctags($a) {}
++ set archeads($a) {}
++ }
++ set nextarc [expr {$a - 1}]
++ }
++ } err]} {
++ dropcache $err
++ return 0
++ }
++ if {!$allcwait} {
++ getallcommits
++ }
++ return $allcwait
++}
++
++proc getcache {f} {
++ global nextarc cachedarcs possible_seeds
++
++ if {[catch {
++ set line [gets $f]
++ if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
++ # make sure it's an integer
++ set cachedarcs [expr {int([lindex $line 1])}]
++ if {$cachedarcs < 0} {error "bad number of arcs"}
++ set nextarc 0
++ set possible_seeds {}
++ run readcache $f
++ } err]} {
++ dropcache $err
++ }
++ return 0
++}
++
++proc dropcache {err} {
++ global allcwait nextarc cachedarcs seeds
++
++ #puts "dropping cache ($err)"
++ foreach v {arcnos arcout arcids arcstart arcend growing \
++ arctags archeads allparents allchildren} {
++ global $v
++ catch {unset $v}
++ }
++ set allcwait 0
++ set nextarc 0
++ set cachedarcs 0
++ set seeds {}
++ getallcommits
++}
++
++proc writecache {f} {
++ global cachearc cachedarcs allccache
++ global arcstart arcend arcnos arcids arcout
++
++ set a $cachearc
++ set lim $cachedarcs
++ if {$lim - $a > 1000} {
++ set lim [expr {$a + 1000}]
++ }
++ if {[catch {
++ while {[incr a] <= $lim} {
++ if {[info exists arcend($a)]} {
++ puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
++ } else {
++ puts $f [list $arcstart($a) {} $arcids($a)]
++ }
++ }
++ } err]} {
++ catch {close $f}
++ catch {file delete $allccache}
++ #puts "writing cache failed ($err)"
++ return 0
++ }
++ set cachearc [expr {$a - 1}]
++ if {$a > $cachedarcs} {
++ puts $f "1"
++ close $f
++ return 0
++ }
++ return 1
++}
++
++proc savecache {} {
++ global nextarc cachedarcs cachearc allccache
++
++ if {$nextarc == $cachedarcs} return
++ set cachearc 0
++ set cachedarcs $nextarc
++ catch {
++ set f [open $allccache w]
++ puts $f [list 1 $cachedarcs]
++ run writecache $f
++ }
++}
++
++# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
++# or 0 if neither is true.
++proc anc_or_desc {a b} {
++ global arcout arcstart arcend arcnos cached_isanc
++
++ if {$arcnos($a) eq $arcnos($b)} {
++ # Both are on the same arc(s); either both are the same BMP,
++ # or if one is not a BMP, the other is also not a BMP or is
++ # the BMP at end of the arc (and it only has 1 incoming arc).
++ # Or both can be BMPs with no incoming arcs.
++ if {$a eq $b || $arcnos($a) eq {}} {
++ return 0
++ }
++ # assert {[llength $arcnos($a)] == 1}
++ set arc [lindex $arcnos($a) 0]
++ set i [lsearch -exact $arcids($arc) $a]
++ set j [lsearch -exact $arcids($arc) $b]
++ if {$i < 0 || $i > $j} {
++ return 1
++ } else {
++ return -1
++ }
++ }
++
++ if {![info exists arcout($a)]} {
++ set arc [lindex $arcnos($a) 0]
++ if {[info exists arcend($arc)]} {
++ set aend $arcend($arc)
++ } else {
++ set aend {}
++ }
++ set a $arcstart($arc)
++ } else {
++ set aend $a
++ }
++ if {![info exists arcout($b)]} {
++ set arc [lindex $arcnos($b) 0]
++ if {[info exists arcend($arc)]} {
++ set bend $arcend($arc)
++ } else {
++ set bend {}
++ }
++ set b $arcstart($arc)
++ } else {
++ set bend $b
++ }
++ if {$a eq $bend} {
++ return 1
++ }
++ if {$b eq $aend} {
++ return -1
++ }
++ if {[info exists cached_isanc($a,$bend)]} {
++ if {$cached_isanc($a,$bend)} {
++ return 1
++ }
++ }
++ if {[info exists cached_isanc($b,$aend)]} {
++ if {$cached_isanc($b,$aend)} {
++ return -1
++ }
++ if {[info exists cached_isanc($a,$bend)]} {
++ return 0
++ }
++ }
++
++ set todo [list $a $b]
++ set anc($a) a
++ set anc($b) b
++ for {set i 0} {$i < [llength $todo]} {incr i} {
++ set x [lindex $todo $i]
++ if {$anc($x) eq {}} {
++ continue
++ }
++ foreach arc $arcnos($x) {
++ set xd $arcstart($arc)
++ if {$xd eq $bend} {
++ set cached_isanc($a,$bend) 1
++ set cached_isanc($b,$aend) 0
++ return 1
++ } elseif {$xd eq $aend} {
++ set cached_isanc($b,$aend) 1
++ set cached_isanc($a,$bend) 0
++ return -1
++ }
++ if {![info exists anc($xd)]} {
++ set anc($xd) $anc($x)
++ lappend todo $xd
++ } elseif {$anc($xd) ne $anc($x)} {
++ set anc($xd) {}
++ }
++ }
++ }
++ set cached_isanc($a,$bend) 0
++ set cached_isanc($b,$aend) 0
++ return 0
++}
++
++# This identifies whether $desc has an ancestor that is
++# a growing tip of the graph and which is not an ancestor of $anc
++# and returns 0 if so and 1 if not.
++# If we subsequently discover a tag on such a growing tip, and that
++# turns out to be a descendent of $anc (which it could, since we
++# don't necessarily see children before parents), then $desc
++# isn't a good choice to display as a descendent tag of
++# $anc (since it is the descendent of another tag which is
++# a descendent of $anc). Similarly, $anc isn't a good choice to
++# display as a ancestor tag of $desc.
++#
++proc is_certain {desc anc} {
++ global arcnos arcout arcstart arcend growing problems
++
++ set certain {}
++ if {[llength $arcnos($anc)] == 1} {
++ # tags on the same arc are certain
++ if {$arcnos($desc) eq $arcnos($anc)} {
++ return 1
++ }
++ if {![info exists arcout($anc)]} {
++ # if $anc is partway along an arc, use the start of the arc instead
++ set a [lindex $arcnos($anc) 0]
++ set anc $arcstart($a)
++ }
++ }
++ if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
++ set x $desc
++ } else {
++ set a [lindex $arcnos($desc) 0]
++ set x $arcend($a)
++ }
++ if {$x == $anc} {
++ return 1
++ }
++ set anclist [list $x]
++ set dl($x) 1
++ set nnh 1
++ set ngrowanc 0
++ for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
++ set x [lindex $anclist $i]
++ if {$dl($x)} {
++ incr nnh -1
++ }
++ set done($x) 1
++ foreach a $arcout($x) {
++ if {[info exists growing($a)]} {
++ if {![info exists growanc($x)] && $dl($x)} {
++ set growanc($x) 1
++ incr ngrowanc
++ }
++ } else {
++ set y $arcend($a)
++ if {[info exists dl($y)]} {
++ if {$dl($y)} {
++ if {!$dl($x)} {
++ set dl($y) 0
++ if {![info exists done($y)]} {
++ incr nnh -1
++ }
++ if {[info exists growanc($x)]} {
++ incr ngrowanc -1
++ }
++ set xl [list $y]
++ for {set k 0} {$k < [llength $xl]} {incr k} {
++ set z [lindex $xl $k]
++ foreach c $arcout($z) {
++ if {[info exists arcend($c)]} {
++ set v $arcend($c)
++ if {[info exists dl($v)] && $dl($v)} {
++ set dl($v) 0
++ if {![info exists done($v)]} {
++ incr nnh -1
++ }
++ if {[info exists growanc($v)]} {
++ incr ngrowanc -1
++ }
++ lappend xl $v
++ }
++ }
++ }
++ }
++ }
++ }
++ } elseif {$y eq $anc || !$dl($x)} {
++ set dl($y) 0
++ lappend anclist $y
++ } else {
++ set dl($y) 1
++ lappend anclist $y
++ incr nnh
++ }
++ }
++ }
++ }
++ foreach x [array names growanc] {
++ if {$dl($x)} {
++ return 0
++ }
++ return 0
++ }
++ return 1
++}
++
++proc validate_arctags {a} {
++ global arctags idtags
++
++ set i -1
++ set na $arctags($a)
++ foreach id $arctags($a) {
++ incr i
++ if {![info exists idtags($id)]} {
++ set na [lreplace $na $i $i]
++ incr i -1
++ }
++ }
++ set arctags($a) $na
++}
++
++proc validate_archeads {a} {
++ global archeads idheads
++
++ set i -1
++ set na $archeads($a)
++ foreach id $archeads($a) {
++ incr i
++ if {![info exists idheads($id)]} {
++ set na [lreplace $na $i $i]
++ incr i -1
++ }
++ }
++ set archeads($a) $na
++}
++
++# Return the list of IDs that have tags that are descendents of id,
++# ignoring IDs that are descendents of IDs already reported.
++proc desctags {id} {
++ global arcnos arcstart arcids arctags idtags allparents
++ global growing cached_dtags
++
++ if {![info exists allparents($id)]} {
++ return {}
++ }
++ set t1 [clock clicks -milliseconds]
++ set argid $id
++ if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
++ # part-way along an arc; check that arc first
++ set a [lindex $arcnos($id) 0]
++ if {$arctags($a) ne {}} {
++ validate_arctags $a
++ set i [lsearch -exact $arcids($a) $id]
++ set tid {}
++ foreach t $arctags($a) {
++ set j [lsearch -exact $arcids($a) $t]
++ if {$j >= $i} break
++ set tid $t
++ }
++ if {$tid ne {}} {
++ return $tid
++ }
++ }
++ set id $arcstart($a)
++ if {[info exists idtags($id)]} {
++ return $id
++ }
++ }
++ if {[info exists cached_dtags($id)]} {
++ return $cached_dtags($id)
++ }
++
++ set origid $id
++ set todo [list $id]
++ set queued($id) 1
++ set nc 1
++ for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
++ set id [lindex $todo $i]
++ set done($id) 1
++ set ta [info exists hastaggedancestor($id)]
++ if {!$ta} {
++ incr nc -1
++ }
++ # ignore tags on starting node
++ if {!$ta && $i > 0} {
++ if {[info exists idtags($id)]} {
++ set tagloc($id) $id
++ set ta 1
++ } elseif {[info exists cached_dtags($id)]} {
++ set tagloc($id) $cached_dtags($id)
++ set ta 1
++ }
++ }
++ foreach a $arcnos($id) {
++ set d $arcstart($a)
++ if {!$ta && $arctags($a) ne {}} {
++ validate_arctags $a
++ if {$arctags($a) ne {}} {
++ lappend tagloc($id) [lindex $arctags($a) end]
++ }
++ }
++ if {$ta || $arctags($a) ne {}} {
++ set tomark [list $d]
++ for {set j 0} {$j < [llength $tomark]} {incr j} {
++ set dd [lindex $tomark $j]
++ if {![info exists hastaggedancestor($dd)]} {
++ if {[info exists done($dd)]} {
++ foreach b $arcnos($dd) {
++ lappend tomark $arcstart($b)
++ }
++ if {[info exists tagloc($dd)]} {
++ unset tagloc($dd)
++ }
++ } elseif {[info exists queued($dd)]} {
++ incr nc -1
++ }
++ set hastaggedancestor($dd) 1
++ }
++ }
++ }
++ if {![info exists queued($d)]} {
++ lappend todo $d
++ set queued($d) 1
++ if {![info exists hastaggedancestor($d)]} {
++ incr nc
++ }
++ }
++ }
++ }
++ set tags {}
++ foreach id [array names tagloc] {
++ if {![info exists hastaggedancestor($id)]} {
++ foreach t $tagloc($id) {
++ if {[lsearch -exact $tags $t] < 0} {
++ lappend tags $t
++ }
++ }
++ }
++ }
++ set t2 [clock clicks -milliseconds]
++ set loopix $i
++
++ # remove tags that are descendents of other tags
++ for {set i 0} {$i < [llength $tags]} {incr i} {
++ set a [lindex $tags $i]
++ for {set j 0} {$j < $i} {incr j} {
++ set b [lindex $tags $j]
++ set r [anc_or_desc $a $b]
++ if {$r == 1} {
++ set tags [lreplace $tags $j $j]
++ incr j -1
++ incr i -1
++ } elseif {$r == -1} {
++ set tags [lreplace $tags $i $i]
++ incr i -1
++ break
++ }
++ }
++ }
++
++ if {[array names growing] ne {}} {
++ # graph isn't finished, need to check if any tag could get
++ # eclipsed by another tag coming later. Simply ignore any
++ # tags that could later get eclipsed.
++ set ctags {}
++ foreach t $tags {
++ if {[is_certain $t $origid]} {
++ lappend ctags $t
++ }
++ }
++ if {$tags eq $ctags} {
++ set cached_dtags($origid) $tags
++ } else {
++ set tags $ctags
++ }
++ } else {
++ set cached_dtags($origid) $tags
++ }
++ set t3 [clock clicks -milliseconds]
++ if {0 && $t3 - $t1 >= 100} {
++ puts "iterating descendents ($loopix/[llength $todo] nodes) took\
++ [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
++ }
++ return $tags
++}
++
++proc anctags {id} {
++ global arcnos arcids arcout arcend arctags idtags allparents
++ global growing cached_atags
++
++ if {![info exists allparents($id)]} {
++ return {}
++ }
++ set t1 [clock clicks -milliseconds]
++ set argid $id
++ if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
++ # part-way along an arc; check that arc first
++ set a [lindex $arcnos($id) 0]
++ if {$arctags($a) ne {}} {
++ validate_arctags $a
++ set i [lsearch -exact $arcids($a) $id]
++ foreach t $arctags($a) {
++ set j [lsearch -exact $arcids($a) $t]
++ if {$j > $i} {
++ return $t
++ }
++ }
++ }
++ if {![info exists arcend($a)]} {
++ return {}
++ }
++ set id $arcend($a)
++ if {[info exists idtags($id)]} {
++ return $id
++ }
++ }
++ if {[info exists cached_atags($id)]} {
++ return $cached_atags($id)
++ }
++
++ set origid $id
++ set todo [list $id]
++ set queued($id) 1
++ set taglist {}
++ set nc 1
++ for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
++ set id [lindex $todo $i]
++ set done($id) 1
++ set td [info exists hastaggeddescendent($id)]
++ if {!$td} {
++ incr nc -1
++ }
++ # ignore tags on starting node
++ if {!$td && $i > 0} {
++ if {[info exists idtags($id)]} {
++ set tagloc($id) $id
++ set td 1
++ } elseif {[info exists cached_atags($id)]} {
++ set tagloc($id) $cached_atags($id)
++ set td 1
++ }
++ }
++ foreach a $arcout($id) {
++ if {!$td && $arctags($a) ne {}} {
++ validate_arctags $a
++ if {$arctags($a) ne {}} {
++ lappend tagloc($id) [lindex $arctags($a) 0]
++ }
++ }
++ if {![info exists arcend($a)]} continue
++ set d $arcend($a)
++ if {$td || $arctags($a) ne {}} {
++ set tomark [list $d]
++ for {set j 0} {$j < [llength $tomark]} {incr j} {
++ set dd [lindex $tomark $j]
++ if {![info exists hastaggeddescendent($dd)]} {
++ if {[info exists done($dd)]} {
++ foreach b $arcout($dd) {
++ if {[info exists arcend($b)]} {
++ lappend tomark $arcend($b)
++ }
++ }
++ if {[info exists tagloc($dd)]} {
++ unset tagloc($dd)
++ }
++ } elseif {[info exists queued($dd)]} {
++ incr nc -1
++ }
++ set hastaggeddescendent($dd) 1
++ }
++ }
++ }
++ if {![info exists queued($d)]} {
++ lappend todo $d
++ set queued($d) 1
++ if {![info exists hastaggeddescendent($d)]} {
++ incr nc
++ }
++ }
++ }
++ }
++ set t2 [clock clicks -milliseconds]
++ set loopix $i
++ set tags {}
++ foreach id [array names tagloc] {
++ if {![info exists hastaggeddescendent($id)]} {
++ foreach t $tagloc($id) {
++ if {[lsearch -exact $tags $t] < 0} {
++ lappend tags $t
++ }
++ }
++ }
++ }
++
++ # remove tags that are ancestors of other tags
++ for {set i 0} {$i < [llength $tags]} {incr i} {
++ set a [lindex $tags $i]
++ for {set j 0} {$j < $i} {incr j} {
++ set b [lindex $tags $j]
++ set r [anc_or_desc $a $b]
++ if {$r == -1} {
++ set tags [lreplace $tags $j $j]
++ incr j -1
++ incr i -1
++ } elseif {$r == 1} {
++ set tags [lreplace $tags $i $i]
++ incr i -1
++ break
++ }
++ }
++ }
++
++ if {[array names growing] ne {}} {
++ # graph isn't finished, need to check if any tag could get
++ # eclipsed by another tag coming later. Simply ignore any
++ # tags that could later get eclipsed.
++ set ctags {}
++ foreach t $tags {
++ if {[is_certain $origid $t]} {
++ lappend ctags $t
++ }
++ }
++ if {$tags eq $ctags} {
++ set cached_atags($origid) $tags
++ } else {
++ set tags $ctags
++ }
++ } else {
++ set cached_atags($origid) $tags
++ }
++ set t3 [clock clicks -milliseconds]
++ if {0 && $t3 - $t1 >= 100} {
++ puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
++ [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
++ }
++ return $tags
++}
++
++# Return the list of IDs that have heads that are descendents of id,
++# including id itself if it has a head.
++proc descheads {id} {
++ global arcnos arcstart arcids archeads idheads cached_dheads
++ global allparents
++
++ if {![info exists allparents($id)]} {
++ return {}
++ }
++ set aret {}
++ if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
++ # part-way along an arc; check it first
++ set a [lindex $arcnos($id) 0]
++ if {$archeads($a) ne {}} {
++ validate_archeads $a
++ set i [lsearch -exact $arcids($a) $id]
++ foreach t $archeads($a) {
++ set j [lsearch -exact $arcids($a) $t]
++ if {$j > $i} break
++ lappend aret $t
++ }
++ }
++ set id $arcstart($a)
++ }
++ set origid $id
++ set todo [list $id]
++ set seen($id) 1
++ set ret {}
++ for {set i 0} {$i < [llength $todo]} {incr i} {
++ set id [lindex $todo $i]
++ if {[info exists cached_dheads($id)]} {
++ set ret [concat $ret $cached_dheads($id)]
++ } else {
++ if {[info exists idheads($id)]} {
++ lappend ret $id
++ }
++ foreach a $arcnos($id) {
++ if {$archeads($a) ne {}} {
++ validate_archeads $a
++ if {$archeads($a) ne {}} {
++ set ret [concat $ret $archeads($a)]
++ }
++ }
++ set d $arcstart($a)
++ if {![info exists seen($d)]} {
++ lappend todo $d
++ set seen($d) 1
++ }
++ }
++ }
++ }
++ set ret [lsort -unique $ret]
++ set cached_dheads($origid) $ret
++ return [concat $ret $aret]
++}
++
++proc addedtag {id} {
++ global arcnos arcout cached_dtags cached_atags
++
++ if {![info exists arcnos($id)]} return
++ if {![info exists arcout($id)]} {
++ recalcarc [lindex $arcnos($id) 0]
++ }
++ catch {unset cached_dtags}
++ catch {unset cached_atags}
++}
++
++proc addedhead {hid head} {
++ global arcnos arcout cached_dheads
++
++ if {![info exists arcnos($hid)]} return
++ if {![info exists arcout($hid)]} {
++ recalcarc [lindex $arcnos($hid) 0]
++ }
++ catch {unset cached_dheads}
++}
++
++proc removedhead {hid head} {
++ global cached_dheads
++
++ catch {unset cached_dheads}
++}
++
++proc movedhead {hid head} {
++ global arcnos arcout cached_dheads
++
++ if {![info exists arcnos($hid)]} return
++ if {![info exists arcout($hid)]} {
++ recalcarc [lindex $arcnos($hid) 0]
++ }
++ catch {unset cached_dheads}
++}
++
++proc changedrefs {} {
++ global cached_dheads cached_dtags cached_atags
++ global arctags archeads arcnos arcout idheads idtags
++
++ foreach id [concat [array names idheads] [array names idtags]] {
++ if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
++ set a [lindex $arcnos($id) 0]
++ if {![info exists donearc($a)]} {
++ recalcarc $a
++ set donearc($a) 1
++ }
++ }
++ }
++ catch {unset cached_dtags}
++ catch {unset cached_atags}
++ catch {unset cached_dheads}
++}
++
++proc rereadrefs {} {
++ global idtags idheads idotherrefs mainheadid
++
++ set refids [concat [array names idtags] \
++ [array names idheads] [array names idotherrefs]]
++ foreach id $refids {
++ if {![info exists ref($id)]} {
++ set ref($id) [listrefs $id]
++ }
++ }
++ set oldmainhead $mainheadid
++ readrefs
++ changedrefs
++ set refids [lsort -unique [concat $refids [array names idtags] \
++ [array names idheads] [array names idotherrefs]]]
++ foreach id $refids {
++ set v [listrefs $id]
++ if {![info exists ref($id)] || $ref($id) != $v} {
++ redrawtags $id
++ }
++ }
++ if {$oldmainhead ne $mainheadid} {
++ redrawtags $oldmainhead
++ redrawtags $mainheadid
++ }
++ run refill_reflist
++}
++
++proc listrefs {id} {
++ global idtags idheads idotherrefs
++
++ set x {}
++ if {[info exists idtags($id)]} {
++ set x $idtags($id)
++ }
++ set y {}
++ if {[info exists idheads($id)]} {
++ set y $idheads($id)
++ }
++ set z {}
++ if {[info exists idotherrefs($id)]} {
++ set z $idotherrefs($id)
++ }
++ return [list $x $y $z]
++}
++
++proc showtag {tag isnew} {
++ global ctext tagcontents tagids linknum tagobjid
++
++ if {$isnew} {
++ addtohistory [list showtag $tag 0]
++ }
++ $ctext conf -state normal
++ clear_ctext
++ settabs 0
++ set linknum 0
++ if {![info exists tagcontents($tag)]} {
++ catch {
++ set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
++ }
++ }
++ if {[info exists tagcontents($tag)]} {
++ set text $tagcontents($tag)
++ } else {
++ set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
++ }
++ appendwithlinks $text {}
++ $ctext conf -state disabled
++ init_flist {}
++}
++
++proc doquit {} {
++ global stopped
++ global gitktmpdir
++
++ set stopped 100
++ savestuff .
++ destroy .
++
++ if {[info exists gitktmpdir]} {
++ catch {file delete -force $gitktmpdir}
++ }
++}
++
++proc mkfontdisp {font top which} {
++ global fontattr fontpref $font
++
++ set fontpref($font) [set $font]
++ button $top.${font}but -text $which -font optionfont \
++ -command [list choosefont $font $which]
++ label $top.$font -relief flat -font $font \
++ -text $fontattr($font,family) -justify left
++ grid x $top.${font}but $top.$font -sticky w
++}
++
++proc choosefont {font which} {
++ global fontparam fontlist fonttop fontattr
++
++ set fontparam(which) $which
++ set fontparam(font) $font
++ set fontparam(family) [font actual $font -family]
++ set fontparam(size) $fontattr($font,size)
++ set fontparam(weight) $fontattr($font,weight)
++ set fontparam(slant) $fontattr($font,slant)
++ set top .gitkfont
++ set fonttop $top
++ if {![winfo exists $top]} {
++ font create sample
++ eval font config sample [font actual $font]
++ toplevel $top
++ wm title $top [mc "Gitk font chooser"]
++ label $top.l -textvariable fontparam(which)
++ pack $top.l -side top
++ set fontlist [lsort [font families]]
++ frame $top.f
++ listbox $top.f.fam -listvariable fontlist \
++ -yscrollcommand [list $top.f.sb set]
++ bind $top.f.fam <<ListboxSelect>> selfontfam
++ scrollbar $top.f.sb -command [list $top.f.fam yview]
++ pack $top.f.sb -side right -fill y
++ pack $top.f.fam -side left -fill both -expand 1
++ pack $top.f -side top -fill both -expand 1
++ frame $top.g
++ spinbox $top.g.size -from 4 -to 40 -width 4 \
++ -textvariable fontparam(size) \
++ -validatecommand {string is integer -strict %s}
++ checkbutton $top.g.bold -padx 5 \
++ -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
++ -variable fontparam(weight) -onvalue bold -offvalue normal
++ checkbutton $top.g.ital -padx 5 \
++ -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
++ -variable fontparam(slant) -onvalue italic -offvalue roman
++ pack $top.g.size $top.g.bold $top.g.ital -side left
++ pack $top.g -side top
++ canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
++ -background white
++ $top.c create text 100 25 -anchor center -text $which -font sample \
++ -fill black -tags text
++ bind $top.c <Configure> [list centertext $top.c]
++ pack $top.c -side top -fill x
++ frame $top.buts
++ button $top.buts.ok -text [mc "OK"] -command fontok -default active
++ button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
++ grid $top.buts.ok $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ pack $top.buts -side bottom -fill x
++ trace add variable fontparam write chg_fontparam
++ } else {
++ raise $top
++ $top.c itemconf text -text $which
++ }
++ set i [lsearch -exact $fontlist $fontparam(family)]
++ if {$i >= 0} {
++ $top.f.fam selection set $i
++ $top.f.fam see $i
++ }
++}
++
++proc centertext {w} {
++ $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
++}
++
++proc fontok {} {
++ global fontparam fontpref prefstop
++
++ set f $fontparam(font)
++ set fontpref($f) [list $fontparam(family) $fontparam(size)]
++ if {$fontparam(weight) eq "bold"} {
++ lappend fontpref($f) "bold"
++ }
++ if {$fontparam(slant) eq "italic"} {
++ lappend fontpref($f) "italic"
++ }
++ set w $prefstop.$f
++ $w conf -text $fontparam(family) -font $fontpref($f)
++
++ fontcan
++}
++
++proc fontcan {} {
++ global fonttop fontparam
++
++ if {[info exists fonttop]} {
++ catch {destroy $fonttop}
++ catch {font delete sample}
++ unset fonttop
++ unset fontparam
++ }
++}
++
++proc selfontfam {} {
++ global fonttop fontparam
++
++ set i [$fonttop.f.fam curselection]
++ if {$i ne {}} {
++ set fontparam(family) [$fonttop.f.fam get $i]
++ }
++}
++
++proc chg_fontparam {v sub op} {
++ global fontparam
++
++ font config sample -$sub $fontparam($sub)
++}
++
++proc doprefs {} {
++ global maxwidth maxgraphpct
++ global oldprefs prefstop showneartags showlocalchanges
++ global bgcolor fgcolor ctext diffcolors selectbgcolor
++ global tabstop limitdiffs autoselect extdifftool
++
++ set top .gitkprefs
++ set prefstop $top
++ if {[winfo exists $top]} {
++ raise $top
++ return
++ }
++ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
++ limitdiffs tabstop} {
++ set oldprefs($v) [set $v]
++ }
++ toplevel $top
++ wm title $top [mc "Gitk preferences"]
++ label $top.ldisp -text [mc "Commit list display options"]
++ grid $top.ldisp - -sticky w -pady 10
++ label $top.spacer -text " "
++ label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
++ -font optionfont
++ spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
++ grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
++ label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
++ -font optionfont
++ spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
++ grid x $top.maxpctl $top.maxpct -sticky w
++ frame $top.showlocal
++ label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
++ checkbutton $top.showlocal.b -variable showlocalchanges
++ pack $top.showlocal.b $top.showlocal.l -side left
++ grid x $top.showlocal -sticky w
++ frame $top.autoselect
++ label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
++ checkbutton $top.autoselect.b -variable autoselect
++ pack $top.autoselect.b $top.autoselect.l -side left
++ grid x $top.autoselect -sticky w
++
++ label $top.ddisp -text [mc "Diff display options"]
++ grid $top.ddisp - -sticky w -pady 10
++ label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
++ spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
++ grid x $top.tabstopl $top.tabstop -sticky w
++ frame $top.ntag
++ label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
++ checkbutton $top.ntag.b -variable showneartags
++ pack $top.ntag.b $top.ntag.l -side left
++ grid x $top.ntag -sticky w
++ frame $top.ldiff
++ label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
++ checkbutton $top.ldiff.b -variable limitdiffs
++ pack $top.ldiff.b $top.ldiff.l -side left
++ grid x $top.ldiff -sticky w
++
++ entry $top.extdifft -textvariable extdifftool
++ frame $top.extdifff
++ label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
++ -padx 10
++ button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
++ -command choose_extdiff
++ pack $top.extdifff.l $top.extdifff.b -side left
++ grid x $top.extdifff $top.extdifft -sticky w
++
++ label $top.cdisp -text [mc "Colors: press to choose"]
++ grid $top.cdisp - -sticky w -pady 10
++ label $top.bg -padx 40 -relief sunk -background $bgcolor
++ button $top.bgbut -text [mc "Background"] -font optionfont \
++ -command [list choosecolor bgcolor {} $top.bg background setbg]
++ grid x $top.bgbut $top.bg -sticky w
++ label $top.fg -padx 40 -relief sunk -background $fgcolor
++ button $top.fgbut -text [mc "Foreground"] -font optionfont \
++ -command [list choosecolor fgcolor {} $top.fg foreground setfg]
++ grid x $top.fgbut $top.fg -sticky w
++ label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
++ button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
++ -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
++ [list $ctext tag conf d0 -foreground]]
++ grid x $top.diffoldbut $top.diffold -sticky w
++ label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
++ button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
++ -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
++ [list $ctext tag conf d1 -foreground]]
++ grid x $top.diffnewbut $top.diffnew -sticky w
++ label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
++ button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
++ -command [list choosecolor diffcolors 2 $top.hunksep \
++ "diff hunk header" \
++ [list $ctext tag conf hunksep -foreground]]
++ grid x $top.hunksepbut $top.hunksep -sticky w
++ label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
++ button $top.selbgbut -text [mc "Select bg"] -font optionfont \
++ -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
++ grid x $top.selbgbut $top.selbgsep -sticky w
++
++ label $top.cfont -text [mc "Fonts: press to choose"]
++ grid $top.cfont - -sticky w -pady 10
++ mkfontdisp mainfont $top [mc "Main font"]
++ mkfontdisp textfont $top [mc "Diff display font"]
++ mkfontdisp uifont $top [mc "User interface font"]
++
++ frame $top.buts
++ button $top.buts.ok -text [mc "OK"] -command prefsok -default active
++ button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
++ grid $top.buts.ok $top.buts.can
++ grid columnconfigure $top.buts 0 -weight 1 -uniform a
++ grid columnconfigure $top.buts 1 -weight 1 -uniform a
++ grid $top.buts - - -pady 10 -sticky ew
++ bind $top <Visibility> "focus $top.buts.ok"
++}
++
++proc choose_extdiff {} {
++ global extdifftool
++
++ set prog [tk_getOpenFile -title "External diff tool" -multiple false]
++ if {$prog ne {}} {
++ set extdifftool $prog
++ }
++}
++
++proc choosecolor {v vi w x cmd} {
++ global $v
++
++ set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
++ -title [mc "Gitk: choose color for %s" $x]]
++ if {$c eq {}} return
++ $w conf -background $c
++ lset $v $vi $c
++ eval $cmd $c
++}
++
++proc setselbg {c} {
++ global bglist cflist
++ foreach w $bglist {
++ $w configure -selectbackground $c
++ }
++ $cflist tag configure highlight \
++ -background [$cflist cget -selectbackground]
++ allcanvs itemconf secsel -fill $c
++}
++
++proc setbg {c} {
++ global bglist
++
++ foreach w $bglist {
++ $w conf -background $c
++ }
++}
++
++proc setfg {c} {
++ global fglist canv
++
++ foreach w $fglist {
++ $w conf -foreground $c
++ }
++ allcanvs itemconf text -fill $c
++ $canv itemconf circle -outline $c
++}
++
++proc prefscan {} {
++ global oldprefs prefstop
++
++ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
++ limitdiffs tabstop} {
++ global $v
++ set $v $oldprefs($v)
++ }
++ catch {destroy $prefstop}
++ unset prefstop
++ fontcan
++}
++
++proc prefsok {} {
++ global maxwidth maxgraphpct
++ global oldprefs prefstop showneartags showlocalchanges
++ global fontpref mainfont textfont uifont
++ global limitdiffs treediffs
++
++ catch {destroy $prefstop}
++ unset prefstop
++ fontcan
++ set fontchanged 0
++ if {$mainfont ne $fontpref(mainfont)} {
++ set mainfont $fontpref(mainfont)
++ parsefont mainfont $mainfont
++ eval font configure mainfont [fontflags mainfont]
++ eval font configure mainfontbold [fontflags mainfont 1]
++ setcoords
++ set fontchanged 1
++ }
++ if {$textfont ne $fontpref(textfont)} {
++ set textfont $fontpref(textfont)
++ parsefont textfont $textfont
++ eval font configure textfont [fontflags textfont]
++ eval font configure textfontbold [fontflags textfont 1]
++ }
++ if {$uifont ne $fontpref(uifont)} {
++ set uifont $fontpref(uifont)
++ parsefont uifont $uifont
++ eval font configure uifont [fontflags uifont]
++ }
++ settabs
++ if {$showlocalchanges != $oldprefs(showlocalchanges)} {
++ if {$showlocalchanges} {
++ doshowlocalchanges
++ } else {
++ dohidelocalchanges
++ }
++ }
++ if {$limitdiffs != $oldprefs(limitdiffs)} {
++ # treediffs elements are limited by path
++ catch {unset treediffs}
++ }
++ if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
++ || $maxgraphpct != $oldprefs(maxgraphpct)} {
++ redisplay
++ } elseif {$showneartags != $oldprefs(showneartags) ||
++ $limitdiffs != $oldprefs(limitdiffs)} {
++ reselectline
++ }
++}
++
++proc formatdate {d} {
++ global datetimeformat
++ if {$d ne {}} {
++ set d [clock format $d -format $datetimeformat]
++ }
++ return $d
++}
++
++# This list of encoding names and aliases is distilled from
++# http://www.iana.org/assignments/character-sets.
++# Not all of them are supported by Tcl.
++set encoding_aliases {
++ { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
++ ISO646-US US-ASCII us IBM367 cp367 csASCII }
++ { ISO-10646-UTF-1 csISO10646UTF1 }
++ { ISO_646.basic:1983 ref csISO646basic1983 }
++ { INVARIANT csINVARIANT }
++ { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
++ { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
++ { NATS-SEFI iso-ir-8-1 csNATSSEFI }
++ { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
++ { NATS-DANO iso-ir-9-1 csNATSDANO }
++ { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
++ { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
++ { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
++ { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
++ { ISO-2022-KR csISO2022KR }
++ { EUC-KR csEUCKR }
++ { ISO-2022-JP csISO2022JP }
++ { ISO-2022-JP-2 csISO2022JP2 }
++ { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
++ csISO13JISC6220jp }
++ { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
++ { IT iso-ir-15 ISO646-IT csISO15Italian }
++ { PT iso-ir-16 ISO646-PT csISO16Portuguese }
++ { ES iso-ir-17 ISO646-ES csISO17Spanish }
++ { greek7-old iso-ir-18 csISO18Greek7Old }
++ { latin-greek iso-ir-19 csISO19LatinGreek }
++ { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
++ { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
++ { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
++ { ISO_5427 iso-ir-37 csISO5427Cyrillic }
++ { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
++ { BS_viewdata iso-ir-47 csISO47BSViewdata }
++ { INIS iso-ir-49 csISO49INIS }
++ { INIS-8 iso-ir-50 csISO50INIS8 }
++ { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
++ { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
++ { ISO_5428:1980 iso-ir-55 csISO5428Greek }
++ { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
++ { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
++ { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
++ csISO60Norwegian1 }
++ { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
++ { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
++ { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
++ { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
++ { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
++ { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
++ { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
++ { greek7 iso-ir-88 csISO88Greek7 }
++ { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
++ { iso-ir-90 csISO90 }
++ { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
++ { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
++ csISO92JISC62991984b }
++ { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
++ { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
++ { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
++ csISO95JIS62291984handadd }
++ { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
++ { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
++ { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
++ { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
++ CP819 csISOLatin1 }
++ { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
++ { T.61-7bit iso-ir-102 csISO102T617bit }
++ { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
++ { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
++ { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
++ { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
++ { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
++ { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
++ { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
++ { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
++ arabic csISOLatinArabic }
++ { ISO_8859-6-E csISO88596E ISO-8859-6-E }
++ { ISO_8859-6-I csISO88596I ISO-8859-6-I }
++ { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
++ greek greek8 csISOLatinGreek }
++ { T.101-G2 iso-ir-128 csISO128T101G2 }
++ { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
++ csISOLatinHebrew }
++ { ISO_8859-8-E csISO88598E ISO-8859-8-E }
++ { ISO_8859-8-I csISO88598I ISO-8859-8-I }
++ { CSN_369103 iso-ir-139 csISO139CSN369103 }
++ { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
++ { ISO_6937-2-add iso-ir-142 csISOTextComm }
++ { IEC_P27-1 iso-ir-143 csISO143IECP271 }
++ { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
++ csISOLatinCyrillic }
++ { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
++ { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
++ { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
++ { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
++ { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
++ { ISO_6937-2-25 iso-ir-152 csISO6937Add }
++ { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
++ { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
++ { ISO_10367-box iso-ir-155 csISO10367Box }
++ { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
++ { latin-lap lap iso-ir-158 csISO158Lap }
++ { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
++ { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
++ { us-dk csUSDK }
++ { dk-us csDKUS }
++ { JIS_X0201 X0201 csHalfWidthKatakana }
++ { KSC5636 ISO646-KR csKSC5636 }
++ { ISO-10646-UCS-2 csUnicode }
++ { ISO-10646-UCS-4 csUCS4 }
++ { DEC-MCS dec csDECMCS }
++ { hp-roman8 roman8 r8 csHPRoman8 }
++ { macintosh mac csMacintosh }
++ { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
++ csIBM037 }
++ { IBM038 EBCDIC-INT cp038 csIBM038 }
++ { IBM273 CP273 csIBM273 }
++ { IBM274 EBCDIC-BE CP274 csIBM274 }
++ { IBM275 EBCDIC-BR cp275 csIBM275 }
++ { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
++ { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
++ { IBM280 CP280 ebcdic-cp-it csIBM280 }
++ { IBM281 EBCDIC-JP-E cp281 csIBM281 }
++ { IBM284 CP284 ebcdic-cp-es csIBM284 }
++ { IBM285 CP285 ebcdic-cp-gb csIBM285 }
++ { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
++ { IBM297 cp297 ebcdic-cp-fr csIBM297 }
++ { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
++ { IBM423 cp423 ebcdic-cp-gr csIBM423 }
++ { IBM424 cp424 ebcdic-cp-he csIBM424 }
++ { IBM437 cp437 437 csPC8CodePage437 }
++ { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
++ { IBM775 cp775 csPC775Baltic }
++ { IBM850 cp850 850 csPC850Multilingual }
++ { IBM851 cp851 851 csIBM851 }
++ { IBM852 cp852 852 csPCp852 }
++ { IBM855 cp855 855 csIBM855 }
++ { IBM857 cp857 857 csIBM857 }
++ { IBM860 cp860 860 csIBM860 }
++ { IBM861 cp861 861 cp-is csIBM861 }
++ { IBM862 cp862 862 csPC862LatinHebrew }
++ { IBM863 cp863 863 csIBM863 }
++ { IBM864 cp864 csIBM864 }
++ { IBM865 cp865 865 csIBM865 }
++ { IBM866 cp866 866 csIBM866 }
++ { IBM868 CP868 cp-ar csIBM868 }
++ { IBM869 cp869 869 cp-gr csIBM869 }
++ { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
++ { IBM871 CP871 ebcdic-cp-is csIBM871 }
++ { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
++ { IBM891 cp891 csIBM891 }
++ { IBM903 cp903 csIBM903 }
++ { IBM904 cp904 904 csIBBM904 }
++ { IBM905 CP905 ebcdic-cp-tr csIBM905 }
++ { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
++ { IBM1026 CP1026 csIBM1026 }
++ { EBCDIC-AT-DE csIBMEBCDICATDE }
++ { EBCDIC-AT-DE-A csEBCDICATDEA }
++ { EBCDIC-CA-FR csEBCDICCAFR }
++ { EBCDIC-DK-NO csEBCDICDKNO }
++ { EBCDIC-DK-NO-A csEBCDICDKNOA }
++ { EBCDIC-FI-SE csEBCDICFISE }
++ { EBCDIC-FI-SE-A csEBCDICFISEA }
++ { EBCDIC-FR csEBCDICFR }
++ { EBCDIC-IT csEBCDICIT }
++ { EBCDIC-PT csEBCDICPT }
++ { EBCDIC-ES csEBCDICES }
++ { EBCDIC-ES-A csEBCDICESA }
++ { EBCDIC-ES-S csEBCDICESS }
++ { EBCDIC-UK csEBCDICUK }
++ { EBCDIC-US csEBCDICUS }
++ { UNKNOWN-8BIT csUnknown8BiT }
++ { MNEMONIC csMnemonic }
++ { MNEM csMnem }
++ { VISCII csVISCII }
++ { VIQR csVIQR }
++ { KOI8-R csKOI8R }
++ { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
++ { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
++ { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
++ { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
++ { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
++ { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
++ { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
++ { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
++ { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
++ { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
++ { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
++ { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
++ { IBM1047 IBM-1047 }
++ { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
++ { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
++ { UNICODE-1-1 csUnicode11 }
++ { CESU-8 csCESU-8 }
++ { BOCU-1 csBOCU-1 }
++ { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
++ { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
++ l8 }
++ { ISO-8859-15 ISO_8859-15 Latin-9 }
++ { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
++ { GBK CP936 MS936 windows-936 }
++ { JIS_Encoding csJISEncoding }
++ { Shift_JIS MS_Kanji csShiftJIS }
++ { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
++ EUC-JP }
++ { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
++ { ISO-10646-UCS-Basic csUnicodeASCII }
++ { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
++ { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
++ { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
++ { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
++ { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
++ { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
++ { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
++ { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
++ { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
++ { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
++ { Adobe-Standard-Encoding csAdobeStandardEncoding }
++ { Ventura-US csVenturaUS }
++ { Ventura-International csVenturaInternational }
++ { PC8-Danish-Norwegian csPC8DanishNorwegian }
++ { PC8-Turkish csPC8Turkish }
++ { IBM-Symbols csIBMSymbols }
++ { IBM-Thai csIBMThai }
++ { HP-Legal csHPLegal }
++ { HP-Pi-font csHPPiFont }
++ { HP-Math8 csHPMath8 }
++ { Adobe-Symbol-Encoding csHPPSMath }
++ { HP-DeskTop csHPDesktop }
++ { Ventura-Math csVenturaMath }
++ { Microsoft-Publishing csMicrosoftPublishing }
++ { Windows-31J csWindows31J }
++ { GB2312 csGB2312 }
++ { Big5 csBig5 }
++}
++
++proc tcl_encoding {enc} {
++ global encoding_aliases
++ set names [encoding names]
++ set lcnames [string tolower $names]
++ set enc [string tolower $enc]
++ set i [lsearch -exact $lcnames $enc]
++ if {$i < 0} {
++ # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
++ if {[regsub {^iso[-_]} $enc iso encx]} {
++ set i [lsearch -exact $lcnames $encx]
++ }
++ }
++ if {$i < 0} {
++ foreach l $encoding_aliases {
++ set ll [string tolower $l]
++ if {[lsearch -exact $ll $enc] < 0} continue
++ # look through the aliases for one that tcl knows about
++ foreach e $ll {
++ set i [lsearch -exact $lcnames $e]
++ if {$i < 0} {
++ if {[regsub {^iso[-_]} $e iso ex]} {
++ set i [lsearch -exact $lcnames $ex]
++ }
++ }
++ if {$i >= 0} break
++ }
++ break
++ }
++ }
++ if {$i >= 0} {
++ return [lindex $names $i]
++ }
++ return {}
++}
++
++# First check that Tcl/Tk is recent enough
++if {[catch {package require Tk 8.4} err]} {
++ show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
++ Gitk requires at least Tcl/Tk 8.4."]
++ exit 1
++}
++
++# defaults...
++set wrcomcmd "git diff-tree --stdin -p --pretty"
++
++set gitencoding {}
++catch {
++ set gitencoding [exec git config --get i18n.commitencoding]
++}
++if {$gitencoding == ""} {
++ set gitencoding "utf-8"
++}
++set tclencoding [tcl_encoding $gitencoding]
++if {$tclencoding == {}} {
++ puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
++}
++
++set mainfont {Helvetica 9}
++set textfont {Courier 9}
++set uifont {Helvetica 9 bold}
++set tabstop 8
++set findmergefiles 0
++set maxgraphpct 50
++set maxwidth 16
++set revlistorder 0
++set fastdate 0
++set uparrowlen 5
++set downarrowlen 5
++set mingaplen 100
++set cmitmode "patch"
++set wrapcomment "none"
++set showneartags 1
++set maxrefs 20
++set maxlinelen 200
++set showlocalchanges 1
++set limitdiffs 1
++set datetimeformat "%Y-%m-%d %H:%M:%S"
++set autoselect 1
++
++set extdifftool "meld"
++
++set colors {green red blue magenta darkgrey brown orange}
++set bgcolor white
++set fgcolor black
++set diffcolors {red "#00a000" blue}
++set diffcontext 3
++set ignorespace 0
++set selectbgcolor gray85
++
++set circlecolors {white blue gray blue blue}
++
++## For msgcat loading, first locate the installation location.
++if { [info exists ::env(GITK_MSGSDIR)] } {
++ ## Msgsdir was manually set in the environment.
++ set gitk_msgsdir $::env(GITK_MSGSDIR)
++} else {
++ ## Let's guess the prefix from argv0.
++ set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
++ set gitk_libdir [file join $gitk_prefix share gitk lib]
++ set gitk_msgsdir [file join $gitk_libdir msgs]
++ unset gitk_prefix
++}
++
++## Internationalization (i18n) through msgcat and gettext. See
++## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
++package require msgcat
++namespace import ::msgcat::mc
++## And eventually load the actual message catalog
++::msgcat::mcload $gitk_msgsdir
++
++catch {source ~/.gitk}
++
++font create optionfont -family sans-serif -size -12
++
++parsefont mainfont $mainfont
++eval font create mainfont [fontflags mainfont]
++eval font create mainfontbold [fontflags mainfont 1]
++
++parsefont textfont $textfont
++eval font create textfont [fontflags textfont]
++eval font create textfontbold [fontflags textfont 1]
++
++parsefont uifont $uifont
++eval font create uifont [fontflags uifont]
++
++setoptions
++
++# check that we can find a .git directory somewhere...
++if {[catch {set gitdir [gitdir]}]} {
++ show_error {} . [mc "Cannot find a git repository here."]
++ exit 1
++}
++if {![file isdirectory $gitdir]} {
++ show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
++ exit 1
++}
++
+++set selecthead {}
+++set selectheadid {}
+++
++set revtreeargs {}
++set cmdline_files {}
++set i 0
++set revtreeargscmd {}
++foreach arg $argv {
++ switch -glob -- $arg {
++ "" { }
++ "--" {
++ set cmdline_files [lrange $argv [expr {$i + 1}] end]
++ break
++ }
+++ "--select-commit=*" {
+++ set selecthead [string range $arg 16 end]
+++ }
++ "--argscmd=*" {
++ set revtreeargscmd [string range $arg 10 end]
++ }
++ default {
++ lappend revtreeargs $arg
++ }
++ }
++ incr i
++}
++
+++if {$selecthead eq "HEAD"} {
+++ set selecthead {}
+++}
+++
++if {$i >= [llength $argv] && $revtreeargs ne {}} {
++ # no -- on command line, but some arguments (other than --argscmd)
++ if {[catch {
++ set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
++ set cmdline_files [split $f "\n"]
++ set n [llength $cmdline_files]
++ set revtreeargs [lrange $revtreeargs 0 end-$n]
++ # Unfortunately git rev-parse doesn't produce an error when
++ # something is both a revision and a filename. To be consistent
++ # with git log and git rev-list, check revtreeargs for filenames.
++ foreach arg $revtreeargs {
++ if {[file exists $arg]} {
++ show_error {} . [mc "Ambiguous argument '%s': both revision\
++ and filename" $arg]
++ exit 1
++ }
++ }
++ } err]} {
++ # unfortunately we get both stdout and stderr in $err,
++ # so look for "fatal:".
++ set i [string first "fatal:" $err]
++ if {$i > 0} {
++ set err [string range $err [expr {$i + 6}] end]
++ }
++ show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
++ exit 1
++ }
++}
++
++set nullid "0000000000000000000000000000000000000000"
++set nullid2 "0000000000000000000000000000000000000001"
++set nullfile "/dev/null"
++
++set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
++
++set runq {}
++set history {}
++set historyindex 0
++set fh_serial 0
++set nhl_names {}
++set highlight_paths {}
++set findpattern {}
++set searchdirn -forwards
++set boldrows {}
++set boldnamerows {}
++set diffelide {0 0}
++set markingmatches 0
++set linkentercount 0
++set need_redisplay 0
++set nrows_drawn 0
++set firsttabstop 0
++
++set nextviewnum 1
++set curview 0
++set selectedview 0
++set selectedhlview [mc "None"]
++set highlight_related [mc "None"]
++set highlight_files {}
++set viewfiles(0) {}
++set viewperm(0) 0
++set viewargs(0) {}
++set viewargscmd(0) {}
++
++set selectedline {}
++set numcommits 0
++set loginstance 0
++set cmdlineok 0
++set stopped 0
++set stuffsaved 0
++set patchnum 0
++set lserial 0
++set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
++setcoords
++makewindow
++# wait for the window to become visible
++tkwait visibility .
++wm title . "[file tail $argv0]: [file tail [pwd]]"
++readrefs
++
++if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
++ # create a view for the files/dirs specified on the command line
++ set curview 1
++ set selectedview 1
++ set nextviewnum 2
++ set viewname(1) [mc "Command line"]
++ set viewfiles(1) $cmdline_files
++ set viewargs(1) $revtreeargs
++ set viewargscmd(1) $revtreeargscmd
++ set viewperm(1) 0
++ set vdatemode(1) 0
++ addviewmenu 1
++ .bar.view entryconf [mc "Edit view..."] -state normal
++ .bar.view entryconf [mc "Delete view"] -state normal
++}
++
++if {[info exists permviews]} {
++ foreach v $permviews {
++ set n $nextviewnum
++ incr nextviewnum
++ set viewname($n) [lindex $v 0]
++ set viewfiles($n) [lindex $v 1]
++ set viewargs($n) [lindex $v 2]
++ set viewargscmd($n) [lindex $v 3]
++ set viewperm($n) 1
++ addviewmenu $n
++ }
++}
++getcommits {}