PageRenderTime 67ms CodeModel.GetById 27ms RepoModel.GetById 0ms app.codeStats 0ms

/git/git-gui/git-gui.sh

https://review.tizen.org/git/
Shell | 3802 lines | 3355 code | 296 blank | 151 comment | 304 complexity | 6f1ce718c708f20e9ce8b58a50f8dcc6 MD5 | raw file
Possible License(s): GPL-3.0, AGPL-3.0, GPL-2.0, MPL-2.0, JSON, WTFPL, CC-BY-SA-4.0, CC-BY-3.0, BSD-3-Clause, LGPL-2.0, MPL-2.0-no-copyleft-exception, AGPL-1.0, 0BSD, Zlib, Unlicense, BSD-2-Clause, Apache-2.0, LGPL-3.0, ISC, MIT, CC-BY-SA-3.0, CC0-1.0, LGPL-2.1

Large files files are truncated, but you can click here to view the full file

  1. #!/bin/sh
  2. # Tcl ignores the next line -*- tcl -*- \
  3. if test "z$*" = zversion \
  4. || test "z$*" = z--version; \
  5. then \
  6. echo 'git-gui version @@GITGUI_VERSION@@'; \
  7. exit; \
  8. fi; \
  9. argv0=$0; \
  10. exec wish "$argv0" -- "$@"
  11. set appvers {@@GITGUI_VERSION@@}
  12. set copyright [encoding convertfrom utf-8 {
  13. Copyright Š 2006, 2007 Shawn Pearce, et. al.
  14. This program is free software; you can redistribute it and/or modify
  15. it under the terms of the GNU General Public License as published by
  16. the Free Software Foundation; either version 2 of the License, or
  17. (at your option) any later version.
  18. This program is distributed in the hope that it will be useful,
  19. but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. GNU General Public License for more details.
  22. You should have received a copy of the GNU General Public License
  23. along with this program; if not, write to the Free Software
  24. Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
  25. ######################################################################
  26. ##
  27. ## Tcl/Tk sanity check
  28. if {[catch {package require Tcl 8.4} err]
  29. || [catch {package require Tk 8.4} err]
  30. } {
  31. catch {wm withdraw .}
  32. tk_messageBox \
  33. -icon error \
  34. -type ok \
  35. -title "git-gui: fatal error" \
  36. -message $err
  37. exit 1
  38. }
  39. catch {rename send {}} ; # What an evil concept...
  40. ######################################################################
  41. ##
  42. ## locate our library
  43. set oguilib {@@GITGUI_LIBDIR@@}
  44. set oguirel {@@GITGUI_RELATIVE@@}
  45. if {$oguirel eq {1}} {
  46. set oguilib [file dirname [file normalize $argv0]]
  47. if {[file tail $oguilib] eq {git-core}} {
  48. set oguilib [file dirname $oguilib]
  49. }
  50. set oguilib [file dirname $oguilib]
  51. set oguilib [file join $oguilib share git-gui lib]
  52. set oguimsg [file join $oguilib msgs]
  53. } elseif {[string match @@* $oguirel]} {
  54. set oguilib [file join [file dirname [file normalize $argv0]] lib]
  55. set oguimsg [file join [file dirname [file normalize $argv0]] po]
  56. } else {
  57. set oguimsg [file join $oguilib msgs]
  58. }
  59. unset oguirel
  60. ######################################################################
  61. ##
  62. ## enable verbose loading?
  63. if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  64. unset _verbose
  65. rename auto_load real__auto_load
  66. proc auto_load {name args} {
  67. puts stderr "auto_load $name"
  68. return [uplevel 1 real__auto_load $name $args]
  69. }
  70. rename source real__source
  71. proc source {name} {
  72. puts stderr "source $name"
  73. uplevel 1 real__source $name
  74. }
  75. }
  76. ######################################################################
  77. ##
  78. ## Internationalization (i18n) through msgcat and gettext. See
  79. ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  80. package require msgcat
  81. proc _mc_trim {fmt} {
  82. set cmk [string first @@ $fmt]
  83. if {$cmk > 0} {
  84. return [string range $fmt 0 [expr {$cmk - 1}]]
  85. }
  86. return $fmt
  87. }
  88. proc mc {en_fmt args} {
  89. set fmt [_mc_trim [::msgcat::mc $en_fmt]]
  90. if {[catch {set msg [eval [list format $fmt] $args]} err]} {
  91. set msg [eval [list format [_mc_trim $en_fmt]] $args]
  92. }
  93. return $msg
  94. }
  95. proc strcat {args} {
  96. return [join $args {}]
  97. }
  98. ::msgcat::mcload $oguimsg
  99. unset oguimsg
  100. ######################################################################
  101. ##
  102. ## read only globals
  103. set _appname {Git Gui}
  104. set _gitdir {}
  105. set _gitworktree {}
  106. set _isbare {}
  107. set _gitexec {}
  108. set _githtmldir {}
  109. set _reponame {}
  110. set _iscygwin {}
  111. set _search_path {}
  112. set _trace [lsearch -exact $argv --trace]
  113. if {$_trace >= 0} {
  114. set argv [lreplace $argv $_trace $_trace]
  115. set _trace 1
  116. } else {
  117. set _trace 0
  118. }
  119. proc appname {} {
  120. global _appname
  121. return $_appname
  122. }
  123. proc gitdir {args} {
  124. global _gitdir
  125. if {$args eq {}} {
  126. return $_gitdir
  127. }
  128. return [eval [list file join $_gitdir] $args]
  129. }
  130. proc gitexec {args} {
  131. global _gitexec
  132. if {$_gitexec eq {}} {
  133. if {[catch {set _gitexec [git --exec-path]} err]} {
  134. error "Git not installed?\n\n$err"
  135. }
  136. if {[is_Cygwin]} {
  137. set _gitexec [exec cygpath \
  138. --windows \
  139. --absolute \
  140. $_gitexec]
  141. } else {
  142. set _gitexec [file normalize $_gitexec]
  143. }
  144. }
  145. if {$args eq {}} {
  146. return $_gitexec
  147. }
  148. return [eval [list file join $_gitexec] $args]
  149. }
  150. proc githtmldir {args} {
  151. global _githtmldir
  152. if {$_githtmldir eq {}} {
  153. if {[catch {set _githtmldir [git --html-path]}]} {
  154. # Git not installed or option not yet supported
  155. return {}
  156. }
  157. if {[is_Cygwin]} {
  158. set _githtmldir [exec cygpath \
  159. --windows \
  160. --absolute \
  161. $_githtmldir]
  162. } else {
  163. set _githtmldir [file normalize $_githtmldir]
  164. }
  165. }
  166. if {$args eq {}} {
  167. return $_githtmldir
  168. }
  169. return [eval [list file join $_githtmldir] $args]
  170. }
  171. proc reponame {} {
  172. return $::_reponame
  173. }
  174. proc is_MacOSX {} {
  175. if {[tk windowingsystem] eq {aqua}} {
  176. return 1
  177. }
  178. return 0
  179. }
  180. proc is_Windows {} {
  181. if {$::tcl_platform(platform) eq {windows}} {
  182. return 1
  183. }
  184. return 0
  185. }
  186. proc is_Cygwin {} {
  187. global _iscygwin
  188. if {$_iscygwin eq {}} {
  189. if {$::tcl_platform(platform) eq {windows}} {
  190. if {[catch {set p [exec cygpath --windir]} err]} {
  191. set _iscygwin 0
  192. } else {
  193. set _iscygwin 1
  194. }
  195. } else {
  196. set _iscygwin 0
  197. }
  198. }
  199. return $_iscygwin
  200. }
  201. proc is_enabled {option} {
  202. global enabled_options
  203. if {[catch {set on $enabled_options($option)}]} {return 0}
  204. return $on
  205. }
  206. proc enable_option {option} {
  207. global enabled_options
  208. set enabled_options($option) 1
  209. }
  210. proc disable_option {option} {
  211. global enabled_options
  212. set enabled_options($option) 0
  213. }
  214. ######################################################################
  215. ##
  216. ## config
  217. proc is_many_config {name} {
  218. switch -glob -- $name {
  219. gui.recentrepo -
  220. remote.*.fetch -
  221. remote.*.push
  222. {return 1}
  223. *
  224. {return 0}
  225. }
  226. }
  227. proc is_config_true {name} {
  228. global repo_config
  229. if {[catch {set v $repo_config($name)}]} {
  230. return 0
  231. } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
  232. return 1
  233. } else {
  234. return 0
  235. }
  236. }
  237. proc is_config_false {name} {
  238. global repo_config
  239. if {[catch {set v $repo_config($name)}]} {
  240. return 0
  241. } elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
  242. return 1
  243. } else {
  244. return 0
  245. }
  246. }
  247. proc get_config {name} {
  248. global repo_config
  249. if {[catch {set v $repo_config($name)}]} {
  250. return {}
  251. } else {
  252. return $v
  253. }
  254. }
  255. proc is_bare {} {
  256. global _isbare
  257. global _gitdir
  258. global _gitworktree
  259. if {$_isbare eq {}} {
  260. if {[catch {
  261. set _bare [git rev-parse --is-bare-repository]
  262. switch -- $_bare {
  263. true { set _isbare 1 }
  264. false { set _isbare 0}
  265. default { throw }
  266. }
  267. }]} {
  268. if {[is_config_true core.bare]
  269. || ($_gitworktree eq {}
  270. && [lindex [file split $_gitdir] end] ne {.git})} {
  271. set _isbare 1
  272. } else {
  273. set _isbare 0
  274. }
  275. }
  276. }
  277. return $_isbare
  278. }
  279. ######################################################################
  280. ##
  281. ## handy utils
  282. proc _trace_exec {cmd} {
  283. if {!$::_trace} return
  284. set d {}
  285. foreach v $cmd {
  286. if {$d ne {}} {
  287. append d { }
  288. }
  289. if {[regexp {[ \t\r\n'"$?*]} $v]} {
  290. set v [sq $v]
  291. }
  292. append d $v
  293. }
  294. puts stderr $d
  295. }
  296. #'" fix poor old emacs font-lock mode
  297. proc _git_cmd {name} {
  298. global _git_cmd_path
  299. if {[catch {set v $_git_cmd_path($name)}]} {
  300. switch -- $name {
  301. version -
  302. --version -
  303. --exec-path { return [list $::_git $name] }
  304. }
  305. set p [gitexec git-$name$::_search_exe]
  306. if {[file exists $p]} {
  307. set v [list $p]
  308. } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
  309. # Try to determine what sort of magic will make
  310. # git-$name go and do its thing, because native
  311. # Tcl on Windows doesn't know it.
  312. #
  313. set p [gitexec git-$name]
  314. set f [open $p r]
  315. set s [gets $f]
  316. close $f
  317. switch -glob -- [lindex $s 0] {
  318. #!*sh { set i sh }
  319. #!*perl { set i perl }
  320. #!*python { set i python }
  321. default { error "git-$name is not supported: $s" }
  322. }
  323. upvar #0 _$i interp
  324. if {![info exists interp]} {
  325. set interp [_which $i]
  326. }
  327. if {$interp eq {}} {
  328. error "git-$name requires $i (not in PATH)"
  329. }
  330. set v [concat [list $interp] [lrange $s 1 end] [list $p]]
  331. } else {
  332. # Assume it is builtin to git somehow and we
  333. # aren't actually able to see a file for it.
  334. #
  335. set v [list $::_git $name]
  336. }
  337. set _git_cmd_path($name) $v
  338. }
  339. return $v
  340. }
  341. proc _which {what args} {
  342. global env _search_exe _search_path
  343. if {$_search_path eq {}} {
  344. if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
  345. set _search_path [split [exec cygpath \
  346. --windows \
  347. --path \
  348. --absolute \
  349. $env(PATH)] {;}]
  350. set _search_exe .exe
  351. } elseif {[is_Windows]} {
  352. set gitguidir [file dirname [info script]]
  353. regsub -all ";" $gitguidir "\\;" gitguidir
  354. set env(PATH) "$gitguidir;$env(PATH)"
  355. set _search_path [split $env(PATH) {;}]
  356. set _search_exe .exe
  357. } else {
  358. set _search_path [split $env(PATH) :]
  359. set _search_exe {}
  360. }
  361. }
  362. if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
  363. set suffix {}
  364. } else {
  365. set suffix $_search_exe
  366. }
  367. foreach p $_search_path {
  368. set p [file join $p $what$suffix]
  369. if {[file exists $p]} {
  370. return [file normalize $p]
  371. }
  372. }
  373. return {}
  374. }
  375. proc _lappend_nice {cmd_var} {
  376. global _nice
  377. upvar $cmd_var cmd
  378. if {![info exists _nice]} {
  379. set _nice [_which nice]
  380. if {[catch {exec $_nice git version}]} {
  381. set _nice {}
  382. }
  383. }
  384. if {$_nice ne {}} {
  385. lappend cmd $_nice
  386. }
  387. }
  388. proc git {args} {
  389. set opt [list]
  390. while {1} {
  391. switch -- [lindex $args 0] {
  392. --nice {
  393. _lappend_nice opt
  394. }
  395. default {
  396. break
  397. }
  398. }
  399. set args [lrange $args 1 end]
  400. }
  401. set cmdp [_git_cmd [lindex $args 0]]
  402. set args [lrange $args 1 end]
  403. _trace_exec [concat $opt $cmdp $args]
  404. set result [eval exec $opt $cmdp $args]
  405. if {$::_trace} {
  406. puts stderr "< $result"
  407. }
  408. return $result
  409. }
  410. proc _open_stdout_stderr {cmd} {
  411. _trace_exec $cmd
  412. if {[catch {
  413. set fd [open [concat [list | ] $cmd] r]
  414. } err]} {
  415. if { [lindex $cmd end] eq {2>@1}
  416. && $err eq {can not find channel named "1"}
  417. } {
  418. # Older versions of Tcl 8.4 don't have this 2>@1 IO
  419. # redirect operator. Fallback to |& cat for those.
  420. # The command was not actually started, so its safe
  421. # to try to start it a second time.
  422. #
  423. set fd [open [concat \
  424. [list | ] \
  425. [lrange $cmd 0 end-1] \
  426. [list |& cat] \
  427. ] r]
  428. } else {
  429. error $err
  430. }
  431. }
  432. fconfigure $fd -eofchar {}
  433. return $fd
  434. }
  435. proc git_read {args} {
  436. set opt [list]
  437. while {1} {
  438. switch -- [lindex $args 0] {
  439. --nice {
  440. _lappend_nice opt
  441. }
  442. --stderr {
  443. lappend args 2>@1
  444. }
  445. default {
  446. break
  447. }
  448. }
  449. set args [lrange $args 1 end]
  450. }
  451. set cmdp [_git_cmd [lindex $args 0]]
  452. set args [lrange $args 1 end]
  453. return [_open_stdout_stderr [concat $opt $cmdp $args]]
  454. }
  455. proc git_write {args} {
  456. set opt [list]
  457. while {1} {
  458. switch -- [lindex $args 0] {
  459. --nice {
  460. _lappend_nice opt
  461. }
  462. default {
  463. break
  464. }
  465. }
  466. set args [lrange $args 1 end]
  467. }
  468. set cmdp [_git_cmd [lindex $args 0]]
  469. set args [lrange $args 1 end]
  470. _trace_exec [concat $opt $cmdp $args]
  471. return [open [concat [list | ] $opt $cmdp $args] w]
  472. }
  473. proc githook_read {hook_name args} {
  474. set pchook [gitdir hooks $hook_name]
  475. lappend args 2>@1
  476. # On Windows [file executable] might lie so we need to ask
  477. # the shell if the hook is executable. Yes that's annoying.
  478. #
  479. if {[is_Windows]} {
  480. upvar #0 _sh interp
  481. if {![info exists interp]} {
  482. set interp [_which sh]
  483. }
  484. if {$interp eq {}} {
  485. error "hook execution requires sh (not in PATH)"
  486. }
  487. set scr {if test -x "$1";then exec "$@";fi}
  488. set sh_c [list $interp -c $scr $interp $pchook]
  489. return [_open_stdout_stderr [concat $sh_c $args]]
  490. }
  491. if {[file executable $pchook]} {
  492. return [_open_stdout_stderr [concat [list $pchook] $args]]
  493. }
  494. return {}
  495. }
  496. proc kill_file_process {fd} {
  497. set process [pid $fd]
  498. catch {
  499. if {[is_Windows]} {
  500. # Use a Cygwin-specific flag to allow killing
  501. # native Windows processes
  502. exec kill -f $process
  503. } else {
  504. exec kill $process
  505. }
  506. }
  507. }
  508. proc gitattr {path attr default} {
  509. if {[catch {set r [git check-attr $attr -- $path]}]} {
  510. set r unspecified
  511. } else {
  512. set r [join [lrange [split $r :] 2 end] :]
  513. regsub {^ } $r {} r
  514. }
  515. if {$r eq {unspecified}} {
  516. return $default
  517. }
  518. return $r
  519. }
  520. proc sq {value} {
  521. regsub -all ' $value "'\\''" value
  522. return "'$value'"
  523. }
  524. proc load_current_branch {} {
  525. global current_branch is_detached
  526. set fd [open [gitdir HEAD] r]
  527. if {[gets $fd ref] < 1} {
  528. set ref {}
  529. }
  530. close $fd
  531. set pfx {ref: refs/heads/}
  532. set len [string length $pfx]
  533. if {[string equal -length $len $pfx $ref]} {
  534. # We're on a branch. It might not exist. But
  535. # HEAD looks good enough to be a branch.
  536. #
  537. set current_branch [string range $ref $len end]
  538. set is_detached 0
  539. } else {
  540. # Assume this is a detached head.
  541. #
  542. set current_branch HEAD
  543. set is_detached 1
  544. }
  545. }
  546. auto_load tk_optionMenu
  547. rename tk_optionMenu real__tkOptionMenu
  548. proc tk_optionMenu {w varName args} {
  549. set m [eval real__tkOptionMenu $w $varName $args]
  550. $m configure -font font_ui
  551. $w configure -font font_ui
  552. return $m
  553. }
  554. proc rmsel_tag {text} {
  555. $text tag conf sel \
  556. -background [$text cget -background] \
  557. -foreground [$text cget -foreground] \
  558. -borderwidth 0
  559. $text tag conf in_sel -background lightgray
  560. bind $text <Motion> break
  561. return $text
  562. }
  563. wm withdraw .
  564. set root_exists 0
  565. bind . <Visibility> {
  566. bind . <Visibility> {}
  567. set root_exists 1
  568. }
  569. if {[is_Windows]} {
  570. wm iconbitmap . -default $oguilib/git-gui.ico
  571. set ::tk::AlwaysShowSelection 1
  572. # Spoof an X11 display for SSH
  573. if {![info exists env(DISPLAY)]} {
  574. set env(DISPLAY) :9999
  575. }
  576. } else {
  577. catch {
  578. image create photo gitlogo -width 16 -height 16
  579. gitlogo put #33CC33 -to 7 0 9 2
  580. gitlogo put #33CC33 -to 4 2 12 4
  581. gitlogo put #33CC33 -to 7 4 9 6
  582. gitlogo put #CC3333 -to 4 6 12 8
  583. gitlogo put gray26 -to 4 9 6 10
  584. gitlogo put gray26 -to 3 10 6 12
  585. gitlogo put gray26 -to 8 9 13 11
  586. gitlogo put gray26 -to 8 11 10 12
  587. gitlogo put gray26 -to 11 11 13 14
  588. gitlogo put gray26 -to 3 12 5 14
  589. gitlogo put gray26 -to 5 13
  590. gitlogo put gray26 -to 10 13
  591. gitlogo put gray26 -to 4 14 12 15
  592. gitlogo put gray26 -to 5 15 11 16
  593. gitlogo redither
  594. wm iconphoto . -default gitlogo
  595. }
  596. }
  597. ######################################################################
  598. ##
  599. ## config defaults
  600. set cursor_ptr arrow
  601. font create font_ui
  602. if {[lsearch -exact [font names] TkDefaultFont] != -1} {
  603. eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
  604. eval [linsert [font actual TkFixedFont] 0 font create font_diff]
  605. } else {
  606. font create font_diff -family Courier -size 10
  607. catch {
  608. label .dummy
  609. eval font configure font_ui [font actual [.dummy cget -font]]
  610. destroy .dummy
  611. }
  612. }
  613. font create font_uiitalic
  614. font create font_uibold
  615. font create font_diffbold
  616. font create font_diffitalic
  617. foreach class {Button Checkbutton Entry Label
  618. Labelframe Listbox Message
  619. Radiobutton Spinbox Text} {
  620. option add *$class.font font_ui
  621. }
  622. if {![is_MacOSX]} {
  623. option add *Menu.font font_ui
  624. option add *Entry.borderWidth 1 startupFile
  625. option add *Entry.relief sunken startupFile
  626. option add *RadioButton.anchor w startupFile
  627. }
  628. unset class
  629. if {[is_Windows] || [is_MacOSX]} {
  630. option add *Menu.tearOff 0
  631. }
  632. if {[is_MacOSX]} {
  633. set M1B M1
  634. set M1T Cmd
  635. } else {
  636. set M1B Control
  637. set M1T Ctrl
  638. }
  639. proc bind_button3 {w cmd} {
  640. bind $w <Any-Button-3> $cmd
  641. if {[is_MacOSX]} {
  642. # Mac OS X sends Button-2 on right click through three-button mouse,
  643. # or through trackpad right-clicking (two-finger touch + click).
  644. bind $w <Any-Button-2> $cmd
  645. bind $w <Control-Button-1> $cmd
  646. }
  647. }
  648. proc apply_config {} {
  649. global repo_config font_descs
  650. foreach option $font_descs {
  651. set name [lindex $option 0]
  652. set font [lindex $option 1]
  653. if {[catch {
  654. set need_weight 1
  655. foreach {cn cv} $repo_config(gui.$name) {
  656. if {$cn eq {-weight}} {
  657. set need_weight 0
  658. }
  659. font configure $font $cn $cv
  660. }
  661. if {$need_weight} {
  662. font configure $font -weight normal
  663. }
  664. } err]} {
  665. error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
  666. }
  667. foreach {cn cv} [font configure $font] {
  668. font configure ${font}bold $cn $cv
  669. font configure ${font}italic $cn $cv
  670. }
  671. font configure ${font}bold -weight bold
  672. font configure ${font}italic -slant italic
  673. }
  674. global use_ttk NS
  675. set use_ttk 0
  676. set NS {}
  677. if {$repo_config(gui.usettk)} {
  678. set use_ttk [package vsatisfies [package provide Tk] 8.5]
  679. if {$use_ttk} {
  680. set NS ttk
  681. bind [winfo class .] <<ThemeChanged>> [list InitTheme]
  682. pave_toplevel .
  683. }
  684. }
  685. }
  686. set default_config(branch.autosetupmerge) true
  687. set default_config(merge.tool) {}
  688. set default_config(mergetool.keepbackup) true
  689. set default_config(merge.diffstat) true
  690. set default_config(merge.summary) false
  691. set default_config(merge.verbosity) 2
  692. set default_config(user.name) {}
  693. set default_config(user.email) {}
  694. set default_config(gui.encoding) [encoding system]
  695. set default_config(gui.matchtrackingbranch) false
  696. set default_config(gui.textconv) true
  697. set default_config(gui.pruneduringfetch) false
  698. set default_config(gui.trustmtime) false
  699. set default_config(gui.fastcopyblame) false
  700. set default_config(gui.copyblamethreshold) 40
  701. set default_config(gui.blamehistoryctx) 7
  702. set default_config(gui.diffcontext) 5
  703. set default_config(gui.commitmsgwidth) 75
  704. set default_config(gui.newbranchtemplate) {}
  705. set default_config(gui.spellingdictionary) {}
  706. set default_config(gui.fontui) [font configure font_ui]
  707. set default_config(gui.fontdiff) [font configure font_diff]
  708. # TODO: this option should be added to the git-config documentation
  709. set default_config(gui.maxfilesdisplayed) 5000
  710. set default_config(gui.usettk) 1
  711. set font_descs {
  712. {fontui font_ui {mc "Main Font"}}
  713. {fontdiff font_diff {mc "Diff/Console Font"}}
  714. }
  715. ######################################################################
  716. ##
  717. ## find git
  718. set _git [_which git]
  719. if {$_git eq {}} {
  720. catch {wm withdraw .}
  721. tk_messageBox \
  722. -icon error \
  723. -type ok \
  724. -title [mc "git-gui: fatal error"] \
  725. -message [mc "Cannot find git in PATH."]
  726. exit 1
  727. }
  728. ######################################################################
  729. ##
  730. ## version check
  731. if {[catch {set _git_version [git --version]} err]} {
  732. catch {wm withdraw .}
  733. tk_messageBox \
  734. -icon error \
  735. -type ok \
  736. -title [mc "git-gui: fatal error"] \
  737. -message "Cannot determine Git version:
  738. $err
  739. [appname] requires Git 1.5.0 or later."
  740. exit 1
  741. }
  742. if {![regsub {^git version } $_git_version {} _git_version]} {
  743. catch {wm withdraw .}
  744. tk_messageBox \
  745. -icon error \
  746. -type ok \
  747. -title [mc "git-gui: fatal error"] \
  748. -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
  749. exit 1
  750. }
  751. set _real_git_version $_git_version
  752. regsub -- {[\-\.]dirty$} $_git_version {} _git_version
  753. regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
  754. regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
  755. regsub {\.GIT$} $_git_version {} _git_version
  756. regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
  757. if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
  758. catch {wm withdraw .}
  759. if {[tk_messageBox \
  760. -icon warning \
  761. -type yesno \
  762. -default no \
  763. -title "[appname]: warning" \
  764. -message [mc "Git version cannot be determined.
  765. %s claims it is version '%s'.
  766. %s requires at least Git 1.5.0 or later.
  767. Assume '%s' is version 1.5.0?
  768. " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
  769. set _git_version 1.5.0
  770. } else {
  771. exit 1
  772. }
  773. }
  774. unset _real_git_version
  775. proc git-version {args} {
  776. global _git_version
  777. switch [llength $args] {
  778. 0 {
  779. return $_git_version
  780. }
  781. 2 {
  782. set op [lindex $args 0]
  783. set vr [lindex $args 1]
  784. set cm [package vcompare $_git_version $vr]
  785. return [expr $cm $op 0]
  786. }
  787. 4 {
  788. set type [lindex $args 0]
  789. set name [lindex $args 1]
  790. set parm [lindex $args 2]
  791. set body [lindex $args 3]
  792. if {($type ne {proc} && $type ne {method})} {
  793. error "Invalid arguments to git-version"
  794. }
  795. if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
  796. error "Last arm of $type $name must be default"
  797. }
  798. foreach {op vr cb} [lrange $body 0 end-2] {
  799. if {[git-version $op $vr]} {
  800. return [uplevel [list $type $name $parm $cb]]
  801. }
  802. }
  803. return [uplevel [list $type $name $parm [lindex $body end]]]
  804. }
  805. default {
  806. error "git-version >= x"
  807. }
  808. }
  809. }
  810. if {[git-version < 1.5]} {
  811. catch {wm withdraw .}
  812. tk_messageBox \
  813. -icon error \
  814. -type ok \
  815. -title [mc "git-gui: fatal error"] \
  816. -message "[appname] requires Git 1.5.0 or later.
  817. You are using [git-version]:
  818. [git --version]"
  819. exit 1
  820. }
  821. ######################################################################
  822. ##
  823. ## configure our library
  824. set idx [file join $oguilib tclIndex]
  825. if {[catch {set fd [open $idx r]} err]} {
  826. catch {wm withdraw .}
  827. tk_messageBox \
  828. -icon error \
  829. -type ok \
  830. -title [mc "git-gui: fatal error"] \
  831. -message $err
  832. exit 1
  833. }
  834. if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
  835. set idx [list]
  836. while {[gets $fd n] >= 0} {
  837. if {$n ne {} && ![string match #* $n]} {
  838. lappend idx $n
  839. }
  840. }
  841. } else {
  842. set idx {}
  843. }
  844. close $fd
  845. if {$idx ne {}} {
  846. set loaded [list]
  847. foreach p $idx {
  848. if {[lsearch -exact $loaded $p] >= 0} continue
  849. source [file join $oguilib $p]
  850. lappend loaded $p
  851. }
  852. unset loaded p
  853. } else {
  854. set auto_path [concat [list $oguilib] $auto_path]
  855. }
  856. unset -nocomplain idx fd
  857. ######################################################################
  858. ##
  859. ## config file parsing
  860. git-version proc _parse_config {arr_name args} {
  861. >= 1.5.3 {
  862. upvar $arr_name arr
  863. array unset arr
  864. set buf {}
  865. catch {
  866. set fd_rc [eval \
  867. [list git_read config] \
  868. $args \
  869. [list --null --list]]
  870. fconfigure $fd_rc -translation binary
  871. set buf [read $fd_rc]
  872. close $fd_rc
  873. }
  874. foreach line [split $buf "\0"] {
  875. if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
  876. if {[is_many_config $name]} {
  877. lappend arr($name) $value
  878. } else {
  879. set arr($name) $value
  880. }
  881. }
  882. }
  883. }
  884. default {
  885. upvar $arr_name arr
  886. array unset arr
  887. catch {
  888. set fd_rc [eval [list git_read config --list] $args]
  889. while {[gets $fd_rc line] >= 0} {
  890. if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  891. if {[is_many_config $name]} {
  892. lappend arr($name) $value
  893. } else {
  894. set arr($name) $value
  895. }
  896. }
  897. }
  898. close $fd_rc
  899. }
  900. }
  901. }
  902. proc load_config {include_global} {
  903. global repo_config global_config system_config default_config
  904. if {$include_global} {
  905. _parse_config system_config --system
  906. _parse_config global_config --global
  907. }
  908. _parse_config repo_config
  909. foreach name [array names default_config] {
  910. if {[catch {set v $system_config($name)}]} {
  911. set system_config($name) $default_config($name)
  912. }
  913. }
  914. foreach name [array names system_config] {
  915. if {[catch {set v $global_config($name)}]} {
  916. set global_config($name) $system_config($name)
  917. }
  918. if {[catch {set v $repo_config($name)}]} {
  919. set repo_config($name) $system_config($name)
  920. }
  921. }
  922. }
  923. ######################################################################
  924. ##
  925. ## feature option selection
  926. if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
  927. unset _junk
  928. } else {
  929. set subcommand gui
  930. }
  931. if {$subcommand eq {gui.sh}} {
  932. set subcommand gui
  933. }
  934. if {$subcommand eq {gui} && [llength $argv] > 0} {
  935. set subcommand [lindex $argv 0]
  936. set argv [lrange $argv 1 end]
  937. }
  938. enable_option multicommit
  939. enable_option branch
  940. enable_option transport
  941. disable_option bare
  942. switch -- $subcommand {
  943. browser -
  944. blame {
  945. enable_option bare
  946. disable_option multicommit
  947. disable_option branch
  948. disable_option transport
  949. }
  950. citool {
  951. enable_option singlecommit
  952. enable_option retcode
  953. disable_option multicommit
  954. disable_option branch
  955. disable_option transport
  956. while {[llength $argv] > 0} {
  957. set a [lindex $argv 0]
  958. switch -- $a {
  959. --amend {
  960. enable_option initialamend
  961. }
  962. --nocommit {
  963. enable_option nocommit
  964. enable_option nocommitmsg
  965. }
  966. --commitmsg {
  967. disable_option nocommitmsg
  968. }
  969. default {
  970. break
  971. }
  972. }
  973. set argv [lrange $argv 1 end]
  974. }
  975. }
  976. }
  977. ######################################################################
  978. ##
  979. ## execution environment
  980. set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
  981. # Suggest our implementation of askpass, if none is set
  982. if {![info exists env(SSH_ASKPASS)]} {
  983. set env(SSH_ASKPASS) [gitexec git-gui--askpass]
  984. }
  985. ######################################################################
  986. ##
  987. ## repository setup
  988. set picked 0
  989. if {[catch {
  990. set _gitdir $env(GIT_DIR)
  991. set _prefix {}
  992. }]
  993. && [catch {
  994. # beware that from the .git dir this sets _gitdir to .
  995. # and _prefix to the empty string
  996. set _gitdir [git rev-parse --git-dir]
  997. set _prefix [git rev-parse --show-prefix]
  998. } err]} {
  999. load_config 1
  1000. apply_config
  1001. choose_repository::pick
  1002. set picked 1
  1003. }
  1004. # we expand the _gitdir when it's just a single dot (i.e. when we're being
  1005. # run from the .git dir itself) lest the routines to find the worktree
  1006. # get confused
  1007. if {$_gitdir eq "."} {
  1008. set _gitdir [pwd]
  1009. }
  1010. if {![file isdirectory $_gitdir] && [is_Cygwin]} {
  1011. catch {set _gitdir [exec cygpath --windows $_gitdir]}
  1012. }
  1013. if {![file isdirectory $_gitdir]} {
  1014. catch {wm withdraw .}
  1015. error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
  1016. exit 1
  1017. }
  1018. # _gitdir exists, so try loading the config
  1019. load_config 0
  1020. apply_config
  1021. # try to set work tree from environment, falling back to core.worktree
  1022. if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  1023. set _gitworktree [get_config core.worktree]
  1024. if {$_gitworktree eq ""} {
  1025. set _gitworktree [file dirname [file normalize $_gitdir]]
  1026. }
  1027. }
  1028. if {$_prefix ne {}} {
  1029. if {$_gitworktree eq {}} {
  1030. regsub -all {[^/]+/} $_prefix ../ cdup
  1031. } else {
  1032. set cdup $_gitworktree
  1033. }
  1034. if {[catch {cd $cdup} err]} {
  1035. catch {wm withdraw .}
  1036. error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
  1037. exit 1
  1038. }
  1039. set _gitworktree [pwd]
  1040. unset cdup
  1041. } elseif {![is_enabled bare]} {
  1042. if {[is_bare]} {
  1043. catch {wm withdraw .}
  1044. error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
  1045. exit 1
  1046. }
  1047. if {$_gitworktree eq {}} {
  1048. set _gitworktree [file dirname $_gitdir]
  1049. }
  1050. if {[catch {cd $_gitworktree} err]} {
  1051. catch {wm withdraw .}
  1052. error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
  1053. exit 1
  1054. }
  1055. set _gitworktree [pwd]
  1056. }
  1057. set _reponame [file split [file normalize $_gitdir]]
  1058. if {[lindex $_reponame end] eq {.git}} {
  1059. set _reponame [lindex $_reponame end-1]
  1060. } else {
  1061. set _reponame [lindex $_reponame end]
  1062. }
  1063. set env(GIT_DIR) $_gitdir
  1064. set env(GIT_WORK_TREE) $_gitworktree
  1065. ######################################################################
  1066. ##
  1067. ## global init
  1068. set current_diff_path {}
  1069. set current_diff_side {}
  1070. set diff_actions [list]
  1071. set HEAD {}
  1072. set PARENT {}
  1073. set MERGE_HEAD [list]
  1074. set commit_type {}
  1075. set empty_tree {}
  1076. set current_branch {}
  1077. set is_detached 0
  1078. set current_diff_path {}
  1079. set is_3way_diff 0
  1080. set is_submodule_diff 0
  1081. set is_conflict_diff 0
  1082. set selected_commit_type new
  1083. set diff_empty_count 0
  1084. set nullid "0000000000000000000000000000000000000000"
  1085. set nullid2 "0000000000000000000000000000000000000001"
  1086. ######################################################################
  1087. ##
  1088. ## task management
  1089. set rescan_active 0
  1090. set diff_active 0
  1091. set last_clicked {}
  1092. set disable_on_lock [list]
  1093. set index_lock_type none
  1094. proc lock_index {type} {
  1095. global index_lock_type disable_on_lock
  1096. if {$index_lock_type eq {none}} {
  1097. set index_lock_type $type
  1098. foreach w $disable_on_lock {
  1099. uplevel #0 $w disabled
  1100. }
  1101. return 1
  1102. } elseif {$index_lock_type eq "begin-$type"} {
  1103. set index_lock_type $type
  1104. return 1
  1105. }
  1106. return 0
  1107. }
  1108. proc unlock_index {} {
  1109. global index_lock_type disable_on_lock
  1110. set index_lock_type none
  1111. foreach w $disable_on_lock {
  1112. uplevel #0 $w normal
  1113. }
  1114. }
  1115. ######################################################################
  1116. ##
  1117. ## status
  1118. proc repository_state {ctvar hdvar mhvar} {
  1119. global current_branch
  1120. upvar $ctvar ct $hdvar hd $mhvar mh
  1121. set mh [list]
  1122. load_current_branch
  1123. if {[catch {set hd [git rev-parse --verify HEAD]}]} {
  1124. set hd {}
  1125. set ct initial
  1126. return
  1127. }
  1128. set merge_head [gitdir MERGE_HEAD]
  1129. if {[file exists $merge_head]} {
  1130. set ct merge
  1131. set fd_mh [open $merge_head r]
  1132. while {[gets $fd_mh line] >= 0} {
  1133. lappend mh $line
  1134. }
  1135. close $fd_mh
  1136. return
  1137. }
  1138. set ct normal
  1139. }
  1140. proc PARENT {} {
  1141. global PARENT empty_tree
  1142. set p [lindex $PARENT 0]
  1143. if {$p ne {}} {
  1144. return $p
  1145. }
  1146. if {$empty_tree eq {}} {
  1147. set empty_tree [git mktree << {}]
  1148. }
  1149. return $empty_tree
  1150. }
  1151. proc force_amend {} {
  1152. global selected_commit_type
  1153. global HEAD PARENT MERGE_HEAD commit_type
  1154. repository_state newType newHEAD newMERGE_HEAD
  1155. set HEAD $newHEAD
  1156. set PARENT $newHEAD
  1157. set MERGE_HEAD $newMERGE_HEAD
  1158. set commit_type $newType
  1159. set selected_commit_type amend
  1160. do_select_commit_type
  1161. }
  1162. proc rescan {after {honor_trustmtime 1}} {
  1163. global HEAD PARENT MERGE_HEAD commit_type
  1164. global ui_index ui_workdir ui_comm
  1165. global rescan_active file_states
  1166. global repo_config
  1167. if {$rescan_active > 0 || ![lock_index read]} return
  1168. repository_state newType newHEAD newMERGE_HEAD
  1169. if {[string match amend* $commit_type]
  1170. && $newType eq {normal}
  1171. && $newHEAD eq $HEAD} {
  1172. } else {
  1173. set HEAD $newHEAD
  1174. set PARENT $newHEAD
  1175. set MERGE_HEAD $newMERGE_HEAD
  1176. set commit_type $newType
  1177. }
  1178. array unset file_states
  1179. if {!$::GITGUI_BCK_exists &&
  1180. (![$ui_comm edit modified]
  1181. || [string trim [$ui_comm get 0.0 end]] eq {})} {
  1182. if {[string match amend* $commit_type]} {
  1183. } elseif {[load_message GITGUI_MSG]} {
  1184. } elseif {[run_prepare_commit_msg_hook]} {
  1185. } elseif {[load_message MERGE_MSG]} {
  1186. } elseif {[load_message SQUASH_MSG]} {
  1187. }
  1188. $ui_comm edit reset
  1189. $ui_comm edit modified false
  1190. }
  1191. if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
  1192. rescan_stage2 {} $after
  1193. } else {
  1194. set rescan_active 1
  1195. ui_status [mc "Refreshing file status..."]
  1196. set fd_rf [git_read update-index \
  1197. -q \
  1198. --unmerged \
  1199. --ignore-missing \
  1200. --refresh \
  1201. ]
  1202. fconfigure $fd_rf -blocking 0 -translation binary
  1203. fileevent $fd_rf readable \
  1204. [list rescan_stage2 $fd_rf $after]
  1205. }
  1206. }
  1207. if {[is_Cygwin]} {
  1208. set is_git_info_exclude {}
  1209. proc have_info_exclude {} {
  1210. global is_git_info_exclude
  1211. if {$is_git_info_exclude eq {}} {
  1212. if {[catch {exec test -f [gitdir info exclude]}]} {
  1213. set is_git_info_exclude 0
  1214. } else {
  1215. set is_git_info_exclude 1
  1216. }
  1217. }
  1218. return $is_git_info_exclude
  1219. }
  1220. } else {
  1221. proc have_info_exclude {} {
  1222. return [file readable [gitdir info exclude]]
  1223. }
  1224. }
  1225. proc rescan_stage2 {fd after} {
  1226. global rescan_active buf_rdi buf_rdf buf_rlo
  1227. if {$fd ne {}} {
  1228. read $fd
  1229. if {![eof $fd]} return
  1230. close $fd
  1231. }
  1232. set ls_others [list --exclude-per-directory=.gitignore]
  1233. if {[have_info_exclude]} {
  1234. lappend ls_others "--exclude-from=[gitdir info exclude]"
  1235. }
  1236. set user_exclude [get_config core.excludesfile]
  1237. if {$user_exclude ne {} && [file readable $user_exclude]} {
  1238. lappend ls_others "--exclude-from=$user_exclude"
  1239. }
  1240. set buf_rdi {}
  1241. set buf_rdf {}
  1242. set buf_rlo {}
  1243. set rescan_active 3
  1244. ui_status [mc "Scanning for modified files ..."]
  1245. set fd_di [git_read diff-index --cached -z [PARENT]]
  1246. set fd_df [git_read diff-files -z]
  1247. set fd_lo [eval git_read ls-files --others -z $ls_others]
  1248. fconfigure $fd_di -blocking 0 -translation binary -encoding binary
  1249. fconfigure $fd_df -blocking 0 -translation binary -encoding binary
  1250. fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
  1251. fileevent $fd_di readable [list read_diff_index $fd_di $after]
  1252. fileevent $fd_df readable [list read_diff_files $fd_df $after]
  1253. fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
  1254. }
  1255. proc load_message {file} {
  1256. global ui_comm
  1257. set f [gitdir $file]
  1258. if {[file isfile $f]} {
  1259. if {[catch {set fd [open $f r]}]} {
  1260. return 0
  1261. }
  1262. fconfigure $fd -eofchar {}
  1263. set content [string trim [read $fd]]
  1264. close $fd
  1265. regsub -all -line {[ \r\t]+$} $content {} content
  1266. $ui_comm delete 0.0 end
  1267. $ui_comm insert end $content
  1268. return 1
  1269. }
  1270. return 0
  1271. }
  1272. proc run_prepare_commit_msg_hook {} {
  1273. global pch_error
  1274. # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
  1275. # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
  1276. # empty file but existant file.
  1277. set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
  1278. if {[file isfile [gitdir MERGE_MSG]]} {
  1279. set pcm_source "merge"
  1280. set fd_mm [open [gitdir MERGE_MSG] r]
  1281. puts -nonewline $fd_pcm [read $fd_mm]
  1282. close $fd_mm
  1283. } elseif {[file isfile [gitdir SQUASH_MSG]]} {
  1284. set pcm_source "squash"
  1285. set fd_sm [open [gitdir SQUASH_MSG] r]
  1286. puts -nonewline $fd_pcm [read $fd_sm]
  1287. close $fd_sm
  1288. } else {
  1289. set pcm_source ""
  1290. }
  1291. close $fd_pcm
  1292. set fd_ph [githook_read prepare-commit-msg \
  1293. [gitdir PREPARE_COMMIT_MSG] $pcm_source]
  1294. if {$fd_ph eq {}} {
  1295. catch {file delete [gitdir PREPARE_COMMIT_MSG]}
  1296. return 0;
  1297. }
  1298. ui_status [mc "Calling prepare-commit-msg hook..."]
  1299. set pch_error {}
  1300. fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
  1301. fileevent $fd_ph readable \
  1302. [list prepare_commit_msg_hook_wait $fd_ph]
  1303. return 1;
  1304. }
  1305. proc prepare_commit_msg_hook_wait {fd_ph} {
  1306. global pch_error
  1307. append pch_error [read $fd_ph]
  1308. fconfigure $fd_ph -blocking 1
  1309. if {[eof $fd_ph]} {
  1310. if {[catch {close $fd_ph}]} {
  1311. ui_status [mc "Commit declined by prepare-commit-msg hook."]
  1312. hook_failed_popup prepare-commit-msg $pch_error
  1313. catch {file delete [gitdir PREPARE_COMMIT_MSG]}
  1314. exit 1
  1315. } else {
  1316. load_message PREPARE_COMMIT_MSG
  1317. }
  1318. set pch_error {}
  1319. catch {file delete [gitdir PREPARE_COMMIT_MSG]}
  1320. return
  1321. }
  1322. fconfigure $fd_ph -blocking 0
  1323. catch {file delete [gitdir PREPARE_COMMIT_MSG]}
  1324. }
  1325. proc read_diff_index {fd after} {
  1326. global buf_rdi
  1327. append buf_rdi [read $fd]
  1328. set c 0
  1329. set n [string length $buf_rdi]
  1330. while {$c < $n} {
  1331. set z1 [string first "\0" $buf_rdi $c]
  1332. if {$z1 == -1} break
  1333. incr z1
  1334. set z2 [string first "\0" $buf_rdi $z1]
  1335. if {$z2 == -1} break
  1336. incr c
  1337. set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
  1338. set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
  1339. merge_state \
  1340. [encoding convertfrom $p] \
  1341. [lindex $i 4]? \
  1342. [list [lindex $i 0] [lindex $i 2]] \
  1343. [list]
  1344. set c $z2
  1345. incr c
  1346. }
  1347. if {$c < $n} {
  1348. set buf_rdi [string range $buf_rdi $c end]
  1349. } else {
  1350. set buf_rdi {}
  1351. }
  1352. rescan_done $fd buf_rdi $after
  1353. }
  1354. proc read_diff_files {fd after} {
  1355. global buf_rdf
  1356. append buf_rdf [read $fd]
  1357. set c 0
  1358. set n [string length $buf_rdf]
  1359. while {$c < $n} {
  1360. set z1 [string first "\0" $buf_rdf $c]
  1361. if {$z1 == -1} break
  1362. incr z1
  1363. set z2 [string first "\0" $buf_rdf $z1]
  1364. if {$z2 == -1} break
  1365. incr c
  1366. set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
  1367. set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
  1368. merge_state \
  1369. [encoding convertfrom $p] \
  1370. ?[lindex $i 4] \
  1371. [list] \
  1372. [list [lindex $i 0] [lindex $i 2]]
  1373. set c $z2
  1374. incr c
  1375. }
  1376. if {$c < $n} {
  1377. set buf_rdf [string range $buf_rdf $c end]
  1378. } else {
  1379. set buf_rdf {}
  1380. }
  1381. rescan_done $fd buf_rdf $after
  1382. }
  1383. proc read_ls_others {fd after} {
  1384. global buf_rlo
  1385. append buf_rlo [read $fd]
  1386. set pck [split $buf_rlo "\0"]
  1387. set buf_rlo [lindex $pck end]
  1388. foreach p [lrange $pck 0 end-1] {
  1389. set p [encoding convertfrom $p]
  1390. if {[string index $p end] eq {/}} {
  1391. set p [string range $p 0 end-1]
  1392. }
  1393. merge_state $p ?O
  1394. }
  1395. rescan_done $fd buf_rlo $after
  1396. }
  1397. proc rescan_done {fd buf after} {
  1398. global rescan_active current_diff_path
  1399. global file_states repo_config
  1400. upvar $buf to_clear
  1401. if {![eof $fd]} return
  1402. set to_clear {}
  1403. close $fd
  1404. if {[incr rescan_active -1] > 0} return
  1405. prune_selection
  1406. unlock_index
  1407. display_all_files
  1408. if {$current_diff_path ne {}} { reshow_diff $after }
  1409. if {$current_diff_path eq {}} { select_first_diff $after }
  1410. }
  1411. proc prune_selection {} {
  1412. global file_states selected_paths
  1413. foreach path [array names selected_paths] {
  1414. if {[catch {set still_here $file_states($path)}]} {
  1415. unset selected_paths($path)
  1416. }
  1417. }
  1418. }
  1419. ######################################################################
  1420. ##
  1421. ## ui helpers
  1422. proc mapicon {w state path} {
  1423. global all_icons
  1424. if {[catch {set r $all_icons($state$w)}]} {
  1425. puts "error: no icon for $w state={$state} $path"
  1426. return file_plain
  1427. }
  1428. return $r
  1429. }
  1430. proc mapdesc {state path} {
  1431. global all_descs
  1432. if {[catch {set r $all_descs($state)}]} {
  1433. puts "error: no desc for state={$state} $path"
  1434. return $state
  1435. }
  1436. return $r
  1437. }
  1438. proc ui_status {msg} {
  1439. global main_status
  1440. if {[info exists main_status]} {
  1441. $main_status show $msg
  1442. }
  1443. }
  1444. proc ui_ready {{test {}}} {
  1445. global main_status
  1446. if {[info exists main_status]} {
  1447. $main_status show [mc "Ready."] $test
  1448. }
  1449. }
  1450. proc escape_path {path} {
  1451. regsub -all {\\} $path "\\\\" path
  1452. regsub -all "\n" $path "\\n" path
  1453. return $path
  1454. }
  1455. proc short_path {path} {
  1456. return [escape_path [lindex [file split $path] end]]
  1457. }
  1458. set next_icon_id 0
  1459. set null_sha1 [string repeat 0 40]
  1460. proc merge_state {path new_state {head_info {}} {index_info {}}} {
  1461. global file_states next_icon_id null_sha1
  1462. set s0 [string index $new_state 0]
  1463. set s1 [string index $new_state 1]
  1464. if {[catch {set info $file_states($path)}]} {
  1465. set state __
  1466. set icon n[incr next_icon_id]
  1467. } else {
  1468. set state [lindex $info 0]
  1469. set icon [lindex $info 1]
  1470. if {$head_info eq {}} {set head_info [lindex $info 2]}
  1471. if {$index_info eq {}} {set index_info [lindex $info 3]}
  1472. }
  1473. if {$s0 eq {?}} {set s0 [string index $state 0]} \
  1474. elseif {$s0 eq {_}} {set s0 _}
  1475. if {$s1 eq {?}} {set s1 [string index $state 1]} \
  1476. elseif {$s1 eq {_}} {set s1 _}
  1477. if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
  1478. set head_info [list 0 $null_sha1]
  1479. } elseif {$s0 ne {_} && [string index $state 0] eq {_}
  1480. && $head_info eq {}} {
  1481. set head_info $index_info
  1482. } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
  1483. set index_info $head_info
  1484. set head_info {}
  1485. }
  1486. set file_states($path) [list $s0$s1 $icon \
  1487. $head_info $index_info \
  1488. ]
  1489. return $state
  1490. }
  1491. proc display_file_helper {w path icon_name old_m new_m} {
  1492. global file_lists
  1493. if {$new_m eq {_}} {
  1494. set lno [lsearch -sorted -exact $file_lists($w) $path]
  1495. if {$lno >= 0} {
  1496. set file_lists($w) [lreplace $file_lists($w) $lno $lno]
  1497. incr lno
  1498. $w conf -state normal
  1499. $w delete $lno.0 [expr {$lno + 1}].0
  1500. $w conf -state disabled
  1501. }
  1502. } elseif {$old_m eq {_} && $new_m ne {_}} {
  1503. lappend file_lists($w) $path
  1504. set file_lists($w) [lsort -unique $file_lists($w)]
  1505. set lno [lsearch -sorted -exact $file_lists($w) $path]
  1506. incr lno
  1507. $w conf -state normal
  1508. $w image create $lno.0 \
  1509. -align center -padx 5 -pady 1 \
  1510. -name $icon_name \
  1511. -image [mapicon $w $new_m $path]
  1512. $w insert $lno.1 "[escape_path $path]\n"
  1513. $w conf -state disabled
  1514. } elseif {$old_m ne $new_m} {
  1515. $w conf -state normal
  1516. $w image conf $icon_name -image [mapicon $w $new_m $path]
  1517. $w conf -state disabled
  1518. }
  1519. }
  1520. proc display_file {path state} {
  1521. global file_states selected_paths
  1522. global ui_index ui_workdir
  1523. set old_m [merge_state $path $state]
  1524. set s $file_states($path)
  1525. set new_m [lindex $s 0]
  1526. set icon_name [lindex $s 1]
  1527. set o [string index $old_m 0]
  1528. set n [string index $new_m 0]
  1529. if {$o eq {U}} {
  1530. set o _
  1531. }
  1532. if {$n eq {U}} {
  1533. set n _
  1534. }
  1535. display_file_helper $ui_index $path $icon_name $o $n
  1536. if {[string index $old_m 0] eq {U}} {
  1537. set o U
  1538. } else {
  1539. set o [string index $old_m 1]
  1540. }
  1541. if {[string index $new_m 0] eq {U}} {
  1542. set n U
  1543. } else {
  1544. set n [string index $new_m 1]
  1545. }
  1546. display_file_helper $ui_workdir $path $icon_name $o $n
  1547. if {$new_m eq {__}} {
  1548. unset file_states($path)
  1549. catch {unset selected_paths($path)}
  1550. }
  1551. }
  1552. proc display_all_files_helper {w path icon_name m} {
  1553. global file_lists
  1554. lappend file_lists($w) $path
  1555. set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
  1556. $w image create end \
  1557. -align center -padx 5 -pady 1 \
  1558. -name $icon_name \
  1559. -image [mapicon $w $m $path]
  1560. $w insert end "[escape_path $path]\n"
  1561. }
  1562. set files_warning 0
  1563. proc display_all_files {} {
  1564. global ui_index ui_workdir
  1565. global file_states file_lists
  1566. global last_clicked
  1567. global files_warning
  1568. $ui_index conf -state normal
  1569. $ui_workdir conf -state normal
  1570. $ui_index delete 0.0 end
  1571. $ui_workdir delete 0.0 end
  1572. set last_clicked {}
  1573. set file_lists($ui_index) [list]
  1574. set file_lists($ui_workdir) [list]
  1575. set to_display [lsort [array names file_states]]
  1576. set display_limit [get_config gui.maxfilesdisplayed]
  1577. if {[llength $to_display] > $display_limit} {
  1578. if {!$files_warning} {
  1579. # do not repeatedly warn:
  1580. set files_warning 1
  1581. info_popup [mc "Displaying only %s of %s files." \
  1582. $display_limit [llength $to_display]]
  1583. }
  1584. set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
  1585. }
  1586. foreach path $to_display {
  1587. set s $file_states($path)
  1588. set m [lindex $s 0]
  1589. set icon_name [lindex $s 1]
  1590. set s [string index $m 0]
  1591. if {$s ne {U} && $s ne {_}} {
  1592. display_all_files_helper $ui_index $path \
  1593. $icon_name $s
  1594. }
  1595. if {[string index $m 0] eq {U}} {
  1596. set s U
  1597. } else {
  1598. set s [string index $m 1]
  1599. }
  1600. if {$s ne {_}} {
  1601. display_all_files_helper $ui_workdir $path \
  1602. $icon_name $s
  1603. }
  1604. }
  1605. $ui_index conf -state disabled
  1606. $ui_workdir conf -state disabled
  1607. }
  1608. ######################################################################
  1609. ##
  1610. ## icons
  1611. set filemask {
  1612. #define mask_width 14
  1613. #define mask_height 15
  1614. static unsigned char mask_bits[] = {
  1615. 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
  1616. 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
  1617. 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
  1618. }
  1619. image create bitmap file_plain -background white -foreground black -data {
  1620. #define plain_width 14
  1621. #define plain_height 15
  1622. static unsigned char plain_bits[] = {
  1623. 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
  1624. 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
  1625. 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
  1626. } -maskdata $filemask
  1627. image create bitmap file_mod -background white -foreground blue -data {
  1628. #define mod_width 14
  1629. #define mod_height 15
  1630. static unsigned char mod_bits[] = {
  1631. 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
  1632. 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
  1633. 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
  1634. } -maskdata $filemask
  1635. image create bitmap file_fulltick -background white -foreground "#007000" -data {
  1636. #define file_fulltick_width 14
  1637. #define file_fulltick_height 15
  1638. static unsigned char file_fulltick_bits[] = {
  1639. 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
  1640. 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
  1641. 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
  1642. } -maskdata $filemask
  1643. image create bitmap file_question -background white -foreground black -data {
  1644. #define file_question_width 14
  1645. #define file_question_height 15
  1646. static unsigned char file_question_bits[] = {
  1647. 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
  1648. 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
  1649. 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
  1650. } -maskdata $filemask
  1651. image create bitmap file_removed -background white -foreground red -data {
  1652. #define file_removed_width 14
  1653. #define file_removed_height 15
  1654. static unsigned char file_removed_bits[] = {
  1655. 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
  1656. 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
  1657. 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
  1658. } -maskdata $filemask
  1659. image create bitmap file_merge -background white -foreground blue -data {
  1660. #define file_merge_width 14
  1661. #define file_merge_height 15
  1662. static unsigned char file_merge_bits[] = {
  1663. 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
  1664. 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
  1665. 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
  1666. } -maskdata $filemask
  1667. image create bitmap file_statechange -background white -foreground green -data {
  1668. #define file_merge_width 14
  1669. #define file_merge_height 15
  1670. static unsigned char file_statechange_bits[] = {
  1671. 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
  1672. 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
  1673. 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
  1674. } -maskdata $filemask
  1675. set ui_index .vpane.files.index.list
  1676. set ui_workdir .vpane.files.workdir.list
  1677. set all_icons(_$ui_index) file_plain
  1678. set all_icons(A$ui_index) file_plain
  1679. set all_icons(M$ui_index) file_fulltick
  1680. set all_icons(D$ui_index) file_removed
  1681. set all_icons(U$ui_index) file_merge
  1682. set all_icons(T$ui_index) file_statechange
  1683. set all_icons(_$ui_workdir) file_plain
  1684. set all_icons(M$ui_workdir) file_mod
  1685. set all_icons(D$ui_workdir) file_question
  1686. set all_icons(U$ui_workdir) file_merge
  1687. set all_icons(O$ui_workdir) file_plain
  1688. set all_icons(T$ui_workdir) file_statechange
  1689. set max_status_desc 0
  1690. foreach i {
  1691. {__ {mc "Unmodified"}}
  1692. {_M {mc "Modified, not staged"}}
  1693. {M_ {mc "Staged for commit"}}
  1694. {MM {mc "Portions staged for commit"}}
  1695. {MD {mc "Staged for commit, missing"}}
  1696. {_T {mc "File type changed, not staged"}}
  1697. {T_ {mc "File type changed, staged"}}
  1698. {_O {mc "Untracked, not staged"}}
  1699. {A_ {mc "Staged for commit"}}
  1700. {AM {mc "Portions staged for commit"}}
  1701. {AD {mc "Staged for commit, missing"}}
  1702. {_D {mc "Missing"}}
  1703. {D_ {mc "Staged for removal"}}
  1704. {DO {mc "Staged for removal, still present"}}
  1705. {_U {mc "Requires merge resolution"}}
  1706. {U_ {mc "Requires merge resolution"}}
  1707. {UU {mc "Requires merge resolution"}}
  1708. {UM {mc "Requires merge resolution"}}
  1709. {UD {mc "Requires merge resolution"}}
  1710. {UT {mc "Requires merge resolution"}}
  1711. } {
  1712. set text [eval [lindex $i 1]]
  1713. if {$max_status_desc < [string length $text]} {
  1714. set max_status_desc [string length $text]
  1715. }
  1716. set all_descs([lindex $i 0]) $text
  1717. }
  1718. unset i
  1719. ######################################################################
  1720. ##
  1721. ## util
  1722. proc scrollbar2many {list mode args} {
  1723. foreach w $list {eval $w $mode $args}
  1724. }
  1725. proc many2scrollbar {list mode sb top bottom} {
  1726. $sb set $top $bottom
  1727. foreach w $list {$w $mode moveto $top}
  1728. }
  1729. proc incr_font_size {font {amt 1}} {
  1730. set sz [font configure $font -size]
  1731. incr sz $amt
  1732. font configure $font -size $sz
  1733. font configure ${font}bold -size $sz
  1734. font configure ${font}italic -size $sz
  1735. }
  1736. ######################################################################
  1737. ##
  1738. ## ui commands
  1739. set starting_gitk_msg [mc "Starting gitk... please wait..."]
  1740. proc do_gitk {revs {is_submodule false}} {
  1741. global current_diff_path file_states current_diff_side ui_index
  1742. global _gitdir _gitworktree
  1743. # -- Always start gitk through whatever we were loaded with. This
  1744. # lets us bypass using shell process on Windows systems.
  1745. #
  1746. set exe [_which gitk -script]
  1747. set cmd [list [info nameofexecutable] $exe]
  1748. if {$exe eq {}} {
  1749. error_popup [mc "Couldn't find gitk in PATH"]
  1750. } else {
  1751. global env
  1752. set pwd [pwd]
  1753. if {!$is_submodule} {
  1754. if {![is_bare]} {
  1755. cd $_gitworktree
  1756. }
  1757. } else {
  1758. cd $current_diff_path
  1759. if {$revs eq {--}} {
  1760. set s $file_states($current_diff_path)
  1761. set old_sha1 {}
  1762. set new_sha1 {}
  1763. switch -glob -- [lindex $s 0] {
  1764. M_ { set old_sha1 [lindex [lindex $s 2] 1] }
  1765. _M { set old_sha1 [lindex [lindex $s 3] 1] }
  1766. MM {
  1767. if {$current_diff_side eq $ui_index} {
  1768. set old_sha1 [lindex [lindex $s 2] 1]
  1769. set new_sha1 [lindex [lindex $s 3] 1]
  1770. } else {
  1771. set old_sha1 [lindex [lindex $s 3] 1]
  1772. }
  1773. }
  1774. }
  1775. set revs $old_sha1...$new_sha1
  1776. }
  1777. # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
  1778. # we've been using for the main repository, so unset them.
  1779. # TODO we could make life easier (start up faster?) for gitk
  1780. # by setting these to the appropriate values to allow gitk
  1781. # to skip the heuristics to find their proper value
  1782. unset env(GIT_DIR)
  1783. unset env(GIT_WORK_TREE)
  1784. }
  1785. eval exec $cmd $revs "--" "--" &
  1786. set env(GIT_DIR) $_gitdir
  1787. set env(GIT_WORK_TREE) $_gitworktree
  1788. cd $pwd
  1789. ui_status $::starting_gitk_msg
  1790. after 10000 {
  1791. ui_ready $starting_gitk_msg
  1792. }
  1793. }
  1794. }
  1795. proc do_git_gui {} {
  1796. global current_diff_path
  1797. # -- Always start git gui through whatever we were loaded with. This
  1798. # lets us bypass using shell process on Windows systems.
  1799. #
  1800. set exe [list [_which git]]
  1801. if {$exe eq {}} {
  1802. error_popup [mc "Couldn't find git gui in PATH"]
  1803. } else {
  1804. global env
  1805. global _gitdir _gitworktree
  1806. # see note in do_gitk about unsetting these vars when
  1807. # running tools in a submodule
  1808. unset env(GIT_DIR)
  1809. unset env(GIT_WORK_TREE)
  1810. set pwd [pwd]
  1811. cd $current_diff_path
  1812. eval exec $exe gui &
  1813. set env(GIT_DIR) $_gitdir
  1814. set env(GIT_WORK_TREE) $_gitworktree
  1815. cd $pwd
  1816. ui_status $::starting_gitk_msg
  1817. after 10000 {
  1818. ui_ready $starting_gitk_msg
  1819. }
  1820. }
  1821. }
  1822. proc do_explore {} {
  1823. global _gitworktree
  1824. set explorer {}
  1825. if {[is_Cygwin] || [is_Windows]} {
  1826. set explorer "explorer.exe"
  1827. } elseif {[is_MacOSX]} {
  1828. set explorer "open"
  1829. } else {
  1830. # freedesktop.org-conforming system is our best shot
  1831. set explorer "xdg-open"
  1832. }
  1833. eval exec $explorer [list [file nativename $_gitworktree]] &
  1834. }
  1835. set is_quitting 0
  1836. set ret_code 1
  1837. proc terminate_me {win} {
  1838. global ret_code
  1839. if {$win ne {.}} return
  1840. exit $ret_code
  1841. }
  1842. proc do_quit {{rc {1}}} {
  1843. global ui_comm is_quitting repo_config commit_type
  1844. global GITGUI_BCK_exists GITGUI_BCK_i
  1845. global ui_comm_spell
  1846. global ret_code use_ttk
  1847. if {$is_quitting} return
  1848. set is_quitting 1
  1849. if {[winfo exists $ui_comm]} {
  1850. # -- Stash our current commit buffer.
  1851. #
  1852. set save [gitdir GITGUI_MSG]
  1853. if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
  1854. file rename -force [gitdir GITGUI_BCK] $save
  1855. set GITGUI_BCK_exists 0
  1856. } else {
  1857. set msg [string trim [$ui_comm get 0.0 end]]
  1858. regsub -all -line {[ \r\t]+$} $msg {} msg
  1859. if {(![string match amend* $commit_type]
  1860. || [$ui_comm edit modified])
  1861. && $msg ne {}} {
  1862. catch {
  1863. set fd [open $save w]
  1864. puts -nonewline $fd $msg
  1865. close $fd
  1866. }
  1867. } else {
  1868. catch {file delete $save}
  1869. }
  1870. }
  1871. # -- Cancel our spellchecker if its running.
  1872. #
  1873. if {[info exists ui_comm_spell]} {
  1874. $ui_comm_spell stop
  1875. }
  1876. # -- Remove our editor backup, its not needed.
  1877. #
  1878. after

Large files files are truncated, but you can click here to view the full file