set appvers {@@GITGUI_VERSION@@}

set copyright [string map [list (c) \u00a9] {

Copyright (c) 2006-2010 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, see <https://www.gnu.org/licenses/>.}]

if {[catch {package require Tcl 8.6-} err]} {

catch {wm withdraw .}

tk_messageBox \

-icon error \

-type ok \

-title "git-gui: fatal error" \

-message $err

exit 1

}

catch {rename send {}} ; # What an evil concept...

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

}

set _iscygwin {}

proc is_Cygwin {} {

global _iscygwin

if {$_iscygwin eq {}} {

if {[string match "CYGWIN_*" $::tcl_platform(os)]} {

set _iscygwin 1

} else {

set _iscygwin 0

}

}

return $_iscygwin

}

if {[package vcompare $::tcl_version 9.0] >= 0} {

rename open _strict_open

proc open args {

set f [_strict_open {*}$args]

chan configure $f -profile tcl8

return $f

}

proc convertfrom args {

return [encoding convertfrom -profile tcl8 {*}$args]

}

} else {

proc convertfrom args {

return [encoding convertfrom {*}$args]

}

}

if {[is_Windows]} {

set _path_sep {;}

} else {

set _path_sep {:}

}

set _path_seen [dict create]

foreach p [split $env(PATH) $_path_sep] {

# Keep only absolute paths, getting rid of ., empty, etc.

if {[file pathtype $p] ne {absolute}} {

continue

}

# Keep only the first occurence of any duplicates.

set norm_p [file normalize $p]

dict set _path_seen $norm_p 1

}

set _search_path [dict keys $_path_seen]

unset _path_seen

set env(PATH) [join $_search_path $_path_sep]

if {[is_Windows]} {

proc _which {what args} {

global _search_path

if {[lsearch -exact $args -script] >= 0} {

set suffix {}

} elseif {[string match *.exe [string tolower $what]]} {

# The search string already has the file extension

set suffix {}

} else {

set suffix .exe

}

foreach p $_search_path {

set p [file join $p $what$suffix]

if {[file exists $p]} {

return [file normalize $p]

}

}

return {}

}

proc sanitize_command_line {command_line from_index} {

set i $from_index

while {$i < [llength $command_line]} {

set cmd [lindex $command_line $i]

if {[llength [file split $cmd]] < 2} {

set fullpath [_which $cmd]

if {$fullpath eq ""} {

throw {NOT-FOUND} "$cmd not found in PATH"

}

lset command_line $i $fullpath

}

# handle piped commands, e.g. `exec A | B`

for {incr i} {$i < [llength $command_line]} {incr i} {

if {[lindex $command_line $i] eq "|"} {

incr i

break

}

}

}

return $command_line

}

# Override `exec` to avoid unsafe PATH lookup

rename exec real_exec

proc exec {args} {

# skip options

for {set i 0} {$i < [llength $args]} {incr i} {

set arg [lindex $args $i]

if {$arg eq "--"} {

incr i

break

}

if {[string range $arg 0 0] ne "-"} {

break

}

}

set args [sanitize_command_line $args $i]

uplevel 1 real_exec $args

}

# Override `open` to avoid unsafe PATH lookup

rename open real_open

proc open {args} {

set arg0 [lindex $args 0]

if {[string range $arg0 0 0] eq "|"} {

set command_line [string trim [string range $arg0 1 end]]

lset args 0 "| [sanitize_command_line $command_line 0]"

}

set fd [real_open {*}$args]

fconfigure $fd -eofchar {}

return $fd

}

} else {

# On non-Windows platforms, auto_execok, exec, and open are safe, and will

# use the sanitized search path. But, we need _which for these.

proc _which {what args} {

return [lindex [auto_execok $what] 0]

}

}

proc is_arg_unsafe {arg} {

regexp {^([<|>&]|2>)} $arg

}

proc make_arg_safe {arg} {

if {[is_arg_unsafe $arg]} {

set arg [file join . $arg]

}

return $arg

}

proc make_arglist_safe {arglist} {

set res {}

foreach arg $arglist {

lappend res [make_arg_safe $arg]

}

return $res

}

proc safe_exec {cmd} {

eval exec [make_arglist_safe $cmd]

}

proc safe_exec_bg {cmd} {

eval exec [make_arglist_safe $cmd] &

}

proc safe_open_file {filename flags} {

# a file name starting with "|" would attempt to run a process

# but such a file name must be treated as a relative path

# hide the "|" behind "./"

if {[string index $filename 0] eq "|"} {

set filename [file join . $filename]

}

open $filename $flags

}

if { [info exists ::env(GIT_GUI_LIB_DIR) ] } {

set oguilib $::env(GIT_GUI_LIB_DIR)

} else {

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

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 {args} {

puts stderr "source $args"

uplevel 1 [linsert $args 0 real__source]

}

if {[tk windowingsystem] eq "win32"} { console show }

}

package require msgcat

if {[tk windowingsystem] eq "win32"

&& [package vcompare [package provide msgcat] 1.4.4] < 0

} then {

proc _mc_update_locale {} {

set key {HKEY_CURRENT_USER\Control Panel\Desktop}

if {![catch {

package require registry

set uilocale [registry get $key "PreferredUILanguages"]

msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]

} uilocale]} {

if {[string length $uilocale] > 0} {

msgcat::mclocale $uilocale

}

}

}

_mc_update_locale

}

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

if {[tk windowingsystem] eq "aqua"} {

catch {

safe_exec [list osascript -e [format {

tell application "System Events"

set frontmost of processes whose unix id is %d to true

end tell

} [pid]]]

}

}

set _appname {Git Gui}

set _gitdir {}

set _gitworktree {}

set _githtmldir {}

set _prefix {}

set _reponame {}

set _shellpath {@@SHELL_PATH@@}

set _trace [lsearch -exact $argv --trace]

if {$_trace >= 0} {

set argv [lreplace $argv $_trace $_trace]

set _trace 1

if {[tk windowingsystem] eq "win32"} { console show }

} else {

set _trace 0

}

set _last_merged_branch {}

if {[string match @@* $_shellpath]} {

if {[info exists env(SHELL)]} {

set _shellpath $env(SHELL)

} else {

set _shellpath /bin/sh

}

}

if {[is_Windows]} {

set _shellpath [safe_exec [list cygpath -m $_shellpath]]

}

if {![file executable $_shellpath] || \

!([file pathtype $_shellpath] eq {absolute})} {

set errmsg "The defined shell ('$_shellpath') is not usable, \

puts stderr $errmsg

catch {wm withdraw .}

tk_messageBox \

-icon error \

-type ok \

-title "git-gui: configuration error" \

-message $errmsg

exit 1

}

proc shellpath {} {

global _shellpath

return $_shellpath

}

proc appname {} {

global _appname

return $_appname

}

proc gitdir {args} {

global _gitdir

if {$args eq {}} {

return $_gitdir

}

return [eval [list file join $_gitdir] $args]

}

proc githtmldir {args} {

global _githtmldir

if {$_githtmldir eq {}} {

if {[catch {set _githtmldir [git --html-path]}]} {

# Git not installed or option not yet supported

return {}

}

set _githtmldir [file normalize $_githtmldir]

}

if {$args eq {}} {

return $_githtmldir

}

return [eval [list file join $_githtmldir] $args]

}

proc reponame {} {

return $::_reponame

}

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

}

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

}

set v [string tolower $v]

if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {

return 1

} else {

return 0

}

}

proc is_config_false {name} {

global repo_config

if {[catch {set v $repo_config($name)}]} {

return 0

}

set v [string tolower $v]

if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {

return 1

} else {

return 0

}

}

proc get_config {name} {

global repo_config

if {[catch {set v $repo_config($name)}]} {

return {}

} else {

return $v

}

}

proc is_bare {} {

return [expr {$::_gitworktree eq {}}]

}

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 open_cmd_pipe {cmd path} {

set run [list [shellpath] -c "$cmd \"\$0\"" $path]

set run [make_arglist_safe $run]

return [open |$run r]

}

proc git {args} {

git_redir $args {}

}

proc git_redir {cmd redir} {

set fd [git_read $cmd $redir]

fconfigure $fd -encoding utf-8

set result [string trimright [read $fd] "\n"]

close $fd

if {$::_trace} {

puts stderr "< $result"

}

return $result

}

proc safe_open_command {cmd {redir {}}} {

set cmd [make_arglist_safe $cmd]

_trace_exec [concat $cmd $redir]

if {[catch {

set fd [open [concat [list | ] $cmd $redir] r]

} err]} {

error $err

}

return $fd

}

proc git_read {cmd {redir {}}} {

global _git

set cmdp [concat [list $_git] $cmd]

return [safe_open_command $cmdp $redir]

}

set _nice [list [_which nice]]

if {[catch {safe_exec [list {*}$_nice git version]}]} {

set _nice {}

}

proc git_read_nice {cmd} {

set cmdp [list {*}$::_nice $::_git {*}$cmd]

return [safe_open_command $cmdp]

}

proc git_write {cmd} {

global _git

set cmd [make_arglist_safe $cmd]

set cmdp [concat [list $_git] $cmd]

_trace_exec $cmdp

return [open [concat [list | ] $cmdp] w]

}

proc githook_read {hook_name args} {

git_read [concat [list hook run --ignore-missing $hook_name --] $args] [list 2>@1]

}

proc kill_file_process {fd} {

set process [pid $fd]

catch {

if {[is_Windows]} {

safe_exec [list taskkill /pid $process]

} else {

safe_exec [list kill $process]

}

}

}

proc gitattr {path attr default} {

if {[catch {set r [git check-attr $attr -- $path]}]} {

set r unspecified

} else {

set r [join [lrange [split $r :] 2 end] :]

regsub {^ } $r {} r

}

if {$r eq {unspecified}} {

return $default

}

return $r

}

proc sq {value} {

regsub -all ' $value "'\\''" value

return "'$value'"

}

proc load_current_branch {} {

global current_branch is_detached

set current_branch [git branch --show-current]

set is_detached [expr [string length $current_branch] == 0]

if {$is_detached} {

set current_branch {HEAD}

}

}

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

bind $text <Motion> break

return $text

}

wm withdraw .

set root_exists 0

bind . <Visibility> {

bind . <Visibility> {}

set root_exists 1

}

if {[is_Windows]} {

wm iconbitmap . -default $oguilib/git-gui.ico

set ::tk::AlwaysShowSelection 1

bind . <Control-F2> {console show}

# Spoof an X11 display for SSH

if {![info exists env(DISPLAY)]} {

set env(DISPLAY) :9999

}

} else {

catch {

image create photo gitlogo -width 16 -height 16

gitlogo put #33CC33 -to 7 0 9 2

gitlogo put #33CC33 -to 4 2 12 4

gitlogo put #33CC33 -to 7 4 9 6

gitlogo put #CC3333 -to 4 6 12 8

gitlogo put gray26 -to 4 9 6 10

gitlogo put gray26 -to 3 10 6 12

gitlogo put gray26 -to 8 9 13 11

gitlogo put gray26 -to 8 11 10 12

gitlogo put gray26 -to 11 11 13 14

gitlogo put gray26 -to 3 12 5 14

gitlogo put gray26 -to 5 13

gitlogo put gray26 -to 10 13

gitlogo put gray26 -to 4 14 12 15

gitlogo put gray26 -to 5 15 11 16

gitlogo redither

image create photo gitlogo32 -width 32 -height 32

gitlogo32 copy gitlogo -zoom 2 2

wm iconphoto . -default gitlogo gitlogo32

}

}

set cursor_ptr arrow

font create font_ui

if {[lsearch -exact [font names] TkDefaultFont] != -1} {

eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]

eval [linsert [font actual TkFixedFont] 0 font create font_diff]

} else {

font create font_diff -family Courier -size 10

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 Message

Radiobutton Spinbox Text} {

option add *$class.font font_ui

}

if {![is_MacOSX]} {

option add *Menu.font font_ui

option add *Entry.borderWidth 1 startupFile

option add *Entry.relief sunken startupFile

option add *RadioButton.anchor w startupFile

}

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

}

bind [winfo class .] <<ThemeChanged>> [list InitTheme]

pave_toplevel .

color::sync_with_theme

global comment_string

set comment_string [get_config core.commentstring]

if {$comment_string eq {}} {

set comment_string [get_config core.commentchar]

}

}

set default_config(branch.autosetupmerge) true

set default_config(merge.tool) {}

set default_config(mergetool.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(core.commentchar) "#"

set default_config(core.commentstring) {}

set default_config(gui.encoding) [encoding system]

set default_config(gui.matchtrackingbranch) false

set default_config(gui.textconv) true

set default_config(gui.pruneduringfetch) false

set default_config(gui.trustmtime) false

set default_config(gui.fastcopyblame) false

set default_config(gui.maxrecentrepo) 10

set default_config(gui.copyblamethreshold) 40

set default_config(gui.blamehistoryctx) 7

set default_config(gui.diffcontext) 5

set default_config(gui.diffopts) {}

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 default_config(gui.maxfilesdisplayed) 5000

set default_config(gui.usettk) 1

set default_config(gui.warndetachedcommit) 1

set default_config(gui.tabsize) 8

set font_descs {

{fontui font_ui {mc "Main Font"}}

{fontdiff font_diff {mc "Diff/Console Font"}}

}

set default_config(gui.stageuntracked) ask

set default_config(gui.displayuntracked) true

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

}

set MIN_GIT_VERSION 2.36

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:

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

}

proc get_trimmed_version {s} {

set r {}

foreach x [split $s -._] {

if {[string is integer -strict $x]} {

lappend r $x

} else {

break

}

}

return [join $r .]

}

set _real_git_version $_git_version

set _git_version [get_trimmed_version $_git_version]

if {[catch {set vcheck [package vcompare $_git_version $MIN_GIT_VERSION]}] ||

[expr $vcheck < 0] } {

set msg1 [mc "Insufficient git version, require: "]

set msg2 [mc "git returned:"]

set message "$msg1 $MIN_GIT_VERSION\n$msg2 $_real_git_version"

catch {wm withdraw .}

tk_messageBox \

-icon error \

-type ok \

-title [mc "git-gui: fatal error"] \

-message $message

exit 1

}

unset _real_git_version

set idx [file join $oguilib tclIndex]

if {[catch {set fd [safe_open_file $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

proc _parse_config {arr_name args} {

upvar $arr_name arr

array unset arr

set buf {}

catch {

set fd_rc [git_read \

[concat config \

$args \

--null --list]]

fconfigure $fd_rc -encoding utf-8

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

}

} elseif {[regexp {^([^\n]+)$} $line line name]} {

# no value given, but interpreting them as

# boolean will be handled as true

set arr($name) {}

}

}

}

proc load_config {include_global} {

global repo_config global_config system_config default_config