annotate mercurial-tests/testData/bin/contrib/hgk @ 1063:4b6661db8a8a Lakhnau-2020.2.x

TW-70509 prohibit creating VCS root with either repo name or branch name containing suspicicios options (grafted from 04407dc0f4967d24d53fe2a983afa4d11531684b)
author victory.bedrosova
date Thu, 11 Mar 2021 15:32:03 +0100
parents 2e52f00a3c94
children
rev   line source
294
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1 #!/usr/bin/env wish
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
4 # This program is free software; it may be used, copied, modified
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
5 # and distributed under the terms of the GNU General Public Licence,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
6 # either version 2, or (at your option) any later version.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
7 #
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
8 # See hgk.py for extension usage and configuration.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
9
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
11 # Modified version of Tip 171:
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
12 # http://www.tcl.tk/cgi-bin/tct/tip/171.html
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
13 #
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
14 # The in_mousewheel global was added to fix strange reentrancy issues.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
15 # The whole snipped is activated only under windows, mouse wheel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
16 # bindings working already under MacOSX and Linux.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
17
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
18 if {[tk windowingsystem] eq "win32"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
19
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
20 set mw_classes [list Text Listbox Table TreeCtrl]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
21 foreach class $mw_classes { bind $class <MouseWheel> {} }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
22
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
23 set in_mousewheel 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
24
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
25 proc ::tk::MouseWheel {wFired X Y D {shifted 0}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
26 global in_mousewheel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
27 if { $in_mousewheel != 0 } { return }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
28 # Set event to check based on call
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
29 set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
30 # do not double-fire in case the class already has a binding
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
31 if {[bind [winfo class $wFired] $evt] ne ""} { return }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
32 # obtain the window the mouse is over
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
33 set w [winfo containing $X $Y]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
34 # if we are outside the app, try and scroll the focus widget
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
35 if {![winfo exists $w]} { catch {set w [focus]} }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
36 if {[winfo exists $w]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
37
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
38 if {[bind $w $evt] ne ""} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
39 # Awkward ... this widget has a MouseWheel binding, but to
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
40 # trigger successfully in it, we must give it focus.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
41 catch {focus} old
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
42 if {$w ne $old} { focus $w }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
43 set in_mousewheel 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
44 event generate $w $evt -rootx $X -rooty $Y -delta $D
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
45 set in_mousewheel 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
46 if {$w ne $old} { focus $old }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
47 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
48 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
49
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
50 # aqua and x11/win32 have different delta handling
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
51 if {[tk windowingsystem] ne "aqua"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
52 set delta [expr {- ($D / 30)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
53 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
54 set delta [expr {- ($D)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
55 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
56 # scrollbars have different call conventions
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
57 if {[string match "*Scrollbar" [winfo class $w]]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
58 catch {tk::ScrollByUnits $w \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
59 [string index [$w cget -orient] 0] $delta}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
60 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
61 set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
62 scroll $delta units]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
63 # Walking up to find the proper widget (handles cases like
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
64 # embedded widgets in a canvas)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
65 while {[catch $cmd] && [winfo toplevel $w] ne $w} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
66 set w [winfo parent $w]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
67 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
68 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
69 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
70 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
71
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
72 bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
73
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
74 # end of win32 section
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
75 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
76
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
77
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
78 # Unify right mouse button handling.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
79 # See "mouse buttons on macintosh" thread on comp.lang.tcl
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
80 if {[tk windowingsystem] eq "aqua"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
81 event add <<B3>> <Control-ButtonPress-1>
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
82 event add <<B3>> <Button-2>
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
83 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
84 event add <<B3>> <Button-3>
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
85 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
86
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
87 proc gitdir {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
88 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
89 if {[info exists env(GIT_DIR)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
90 return $env(GIT_DIR)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
91 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
92 return ".hg"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
93 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
94 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
95
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
96 proc getcommits {rargs} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
97 global commits commfd phase canv mainfont env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
98 global startmsecs nextupdate ncmupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
99 global ctext maincursor textcursor leftover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
100
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
101 # check that we can find a .git directory somewhere...
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
102 set gitdir [gitdir]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
103 if {![file isdirectory $gitdir]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
104 error_popup "Cannot find the git directory \"$gitdir\"."
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
105 exit 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
106 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
107 set commits {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
108 set phase getcommits
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
109 set startmsecs [clock clicks -milliseconds]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
110 set nextupdate [expr $startmsecs + 100]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
111 set ncmupdate 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
112 set limit 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
113 set revargs {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
114 for {set i 0} {$i < [llength $rargs]} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
115 set opt [lindex $rargs $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
116 if {$opt == "--limit"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
117 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
118 set limit [lindex $rargs $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
119 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
120 lappend revargs $opt
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
121 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
122 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
123 if [catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
124 set parse_args [concat --default HEAD $revargs]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
125 set parse_temp [eval exec {$env(HG)} --config ui.report_untrusted=false debug-rev-parse $parse_args]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
126 regsub -all "\r\n" $parse_temp "\n" parse_temp
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
127 set parsed_args [split $parse_temp "\n"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
128 } err] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
129 # if git-rev-parse failed for some reason...
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
130 if {$rargs == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
131 set revargs HEAD
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
132 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
133 set parsed_args $revargs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
134 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
135 if {$limit > 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
136 set parsed_args [concat -n $limit $parsed_args]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
137 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
138 if [catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
139 set commfd [open "|{$env(HG)} --config ui.report_untrusted=false debug-rev-list --header --topo-order --parents $parsed_args" r]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
140 } err] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
141 puts stderr "Error executing hg debug-rev-list: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
142 exit 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
143 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
144 set leftover {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
145 fconfigure $commfd -blocking 0 -translation lf
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
146 fileevent $commfd readable [list getcommitlines $commfd]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
147 $canv delete all
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
148 $canv create text 3 3 -anchor nw -text "Reading commits..." \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
149 -font $mainfont -tags textitems
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
150 . config -cursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
151 settextcursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
152 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
153
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
154 proc getcommitlines {commfd} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
155 global commits parents cdate children
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
156 global commitlisted phase commitinfo nextupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
157 global stopped redisplaying leftover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
158
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
159 set stuff [read $commfd]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
160 if {$stuff == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
161 if {![eof $commfd]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
162 # set it blocking so we wait for the process to terminate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
163 fconfigure $commfd -blocking 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
164 if {![catch {close $commfd} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
165 after idle finishcommits
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
166 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
167 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
168 if {[string range $err 0 4] == "usage"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
169 set err \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
170 {Gitk: error reading commits: bad arguments to git-rev-list.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
171 (Note: arguments to gitk are passed to git-rev-list
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
172 to allow selection of commits to be displayed.)}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
173 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
174 set err "Error reading commits: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
175 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
176 error_popup $err
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
177 exit 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
178 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
179 set start 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
180 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
181 set i [string first "\0" $stuff $start]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
182 if {$i < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
183 append leftover [string range $stuff $start end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
184 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
185 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
186 set cmit [string range $stuff $start [expr {$i - 1}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
187 if {$start == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
188 set cmit "$leftover$cmit"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
189 set leftover {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
190 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
191 set start [expr {$i + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
192 regsub -all "\r\n" $cmit "\n" cmit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
193 set j [string first "\n" $cmit]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
194 set ok 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
195 if {$j >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
196 set ids [string range $cmit 0 [expr {$j - 1}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
197 set ok 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
198 foreach id $ids {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
199 if {![regexp {^[0-9a-f]{12}$} $id]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
200 set ok 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
201 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
202 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
203 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
204 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
205 if {!$ok} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
206 set shortcmit $cmit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
207 if {[string length $shortcmit] > 80} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
208 set shortcmit "[string range $shortcmit 0 80]..."
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
209 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
210 error_popup "Can't parse hg debug-rev-list output: {$shortcmit}"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
211 exit 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
212 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
213 set id [lindex $ids 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
214 set olds [lrange $ids 1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
215 set cmit [string range $cmit [expr {$j + 1}] end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
216 lappend commits $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
217 set commitlisted($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
218 parsecommit $id $cmit 1 [lrange $ids 1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
219 drawcommit $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
220 if {[clock clicks -milliseconds] >= $nextupdate} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
221 doupdate 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
222 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
223 while {$redisplaying} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
224 set redisplaying 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
225 if {$stopped == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
226 set stopped 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
227 set phase "getcommits"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
228 foreach id $commits {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
229 drawcommit $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
230 if {$stopped} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
231 if {[clock clicks -milliseconds] >= $nextupdate} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
232 doupdate 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
233 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
234 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
235 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
236 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
237 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
238 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
239
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
240 proc doupdate {reading} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
241 global commfd nextupdate numcommits ncmupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
242
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
243 if {$reading} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
244 fileevent $commfd readable {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
245 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
246 update
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
247 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
248 if {$numcommits < 100} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
249 set ncmupdate [expr {$numcommits + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
250 } elseif {$numcommits < 10000} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
251 set ncmupdate [expr {$numcommits + 10}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
252 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
253 set ncmupdate [expr {$numcommits + 100}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
254 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
255 if {$reading} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
256 fileevent $commfd readable [list getcommitlines $commfd]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
257 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
258 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
259
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
260 proc readcommit {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
261 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
262 if [catch {set contents [exec $env(HG) --config ui.report_untrusted=false debug-cat-file commit $id]}] return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
263 parsecommit $id $contents 0 {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
264 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
265
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
266 proc parsecommit {id contents listed olds} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
267 global commitinfo children nchildren parents nparents cdate ncleft
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
268 global firstparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
269
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
270 set inhdr 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
271 set comment {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
272 set headline {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
273 set auname {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
274 set audate {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
275 set comname {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
276 set comdate {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
277 set rev {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
278 set branch {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
279 if {![info exists nchildren($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
280 set children($id) {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
281 set nchildren($id) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
282 set ncleft($id) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
283 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
284 set parents($id) $olds
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
285 set nparents($id) [llength $olds]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
286 foreach p $olds {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
287 if {![info exists nchildren($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
288 set children($p) [list $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
289 set nchildren($p) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
290 set ncleft($p) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
291 } elseif {[lsearch -exact $children($p) $id] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
292 lappend children($p) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
293 incr nchildren($p)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
294 incr ncleft($p)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
295 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
296 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
297 regsub -all "\r\n" $contents "\n" contents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
298 foreach line [split $contents "\n"] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
299 if {$inhdr} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
300 set line [split $line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
301 if {$line == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
302 set inhdr 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
303 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
304 set tag [lindex $line 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
305 if {$tag == "author"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
306 set x [expr {[llength $line] - 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
307 set audate [lindex $line $x]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
308 set auname [join [lrange $line 1 [expr {$x - 1}]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
309 } elseif {$tag == "committer"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
310 set x [expr {[llength $line] - 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
311 set comdate [lindex $line $x]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
312 set comname [join [lrange $line 1 [expr {$x - 1}]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
313 } elseif {$tag == "revision"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
314 set rev [lindex $line 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
315 } elseif {$tag == "branch"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
316 set branch [join [lrange $line 1 end]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
317 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
318 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
319 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
320 if {$comment == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
321 set headline [string trim $line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
322 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
323 append comment "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
324 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
325 if {!$listed} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
326 # git-rev-list indents the comment by 4 spaces;
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
327 # if we got this via git-cat-file, add the indentation
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
328 append comment " "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
329 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
330 append comment $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
331 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
332 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
333 if {$audate != {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
334 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
335 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
336 if {$comdate != {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
337 set cdate($id) $comdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
338 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
339 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
340 set commitinfo($id) [list $headline $auname $audate \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
341 $comname $comdate $comment $rev $branch]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
342
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
343 if {[info exists firstparents]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
344 set i [lsearch $firstparents $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
345 if {$i != -1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
346 # remove the parent from firstparents, possible building
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
347 # an empty list
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
348 set firstparents [concat \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
349 [lrange $firstparents 0 [expr $i - 1]] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
350 [lrange $firstparents [expr $i + 1] end]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
351 if {$firstparents eq {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
352 # we have found all parents of the first changeset
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
353 # which means that we can safely select the first line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
354 after idle {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
355 selectline 0 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
356 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
357 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
358 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
359 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
360 # this is the first changeset, save the parents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
361 set firstparents $olds
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
362 if {$firstparents eq {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
363 # a repository with a single changeset
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
364 after idle {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
365 selectline 0 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
366 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
367 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
368 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
369 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
370
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
371 proc readrefs {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
372 global tagids idtags headids idheads tagcontents env curid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
373
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
374 set status [catch {exec $env(HG) --config ui.report_untrusted=false id} curid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
375 if { $status != 0 } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
376 puts $::errorInfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
377 if { ![string equal $::errorCode NONE] } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
378 exit 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
379 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
380 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
381 regexp -- {[[:xdigit:]]+} $curid curid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
382
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
383 set status [catch {exec $env(HG) --config ui.report_untrusted=false tags} tags]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
384 if { $status != 0 } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
385 puts $::errorInfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
386 if { ![string equal $::errorCode NONE] } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
387 exit 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
388 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
389 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
390 regsub -all "\r\n" $tags "\n" tags
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
391
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
392 set lines [split $tags "\n"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
393 foreach f $lines {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
394 regexp {(\S+)$} $f full
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
395 regsub {\s+(\S+)$} $f "" direct
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
396 set sha [split $full ':']
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
397 set tag [lindex $sha 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
398 lappend tagids($direct) $tag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
399 lappend idtags($tag) $direct
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
400 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
401
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
402 set status [catch {exec $env(HG) --config ui.report_untrusted=false heads} heads]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
403 if { $status != 0 } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
404 puts $::errorInfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
405 if { ![string equal $::errorCode NONE] } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
406 exit 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
407 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
408 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
409 regsub -all "\r\n" $heads "\n" heads
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
410
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
411 set lines [split $heads "\n"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
412 foreach f $lines {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
413 set match ""
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
414 regexp {changeset:\s+(\S+):(\S+)$} $f match id sha
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
415 if {$match != ""} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
416 lappend idheads($sha) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
417 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
418 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
419
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
420 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
421
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
422 proc readotherrefs {base dname excl} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
423 global otherrefids idotherrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
424
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
425 set git [gitdir]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
426 set files [glob -nocomplain -types f [file join $git $base *]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
427 foreach f $files {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
428 catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
429 set fd [open $f r]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
430 set line [read $fd 40]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
431 if {[regexp {^[0-9a-f]{12}} $line id]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
432 set name "$dname[file tail $f]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
433 set otherrefids($name) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
434 lappend idotherrefs($id) $name
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
435 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
436 close $fd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
437 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
438 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
439 set dirs [glob -nocomplain -types d [file join $git $base *]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
440 foreach d $dirs {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
441 set dir [file tail $d]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
442 if {[lsearch -exact $excl $dir] >= 0} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
443 readotherrefs [file join $base $dir] "$dname$dir/" {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
444 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
445 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
446
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
447 proc allcansmousewheel {delta} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
448 set delta [expr -5*(int($delta)/abs($delta))]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
449 allcanvs yview scroll $delta units
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
450 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
451
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
452 proc error_popup msg {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
453 set w .error
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
454 toplevel $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
455 wm transient $w .
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
456 message $w.m -text $msg -justify center -aspect 400
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
457 pack $w.m -side top -fill x -padx 20 -pady 20
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
458 button $w.ok -text OK -command "destroy $w"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
459 pack $w.ok -side bottom -fill x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
460 bind $w <Visibility> "grab $w; focus $w"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
461 tkwait window $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
462 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
463
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
464 proc makewindow {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
465 global canv canv2 canv3 linespc charspc ctext cflist textfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
466 global findtype findtypemenu findloc findstring fstring geometry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
467 global entries sha1entry sha1string sha1but
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
468 global maincursor textcursor curtextcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
469 global rowctxmenu gaudydiff mergemax
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
470 global hgvdiff bgcolor fgcolor diffremcolor diffaddcolor diffmerge1color
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
471 global diffmerge2color hunksepcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
472
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
473 menu .bar
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
474 .bar add cascade -label "File" -menu .bar.file
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
475 menu .bar.file
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
476 .bar.file add command -label "Reread references" -command rereadrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
477 .bar.file add command -label "Quit" -command doquit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
478 menu .bar.help
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
479 .bar add cascade -label "Help" -menu .bar.help
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
480 .bar.help add command -label "About gitk" -command about
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
481 . configure -menu .bar
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
482
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
483 if {![info exists geometry(canv1)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
484 set geometry(canv1) [expr 45 * $charspc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
485 set geometry(canv2) [expr 30 * $charspc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
486 set geometry(canv3) [expr 15 * $charspc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
487 set geometry(canvh) [expr 25 * $linespc + 4]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
488 set geometry(ctextw) 80
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
489 set geometry(ctexth) 30
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
490 set geometry(cflistw) 30
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
491 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
492 panedwindow .ctop -orient vertical
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
493 if {[info exists geometry(width)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
494 .ctop conf -width $geometry(width) -height $geometry(height)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
495 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
496 set geometry(ctexth) [expr {($texth - 8) /
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
497 [font metrics $textfont -linespace]}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
498 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
499 frame .ctop.top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
500 frame .ctop.top.bar
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
501 pack .ctop.top.bar -side bottom -fill x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
502 set cscroll .ctop.top.csb
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
503 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
504 pack $cscroll -side right -fill y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
505 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
506 pack .ctop.top.clist -side top -fill both -expand 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
507 .ctop add .ctop.top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
508 set canv .ctop.top.clist.canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
509 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
510 -bg $bgcolor -bd 0 \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
511 -yscrollincr $linespc -yscrollcommand "$cscroll set" -selectbackground grey
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
512 .ctop.top.clist add $canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
513 set canv2 .ctop.top.clist.canv2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
514 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
515 -bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground grey
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
516 .ctop.top.clist add $canv2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
517 set canv3 .ctop.top.clist.canv3
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
518 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
519 -bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground grey
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
520 .ctop.top.clist add $canv3
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
521 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
522
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
523 set sha1entry .ctop.top.bar.sha1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
524 set entries $sha1entry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
525 set sha1but .ctop.top.bar.sha1label
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
526 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
527 -command gotocommit -width 8
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
528 $sha1but conf -disabledforeground [$sha1but cget -foreground]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
529 pack .ctop.top.bar.sha1label -side left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
530 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
531 trace add variable sha1string write sha1change
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
532 pack $sha1entry -side left -pady 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
533
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
534 image create bitmap bm-left -data {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
535 #define left_width 16
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
536 #define left_height 16
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
537 static unsigned char left_bits[] = {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
538 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
539 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
540 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
541 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
542 image create bitmap bm-right -data {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
543 #define right_width 16
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
544 #define right_height 16
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
545 static unsigned char right_bits[] = {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
546 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
547 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
548 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
549 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
550 button .ctop.top.bar.leftbut -image bm-left -command goback \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
551 -state disabled -width 26
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
552 pack .ctop.top.bar.leftbut -side left -fill y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
553 button .ctop.top.bar.rightbut -image bm-right -command goforw \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
554 -state disabled -width 26
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
555 pack .ctop.top.bar.rightbut -side left -fill y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
556
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
557 button .ctop.top.bar.findbut -text "Find" -command dofind
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
558 pack .ctop.top.bar.findbut -side left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
559 set findstring {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
560 set fstring .ctop.top.bar.findstring
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
561 lappend entries $fstring
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
562 entry $fstring -width 30 -font $textfont -textvariable findstring
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
563 pack $fstring -side left -expand 1 -fill x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
564 set findtype Exact
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
565 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
566 findtype Exact IgnCase Regexp]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
567 set findloc "All fields"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
568 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
569 Comments Author Committer Files Pickaxe
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
570 pack .ctop.top.bar.findloc -side right
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
571 pack .ctop.top.bar.findtype -side right
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
572 # for making sure type==Exact whenever loc==Pickaxe
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
573 trace add variable findloc write findlocchange
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
574
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
575 panedwindow .ctop.cdet -orient horizontal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
576 .ctop add .ctop.cdet
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
577 frame .ctop.cdet.left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
578 set ctext .ctop.cdet.left.ctext
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
579 text $ctext -fg $fgcolor -bg $bgcolor -state disabled -font $textfont \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
580 -width $geometry(ctextw) -height $geometry(ctexth) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
581 -yscrollcommand ".ctop.cdet.left.sb set" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
582 -xscrollcommand ".ctop.cdet.left.hb set" -wrap none
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
583 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
584 scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
585 pack .ctop.cdet.left.sb -side right -fill y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
586 pack .ctop.cdet.left.hb -side bottom -fill x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
587 pack $ctext -side left -fill both -expand 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
588 .ctop.cdet add .ctop.cdet.left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
589
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
590 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
591 if {$gaudydiff} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
592 $ctext tag conf hunksep -back blue -fore white
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
593 $ctext tag conf d0 -back "#ff8080"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
594 $ctext tag conf d1 -back green
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
595 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
596 $ctext tag conf hunksep -fore $hunksepcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
597 $ctext tag conf d0 -fore $diffremcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
598 $ctext tag conf d1 -fore $diffaddcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
599
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
600 # The mX colours seem to be used in merge changesets, where m0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
601 # is first parent, m1 is second parent and so on. Git can have
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
602 # several parents, Hg cannot, so I think the m2..mmax would be
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
603 # unused.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
604 $ctext tag conf m0 -fore $diffmerge1color
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
605 $ctext tag conf m1 -fore $diffmerge2color
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
606 $ctext tag conf m2 -fore green
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
607 $ctext tag conf m3 -fore purple
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
608 $ctext tag conf m4 -fore brown
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
609 $ctext tag conf mmax -fore darkgrey
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
610 set mergemax 5
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
611 $ctext tag conf mresult -font [concat $textfont bold]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
612 $ctext tag conf msep -font [concat $textfont bold]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
613 $ctext tag conf found -back yellow
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
614 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
615
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
616 frame .ctop.cdet.right
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
617 set cflist .ctop.cdet.right.cfiles
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
618 listbox $cflist -fg $fgcolor -bg $bgcolor \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
619 -selectmode extended -width $geometry(cflistw) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
620 -yscrollcommand ".ctop.cdet.right.sb set"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
621 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
622 pack .ctop.cdet.right.sb -side right -fill y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
623 pack $cflist -side left -fill both -expand 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
624 .ctop.cdet add .ctop.cdet.right
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
625 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
626
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
627 pack .ctop -side top -fill both -expand 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
628
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
629 bindall <1> {selcanvline %W %x %y}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
630 #bindall <B1-Motion> {selcanvline %W %x %y}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
631 bindall <MouseWheel> "allcansmousewheel %D"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
632 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
633 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
634 bindall <2> "allcanvs scan mark 0 %y"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
635 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
636 bind . <Key-Up> "selnextline -1"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
637 bind . <Key-Down> "selnextline 1"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
638 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
639 bind . <Key-Next> "allcanvs yview scroll 1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
640 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
641 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
642 bindkey <Key-space> "$ctext yview scroll 1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
643 bindkey p "selnextline -1"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
644 bindkey n "selnextline 1"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
645 bindkey b "$ctext yview scroll -1 pages"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
646 bindkey d "$ctext yview scroll 18 units"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
647 bindkey u "$ctext yview scroll -18 units"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
648 bindkey / {findnext 1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
649 bindkey <Key-Return> {findnext 0}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
650 bindkey ? findprev
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
651 bindkey f nextfile
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
652 bind . <Control-q> doquit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
653 bind . <Control-w> doquit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
654 bind . <Control-f> dofind
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
655 bind . <Control-g> {findnext 0}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
656 bind . <Control-r> findprev
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
657 bind . <Control-equal> {incrfont 1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
658 bind . <Control-KP_Add> {incrfont 1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
659 bind . <Control-minus> {incrfont -1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
660 bind . <Control-KP_Subtract> {incrfont -1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
661 bind $cflist <<ListboxSelect>> listboxsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
662 bind . <Destroy> {savestuff %W}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
663 bind . <Button-1> "click %W"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
664 bind $fstring <Key-Return> dofind
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
665 bind $sha1entry <Key-Return> gotocommit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
666 bind $sha1entry <<PasteSelection>> clearsha1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
667
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
668 set maincursor [. cget -cursor]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
669 set textcursor [$ctext cget -cursor]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
670 set curtextcursor $textcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
671
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
672 set rowctxmenu .rowctxmenu
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
673 menu $rowctxmenu -tearoff 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
674 $rowctxmenu add command -label "Diff this -> selected" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
675 -command {diffvssel 0}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
676 $rowctxmenu add command -label "Diff selected -> this" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
677 -command {diffvssel 1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
678 $rowctxmenu add command -label "Make patch" -command mkpatch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
679 $rowctxmenu add command -label "Create tag" -command mktag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
680 $rowctxmenu add command -label "Write commit to file" -command writecommit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
681 if { $hgvdiff ne "" } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
682 $rowctxmenu add command -label "Visual diff with parent" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
683 -command {vdiff 1}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
684 $rowctxmenu add command -label "Visual diff with selected" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
685 -command {vdiff 0}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
686 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
687 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
688
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
689 # when we make a key binding for the toplevel, make sure
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
690 # it doesn't get triggered when that key is pressed in the
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
691 # find string entry widget.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
692 proc bindkey {ev script} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
693 global entries
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
694 bind . $ev $script
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
695 set escript [bind Entry $ev]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
696 if {$escript == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
697 set escript [bind Entry <Key>]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
698 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
699 foreach e $entries {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
700 bind $e $ev "$escript; break"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
701 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
702 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
703
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
704 # set the focus back to the toplevel for any click outside
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
705 # the entry widgets
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
706 proc click {w} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
707 global entries
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
708 foreach e $entries {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
709 if {$w == $e} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
710 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
711 focus .
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
712 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
713
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
714 proc savestuff {w} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
715 global canv canv2 canv3 ctext cflist mainfont textfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
716 global stuffsaved findmergefiles gaudydiff maxgraphpct
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
717 global maxwidth authorcolors curidfont bgcolor fgcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
718 global diffremcolor diffaddcolor hunksepcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
719 global diffmerge1color diffmerge2color
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
720
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
721 if {$stuffsaved} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
722 if {![winfo viewable .]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
723 catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
724 set f [open "~/.hgk-new" w]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
725 puts $f [list set mainfont $mainfont]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
726 puts $f [list set curidfont $curidfont]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
727 puts $f [list set textfont $textfont]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
728 puts $f [list set findmergefiles $findmergefiles]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
729 puts $f [list set gaudydiff $gaudydiff]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
730 puts $f [list set maxgraphpct $maxgraphpct]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
731 puts $f [list set maxwidth $maxwidth]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
732 puts $f "set geometry(width) [winfo width .ctop]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
733 puts $f "set geometry(height) [winfo height .ctop]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
734 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
735 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
736 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
737 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
738 set wid [expr {([winfo width $ctext] - 8) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
739 / [font measure $textfont "0"]}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
740 puts $f "set geometry(ctextw) $wid"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
741 set wid [expr {([winfo width $cflist] - 11) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
742 / [font measure [$cflist cget -font] "0"]}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
743 puts $f "set geometry(cflistw) $wid"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
744 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
745 puts $f "# authorcolors format:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
746 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
747 puts $f "# zero or more sublists of"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
748 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
749 puts $f "# { regex color }"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
750 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
751 puts $f "# followed by a list of colors"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
752 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
753 puts $f "# If the commit author matches a regex in a sublist,"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
754 puts $f "# the commit will be colored by that color"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
755 puts $f "# otherwise the next unused entry from the list of colors"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
756 puts $f "# will be assigned to this commit and also all other commits"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
757 puts $f "# of the same author. When the list of colors is exhausted,"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
758 puts $f "# the last entry will be reused."
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
759 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
760 puts $f "set authorcolors {$authorcolors}"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
761 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
762 puts $f "# The background color in the text windows"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
763 puts $f "set bgcolor $bgcolor"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
764 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
765 puts $f "# The text color used in the diff and file list view"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
766 puts $f "set fgcolor $fgcolor"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
767 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
768 puts $f "# Color to display + lines in diffs"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
769 puts $f "set diffaddcolor $diffaddcolor"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
770 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
771 puts $f "# Color to display - lines in diffs"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
772 puts $f "set diffremcolor $diffremcolor"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
773 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
774 puts $f "# Merge diffs: Color to signal lines from first parent"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
775 puts $f "set diffmerge1color $diffmerge1color"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
776 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
777 puts $f "# Merge diffs: Color to signal lines from second parent"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
778 puts $f "set diffmerge2color $diffmerge2color"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
779 puts $f "#"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
780 puts $f "# Hunkseparator (@@ -lineno,lines +lineno,lines @@) color"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
781 puts $f "set hunksepcolor $hunksepcolor"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
782 close $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
783 file rename -force "~/.hgk-new" "~/.hgk"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
784 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
785 set stuffsaved 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
786 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
787
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
788 proc resizeclistpanes {win w} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
789 global oldwidth
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
790 if [info exists oldwidth($win)] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
791 set s0 [$win sash coord 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
792 set s1 [$win sash coord 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
793 if {$w < 60} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
794 set sash0 [expr {int($w/2 - 2)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
795 set sash1 [expr {int($w*5/6 - 2)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
796 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
797 set factor [expr {1.0 * $w / $oldwidth($win)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
798 set sash0 [expr {int($factor * [lindex $s0 0])}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
799 set sash1 [expr {int($factor * [lindex $s1 0])}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
800 if {$sash0 < 30} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
801 set sash0 30
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
802 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
803 if {$sash1 < $sash0 + 20} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
804 set sash1 [expr $sash0 + 20]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
805 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
806 if {$sash1 > $w - 10} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
807 set sash1 [expr $w - 10]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
808 if {$sash0 > $sash1 - 20} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
809 set sash0 [expr $sash1 - 20]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
810 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
811 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
812 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
813 $win sash place 0 $sash0 [lindex $s0 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
814 $win sash place 1 $sash1 [lindex $s1 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
815 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
816 set oldwidth($win) $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
817 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
818
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
819 proc resizecdetpanes {win w} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
820 global oldwidth
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
821 if [info exists oldwidth($win)] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
822 set s0 [$win sash coord 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
823 if {$w < 60} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
824 set sash0 [expr {int($w*3/4 - 2)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
825 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
826 set factor [expr {1.0 * $w / $oldwidth($win)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
827 set sash0 [expr {int($factor * [lindex $s0 0])}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
828 if {$sash0 < 45} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
829 set sash0 45
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
830 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
831 if {$sash0 > $w - 15} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
832 set sash0 [expr $w - 15]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
833 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
834 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
835 $win sash place 0 $sash0 [lindex $s0 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
836 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
837 set oldwidth($win) $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
838 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
839
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
840 proc allcanvs args {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
841 global canv canv2 canv3
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
842 eval $canv $args
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
843 eval $canv2 $args
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
844 eval $canv3 $args
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
845 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
846
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
847 proc bindall {event action} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
848 global canv canv2 canv3
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
849 bind $canv $event $action
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
850 bind $canv2 $event $action
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
851 bind $canv3 $event $action
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
852 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
853
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
854 proc about {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
855 set w .about
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
856 if {[winfo exists $w]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
857 raise $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
858 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
859 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
860 toplevel $w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
861 wm title $w "About gitk"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
862 message $w.m -text {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
863 Gitk version 1.2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
864
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
865 Copyright © 2005 Paul Mackerras
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
866
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
867 Use and redistribute under the terms of the GNU General Public License} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
868 -justify center -aspect 400
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
869 pack $w.m -side top -fill x -padx 20 -pady 20
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
870 button $w.ok -text Close -command "destroy $w"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
871 pack $w.ok -side bottom
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
872 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
873
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
874 set aunextcolor 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
875 proc assignauthorcolor {name} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
876 global authorcolors aucolormap aunextcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
877 if [info exists aucolormap($name)] return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
878
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
879 set randomcolors {black}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
880 for {set i 0} {$i < [llength $authorcolors]} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
881 set col [lindex $authorcolors $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
882 if {[llength $col] > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
883 set re [lindex $col 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
884 set c [lindex $col 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
885 if {[regexp -- $re $name]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
886 set aucolormap($name) $c
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
887 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
888 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
889 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
890 set randomcolors [lrange $authorcolors $i end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
891 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
892 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
893 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
894
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
895 set ncolors [llength $randomcolors]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
896 set c [lindex $randomcolors $aunextcolor]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
897 if {[incr aunextcolor] >= $ncolors} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
898 incr aunextcolor -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
899 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
900 set aucolormap($name) $c
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
901 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
902
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
903 proc assigncolor {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
904 global commitinfo colormap commcolors colors nextcolor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
905 global parents nparents children nchildren
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
906 global cornercrossings crossings
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
907
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
908 if [info exists colormap($id)] return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
909 set ncolors [llength $colors]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
910 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
911 set child [lindex $children($id) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
912 if {[info exists colormap($child)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
913 && $nparents($child) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
914 set colormap($id) $colormap($child)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
915 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
916 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
917 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
918 set badcolors {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
919 if {[info exists cornercrossings($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
920 foreach x $cornercrossings($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
921 if {[info exists colormap($x)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
922 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
923 lappend badcolors $colormap($x)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
924 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
925 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
926 if {[llength $badcolors] >= $ncolors} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
927 set badcolors {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
928 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
929 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
930 set origbad $badcolors
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
931 if {[llength $badcolors] < $ncolors - 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
932 if {[info exists crossings($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
933 foreach x $crossings($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
934 if {[info exists colormap($x)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
935 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
936 lappend badcolors $colormap($x)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
937 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
938 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
939 if {[llength $badcolors] >= $ncolors} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
940 set badcolors $origbad
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
941 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
942 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
943 set origbad $badcolors
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
944 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
945 if {[llength $badcolors] < $ncolors - 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
946 foreach child $children($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
947 if {[info exists colormap($child)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
948 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
949 lappend badcolors $colormap($child)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
950 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
951 if {[info exists parents($child)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
952 foreach p $parents($child) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
953 if {[info exists colormap($p)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
954 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
955 lappend badcolors $colormap($p)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
956 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
957 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
958 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
959 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
960 if {[llength $badcolors] >= $ncolors} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
961 set badcolors $origbad
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
962 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
963 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
964 for {set i 0} {$i <= $ncolors} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
965 set c [lindex $colors $nextcolor]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
966 if {[incr nextcolor] >= $ncolors} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
967 set nextcolor 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
968 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
969 if {[lsearch -exact $badcolors $c]} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
970 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
971 set colormap($id) $c
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
972 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
973
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
974 proc initgraph {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
975 global canvy canvy0 lineno numcommits nextcolor linespc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
976 global mainline mainlinearrow sidelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
977 global nchildren ncleft
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
978 global displist nhyperspace
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
979
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
980 allcanvs delete all
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
981 set nextcolor 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
982 set canvy $canvy0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
983 set lineno -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
984 set numcommits 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
985 catch {unset mainline}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
986 catch {unset mainlinearrow}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
987 catch {unset sidelines}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
988 foreach id [array names nchildren] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
989 set ncleft($id) $nchildren($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
990 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
991 set displist {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
992 set nhyperspace 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
993 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
994
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
995 proc bindline {t id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
996 global canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
997
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
998 $canv bind $t <Enter> "lineenter %x %y $id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
999 $canv bind $t <Motion> "linemotion %x %y $id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1000 $canv bind $t <Leave> "lineleave $id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1001 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1002 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1003
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1004 proc drawlines {id xtra} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1005 global mainline mainlinearrow sidelines lthickness colormap canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1006
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1007 $canv delete lines.$id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1008 if {[info exists mainline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1009 set t [$canv create line $mainline($id) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1010 -width [expr {($xtra + 1) * $lthickness}] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1011 -fill $colormap($id) -tags lines.$id \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1012 -arrow $mainlinearrow($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1013 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1014 bindline $t $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1015 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1016 if {[info exists sidelines($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1017 foreach ls $sidelines($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1018 set coords [lindex $ls 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1019 set thick [lindex $ls 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1020 set arrow [lindex $ls 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1021 set t [$canv create line $coords -fill $colormap($id) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1022 -width [expr {($thick + $xtra) * $lthickness}] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1023 -arrow $arrow -tags lines.$id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1024 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1025 bindline $t $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1026 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1027 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1028 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1029
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1030 # level here is an index in displist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1031 proc drawcommitline {level} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1032 global parents children nparents displist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1033 global canv canv2 canv3 mainfont namefont canvy linespc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1034 global lineid linehtag linentag linedtag commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1035 global colormap numcommits currentparents dupparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1036 global idtags idline idheads idotherrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1037 global lineno lthickness mainline mainlinearrow sidelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1038 global commitlisted rowtextx idpos lastuse displist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1039 global oldnlines olddlevel olddisplist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1040 global aucolormap curid curidfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1041
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1042 incr numcommits
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1043 incr lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1044 set id [lindex $displist $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1045 set lastuse($id) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1046 set lineid($lineno) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1047 set idline($id) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1048 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1049 if {![info exists commitinfo($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1050 readcommit $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1051 if {![info exists commitinfo($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1052 set commitinfo($id) {"No commit information available"}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1053 set nparents($id) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1054 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1055 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1056 assigncolor $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1057 set currentparents {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1058 set dupparents {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1059 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1060 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1061 if {[lsearch -exact $currentparents $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1062 lappend currentparents $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1063 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1064 # remember that this parent was listed twice
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1065 lappend dupparents $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1066 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1067 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1068 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1069 set x [xcoord $level $level $lineno]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1070 set y1 $canvy
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1071 set canvy [expr $canvy + $linespc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1072 allcanvs conf -scrollregion \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1073 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1074 if {[info exists mainline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1075 lappend mainline($id) $x $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1076 if {$mainlinearrow($id) ne "none"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1077 set mainline($id) [trimdiagstart $mainline($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1078 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1079 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1080 drawlines $id 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1081 set orad [expr {$linespc / 3}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1082 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1083 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1084 -fill $ofill -outline black -width 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1085 $canv raise $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1086 $canv bind $t <1> {selcanvline {} %x %y}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1087 set xt [xcoord [llength $displist] $level $lineno]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1088 if {[llength $currentparents] > 2} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1089 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1090 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1091 set rowtextx($lineno) $xt
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1092 set idpos($id) [list $x $xt $y1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1093 if {[info exists idtags($id)] || [info exists idheads($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1094 || [info exists idotherrefs($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1095 set xt [drawtags $id $x $xt $y1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1096 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1097 set headline [lindex $commitinfo($id) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1098 set name [lindex $commitinfo($id) 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1099 assignauthorcolor $name
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1100 set fg $aucolormap($name)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1101 if {$id == $curid} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1102 set fn $curidfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1103 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1104 set fn $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1105 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1106
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1107 set date [lindex $commitinfo($id) 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1108 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1109 -text $headline -font $fn \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1110 -fill $fg]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1111 $canv bind $linehtag($lineno) <<B3>> "rowmenu %X %Y $id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1112 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1113 -text $name -font $namefont \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1114 -fill $fg]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1115 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1116 -text $date -font $mainfont \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1117 -fill $fg]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1118
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1119 set olddlevel $level
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1120 set olddisplist $displist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1121 set oldnlines [llength $displist]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1122 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1123
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1124 proc drawtags {id x xt y1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1125 global idtags idheads idotherrefs commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1126 global linespc lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1127 global canv mainfont idline rowtextx
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1128
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1129 set marks {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1130 set ntags 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1131 set nheads 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1132 if {[info exists idtags($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1133 set marks $idtags($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1134 set ntags [llength $marks]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1135 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1136 if {[info exists idheads($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1137 set headmark [lindex $commitinfo($id) 7]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1138 if {$headmark ne "default"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1139 lappend marks $headmark
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1140 set nheads 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1141 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1142 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1143 if {[info exists idotherrefs($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1144 set marks [concat $marks $idotherrefs($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1145 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1146 if {$marks eq {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1147 return $xt
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1148 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1149
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1150 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1151 set yt [expr $y1 - 0.5 * $linespc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1152 set yb [expr $yt + $linespc - 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1153 set xvals {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1154 set wvals {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1155 foreach tag $marks {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1156 set wid [font measure $mainfont $tag]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1157 lappend xvals $xt
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1158 lappend wvals $wid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1159 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1160 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1161 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1162 -width $lthickness -fill black -tags tag.$id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1163 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1164 foreach tag $marks x $xvals wid $wvals {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1165 set xl [expr $x + $delta]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1166 set xr [expr $x + $delta + $wid + $lthickness]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1167 if {[incr ntags -1] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1168 # draw a tag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1169 set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1170 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1171 -width 1 -outline black -fill yellow -tags tag.$id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1172 $canv bind $t <1> [list showtag $tag 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1173 set rowtextx($idline($id)) [expr {$xr + $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1174 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1175 # draw a head or other ref
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1176 if {[incr nheads -1] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1177 set col green
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1178 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1179 set col "#ddddff"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1180 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1181 set xl [expr $xl - $delta/2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1182 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1183 -width 1 -outline black -fill $col -tags tag.$id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1184 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1185 set t [$canv create text $xl $y1 -anchor w -text $tag \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1186 -font $mainfont -tags tag.$id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1187 if {$ntags >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1188 $canv bind $t <1> [list showtag $tag 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1189 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1190 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1191 return $xt
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1192 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1193
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1194 proc notecrossings {id lo hi corner} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1195 global olddisplist crossings cornercrossings
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1196
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1197 for {set i $lo} {[incr i] < $hi} {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1198 set p [lindex $olddisplist $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1199 if {$p == {}} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1200 if {$i == $corner} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1201 if {![info exists cornercrossings($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1202 || [lsearch -exact $cornercrossings($id) $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1203 lappend cornercrossings($id) $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1204 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1205 if {![info exists cornercrossings($p)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1206 || [lsearch -exact $cornercrossings($p) $id] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1207 lappend cornercrossings($p) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1208 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1209 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1210 if {![info exists crossings($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1211 || [lsearch -exact $crossings($id) $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1212 lappend crossings($id) $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1213 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1214 if {![info exists crossings($p)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1215 || [lsearch -exact $crossings($p) $id] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1216 lappend crossings($p) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1217 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1218 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1219 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1220 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1221
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1222 proc xcoord {i level ln} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1223 global canvx0 xspc1 xspc2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1224
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1225 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1226 if {$i > 0 && $i == $level} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1227 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1228 } elseif {$i > $level} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1229 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1230 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1231 return $x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1232 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1233
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1234 # it seems Tk can't draw arrows on the end of diagonal line segments...
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1235 proc trimdiagend {line} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1236 while {[llength $line] > 4} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1237 set x1 [lindex $line end-3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1238 set y1 [lindex $line end-2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1239 set x2 [lindex $line end-1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1240 set y2 [lindex $line end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1241 if {($x1 == $x2) != ($y1 == $y2)} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1242 set line [lreplace $line end-1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1243 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1244 return $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1245 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1246
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1247 proc trimdiagstart {line} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1248 while {[llength $line] > 4} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1249 set x1 [lindex $line 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1250 set y1 [lindex $line 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1251 set x2 [lindex $line 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1252 set y2 [lindex $line 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1253 if {($x1 == $x2) != ($y1 == $y2)} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1254 set line [lreplace $line 0 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1255 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1256 return $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1257 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1258
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1259 proc drawslants {id needonscreen nohs} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1260 global canv mainline mainlinearrow sidelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1261 global canvx0 canvy xspc1 xspc2 lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1262 global currentparents dupparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1263 global lthickness linespc canvy colormap lineno geometry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1264 global maxgraphpct maxwidth
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1265 global displist onscreen lastuse
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1266 global parents commitlisted
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1267 global oldnlines olddlevel olddisplist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1268 global nhyperspace numcommits nnewparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1269
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1270 if {$lineno < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1271 lappend displist $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1272 set onscreen($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1273 return 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1274 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1275
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1276 set y1 [expr {$canvy - $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1277 set y2 $canvy
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1278
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1279 # work out what we need to get back on screen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1280 set reins {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1281 if {$onscreen($id) < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1282 # next to do isn't displayed, better get it on screen...
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1283 lappend reins [list $id 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1284 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1285 # make sure all the previous commits's parents are on the screen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1286 foreach p $currentparents {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1287 if {$onscreen($p) < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1288 lappend reins [list $p 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1289 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1290 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1291 # bring back anything requested by caller
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1292 if {$needonscreen ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1293 lappend reins $needonscreen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1294 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1295
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1296 # try the shortcut
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1297 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1298 set dlevel $olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1299 set x [xcoord $dlevel $dlevel $lineno]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1300 set mainline($id) [list $x $y1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1301 set mainlinearrow($id) none
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1302 set lastuse($id) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1303 set displist [lreplace $displist $dlevel $dlevel $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1304 set onscreen($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1305 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1306 return $dlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1307 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1308
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1309 # update displist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1310 set displist [lreplace $displist $olddlevel $olddlevel]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1311 set j $olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1312 foreach p $currentparents {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1313 set lastuse($p) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1314 if {$onscreen($p) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1315 set displist [linsert $displist $j $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1316 set onscreen($p) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1317 incr j
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1318 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1319 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1320 if {$onscreen($id) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1321 lappend displist $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1322 set onscreen($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1323 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1324
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1325 # remove the null entry if present
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1326 set nullentry [lsearch -exact $displist {}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1327 if {$nullentry >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1328 set displist [lreplace $displist $nullentry $nullentry]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1329 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1330
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1331 # bring back the ones we need now (if we did it earlier
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1332 # it would change displist and invalidate olddlevel)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1333 foreach pi $reins {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1334 # test again in case of duplicates in reins
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1335 set p [lindex $pi 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1336 if {$onscreen($p) < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1337 set onscreen($p) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1338 set lastuse($p) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1339 set displist [linsert $displist [lindex $pi 1] $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1340 incr nhyperspace -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1341 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1342 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1343
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1344 set lastuse($id) $lineno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1345
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1346 # see if we need to make any lines jump off into hyperspace
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1347 set displ [llength $displist]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1348 if {$displ > $maxwidth} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1349 set ages {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1350 foreach x $displist {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1351 lappend ages [list $lastuse($x) $x]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1352 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1353 set ages [lsort -integer -index 0 $ages]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1354 set k 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1355 while {$displ > $maxwidth} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1356 set use [lindex $ages $k 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1357 set victim [lindex $ages $k 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1358 if {$use >= $lineno - 5} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1359 incr k
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1360 if {[lsearch -exact $nohs $victim] >= 0} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1361 set i [lsearch -exact $displist $victim]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1362 set displist [lreplace $displist $i $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1363 set onscreen($victim) -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1364 incr nhyperspace
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1365 incr displ -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1366 if {$i < $nullentry} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1367 incr nullentry -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1368 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1369 set x [lindex $mainline($victim) end-1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1370 lappend mainline($victim) $x $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1371 set line [trimdiagend $mainline($victim)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1372 set arrow "last"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1373 if {$mainlinearrow($victim) ne "none"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1374 set line [trimdiagstart $line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1375 set arrow "both"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1376 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1377 lappend sidelines($victim) [list $line 1 $arrow]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1378 unset mainline($victim)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1379 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1380 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1381
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1382 set dlevel [lsearch -exact $displist $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1383
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1384 # If we are reducing, put in a null entry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1385 if {$displ < $oldnlines} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1386 # does the next line look like a merge?
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1387 # i.e. does it have > 1 new parent?
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1388 if {$nnewparents($id) > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1389 set i [expr {$dlevel + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1390 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1391 set i $olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1392 if {$nullentry >= 0 && $nullentry < $i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1393 incr i -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1394 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1395 } elseif {$nullentry >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1396 set i $nullentry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1397 while {$i < $displ
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1398 && [lindex $olddisplist $i] == [lindex $displist $i]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1399 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1400 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1401 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1402 set i $olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1403 if {$dlevel >= $i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1404 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1405 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1406 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1407 if {$i < $displ} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1408 set displist [linsert $displist $i {}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1409 incr displ
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1410 if {$dlevel >= $i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1411 incr dlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1412 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1413 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1414 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1415
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1416 # decide on the line spacing for the next line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1417 set lj [expr {$lineno + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1418 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1419 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1420 set xspc1($lj) $xspc2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1421 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1422 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1423 if {$xspc1($lj) < $lthickness} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1424 set xspc1($lj) $lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1425 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1426 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1427
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1428 foreach idi $reins {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1429 set id [lindex $idi 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1430 set j [lsearch -exact $displist $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1431 set xj [xcoord $j $dlevel $lj]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1432 set mainline($id) [list $xj $y2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1433 set mainlinearrow($id) first
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1434 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1435
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1436 set i -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1437 foreach id $olddisplist {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1438 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1439 if {$id == {}} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1440 if {$onscreen($id) <= 0} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1441 set xi [xcoord $i $olddlevel $lineno]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1442 if {$i == $olddlevel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1443 foreach p $currentparents {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1444 set j [lsearch -exact $displist $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1445 set coords [list $xi $y1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1446 set xj [xcoord $j $dlevel $lj]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1447 if {$xj < $xi - $linespc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1448 lappend coords [expr {$xj + $linespc}] $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1449 notecrossings $p $j $i [expr {$j + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1450 } elseif {$xj > $xi + $linespc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1451 lappend coords [expr {$xj - $linespc}] $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1452 notecrossings $p $i $j [expr {$j - 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1453 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1454 if {[lsearch -exact $dupparents $p] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1455 # draw a double-width line to indicate the doubled parent
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1456 lappend coords $xj $y2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1457 lappend sidelines($p) [list $coords 2 none]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1458 if {![info exists mainline($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1459 set mainline($p) [list $xj $y2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1460 set mainlinearrow($p) none
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1461 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1462 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1463 # normal case, no parent duplicated
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1464 set yb $y2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1465 set dx [expr {abs($xi - $xj)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1466 if {0 && $dx < $linespc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1467 set yb [expr {$y1 + $dx}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1468 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1469 if {![info exists mainline($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1470 if {$xi != $xj} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1471 lappend coords $xj $yb
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1472 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1473 set mainline($p) $coords
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1474 set mainlinearrow($p) none
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1475 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1476 lappend coords $xj $yb
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1477 if {$yb < $y2} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1478 lappend coords $xj $y2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1479 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1480 lappend sidelines($p) [list $coords 1 none]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1481 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1482 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1483 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1484 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1485 set j $i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1486 if {[lindex $displist $i] != $id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1487 set j [lsearch -exact $displist $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1488 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1489 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1490 || ($olddlevel < $i && $i < $dlevel)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1491 || ($dlevel < $i && $i < $olddlevel)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1492 set xj [xcoord $j $dlevel $lj]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1493 lappend mainline($id) $xi $y1 $xj $y2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1494 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1495 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1496 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1497 return $dlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1498 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1499
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1500 # search for x in a list of lists
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1501 proc llsearch {llist x} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1502 set i 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1503 foreach l $llist {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1504 if {$l == $x || [lsearch -exact $l $x] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1505 return $i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1506 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1507 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1508 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1509 return -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1510 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1511
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1512 proc drawmore {reading} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1513 global displayorder numcommits ncmupdate nextupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1514 global stopped nhyperspace parents commitlisted
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1515 global maxwidth onscreen displist currentparents olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1516
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1517 set n [llength $displayorder]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1518 while {$numcommits < $n} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1519 set id [lindex $displayorder $numcommits]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1520 set ctxend [expr {$numcommits + 10}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1521 if {!$reading && $ctxend > $n} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1522 set ctxend $n
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1523 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1524 set dlist {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1525 if {$numcommits > 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1526 set dlist [lreplace $displist $olddlevel $olddlevel]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1527 set i $olddlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1528 foreach p $currentparents {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1529 if {$onscreen($p) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1530 set dlist [linsert $dlist $i $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1531 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1532 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1533 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1534 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1535 set nohs {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1536 set reins {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1537 set isfat [expr {[llength $dlist] > $maxwidth}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1538 if {$nhyperspace > 0 || $isfat} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1539 if {$ctxend > $n} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1540 # work out what to bring back and
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1541 # what we want to don't want to send into hyperspace
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1542 set room 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1543 for {set k $numcommits} {$k < $ctxend} {incr k} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1544 set x [lindex $displayorder $k]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1545 set i [llsearch $dlist $x]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1546 if {$i < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1547 set i [llength $dlist]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1548 lappend dlist $x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1549 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1550 if {[lsearch -exact $nohs $x] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1551 lappend nohs $x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1552 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1553 if {$reins eq {} && $onscreen($x) < 0 && $room} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1554 set reins [list $x $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1555 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1556 set newp {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1557 if {[info exists commitlisted($x)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1558 set right 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1559 foreach p $parents($x) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1560 if {[llsearch $dlist $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1561 lappend newp $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1562 if {[lsearch -exact $nohs $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1563 lappend nohs $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1564 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1565 if {$reins eq {} && $onscreen($p) < 0 && $room} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1566 set reins [list $p [expr {$i + $right}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1567 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1568 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1569 set right 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1570 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1571 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1572 set l [lindex $dlist $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1573 if {[llength $l] == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1574 set l $newp
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1575 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1576 set j [lsearch -exact $l $x]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1577 set l [concat [lreplace $l $j $j] $newp]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1578 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1579 set dlist [lreplace $dlist $i $i $l]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1580 if {$room && $isfat && [llength $newp] <= 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1581 set room 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1582 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1583 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1584 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1585
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1586 set dlevel [drawslants $id $reins $nohs]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1587 drawcommitline $dlevel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1588 if {[clock clicks -milliseconds] >= $nextupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1589 && $numcommits >= $ncmupdate} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1590 doupdate $reading
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1591 if {$stopped} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1592 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1593 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1594 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1595
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1596 # level here is an index in todo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1597 proc updatetodo {level noshortcut} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1598 global ncleft todo nnewparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1599 global commitlisted parents onscreen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1600
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1601 set id [lindex $todo $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1602 set olds {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1603 if {[info exists commitlisted($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1604 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1605 if {[lsearch -exact $olds $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1606 lappend olds $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1607 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1608 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1609 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1610 if {!$noshortcut && [llength $olds] == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1611 set p [lindex $olds 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1612 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1613 set ncleft($p) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1614 set todo [lreplace $todo $level $level $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1615 set onscreen($p) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1616 set nnewparents($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1617 return 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1618 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1619 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1620
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1621 set todo [lreplace $todo $level $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1622 set i $level
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1623 set n 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1624 foreach p $olds {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1625 incr ncleft($p) -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1626 set k [lsearch -exact $todo $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1627 if {$k < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1628 set todo [linsert $todo $i $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1629 set onscreen($p) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1630 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1631 incr n
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1632 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1633 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1634 set nnewparents($id) $n
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1635
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1636 return 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1637 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1638
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1639 proc decidenext {{noread 0}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1640 global ncleft todo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1641 global datemode cdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1642 global commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1643
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1644 # choose which one to do next time around
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1645 set todol [llength $todo]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1646 set level -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1647 set latest {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1648 for {set k $todol} {[incr k -1] >= 0} {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1649 set p [lindex $todo $k]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1650 if {$ncleft($p) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1651 if {$datemode} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1652 if {![info exists commitinfo($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1653 if {$noread} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1654 return {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1655 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1656 readcommit $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1657 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1658 if {$latest == {} || $cdate($p) > $latest} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1659 set level $k
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1660 set latest $cdate($p)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1661 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1662 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1663 set level $k
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1664 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1665 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1666 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1667 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1668 if {$level < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1669 if {$todo != {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1670 puts "ERROR: none of the pending commits can be done yet:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1671 foreach p $todo {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1672 puts " $p ($ncleft($p))"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1673 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1674 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1675 return -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1676 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1677
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1678 return $level
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1679 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1680
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1681 proc drawcommit {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1682 global phase todo nchildren datemode nextupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1683 global numcommits ncmupdate displayorder todo onscreen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1684
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1685 if {$phase != "incrdraw"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1686 set phase incrdraw
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1687 set displayorder {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1688 set todo {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1689 initgraph
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1690 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1691 if {$nchildren($id) == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1692 lappend todo $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1693 set onscreen($id) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1694 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1695 set level [decidenext 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1696 if {$level == {} || $id != [lindex $todo $level]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1697 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1698 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1699 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1700 lappend displayorder [lindex $todo $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1701 if {[updatetodo $level $datemode]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1702 set level [decidenext 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1703 if {$level == {}} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1704 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1705 set id [lindex $todo $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1706 if {![info exists commitlisted($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1707 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1708 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1709 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1710 drawmore 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1711 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1712
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1713 proc finishcommits {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1714 global phase
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1715 global canv mainfont ctext maincursor textcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1716
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1717 if {$phase != "incrdraw"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1718 $canv delete all
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1719 $canv create text 3 3 -anchor nw -text "No commits selected" \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1720 -font $mainfont -tags textitems
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1721 set phase {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1722 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1723 drawrest
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1724 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1725 . config -cursor $maincursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1726 settextcursor $textcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1727 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1728
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1729 # Don't change the text pane cursor if it is currently the hand cursor,
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1730 # showing that we are over a sha1 ID link.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1731 proc settextcursor {c} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1732 global ctext curtextcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1733
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1734 if {[$ctext cget -cursor] == $curtextcursor} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1735 $ctext config -cursor $c
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1736 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1737 set curtextcursor $c
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1738 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1739
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1740 proc drawgraph {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1741 global nextupdate startmsecs ncmupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1742 global displayorder onscreen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1743
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1744 if {$displayorder == {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1745 set startmsecs [clock clicks -milliseconds]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1746 set nextupdate [expr $startmsecs + 100]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1747 set ncmupdate 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1748 initgraph
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1749 foreach id $displayorder {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1750 set onscreen($id) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1751 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1752 drawmore 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1753 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1754
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1755 proc drawrest {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1756 global phase stopped redisplaying selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1757 global datemode todo displayorder
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1758 global numcommits ncmupdate
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1759 global nextupdate startmsecs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1760
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1761 set level [decidenext]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1762 if {$level >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1763 set phase drawgraph
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1764 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1765 lappend displayorder [lindex $todo $level]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1766 set hard [updatetodo $level $datemode]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1767 if {$hard} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1768 set level [decidenext]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1769 if {$level < 0} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1770 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1771 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1772 drawmore 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1773 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1774 set phase {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1775 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1776 #puts "overall $drawmsecs ms for $numcommits commits"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1777 if {$redisplaying} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1778 if {$stopped == 0 && [info exists selectedline]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1779 selectline $selectedline 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1780 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1781 if {$stopped == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1782 set stopped 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1783 after idle drawgraph
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1784 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1785 set redisplaying 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1786 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1787 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1788 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1789
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1790 proc findmatches {f} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1791 global findtype foundstring foundstrlen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1792 if {$findtype == "Regexp"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1793 set matches [regexp -indices -all -inline $foundstring $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1794 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1795 if {$findtype == "IgnCase"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1796 set str [string tolower $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1797 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1798 set str $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1799 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1800 set matches {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1801 set i 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1802 while {[set j [string first $foundstring $str $i]] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1803 lappend matches [list $j [expr $j+$foundstrlen-1]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1804 set i [expr $j + $foundstrlen]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1805 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1806 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1807 return $matches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1808 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1809
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1810 proc dofind {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1811 global findtype findloc findstring markedmatches commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1812 global numcommits lineid linehtag linentag linedtag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1813 global mainfont namefont canv canv2 canv3 selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1814 global matchinglines foundstring foundstrlen
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1815
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1816 stopfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1817 unmarkmatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1818 focus .
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1819 set matchinglines {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1820 if {$findloc == "Pickaxe"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1821 findpatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1822 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1823 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1824 if {$findtype == "IgnCase"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1825 set foundstring [string tolower $findstring]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1826 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1827 set foundstring $findstring
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1828 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1829 set foundstrlen [string length $findstring]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1830 if {$foundstrlen == 0} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1831 if {$findloc == "Files"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1832 findfiles
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1833 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1834 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1835 if {![info exists selectedline]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1836 set oldsel -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1837 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1838 set oldsel $selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1839 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1840 set didsel 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1841 set fldtypes {Headline Author Date Committer CDate Comment}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1842 for {set l 0} {$l < $numcommits} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1843 set id $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1844 set info $commitinfo($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1845 set doesmatch 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1846 foreach f $info ty $fldtypes {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1847 if {$findloc != "All fields" && $findloc != $ty} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1848 continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1849 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1850 set matches [findmatches $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1851 if {$matches == {}} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1852 set doesmatch 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1853 if {$ty == "Headline"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1854 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1855 } elseif {$ty == "Author"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1856 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1857 } elseif {$ty == "Date"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1858 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1859 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1860 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1861 if {$doesmatch} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1862 lappend matchinglines $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1863 if {!$didsel && $l > $oldsel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1864 findselectline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1865 set didsel 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1866 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1867 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1868 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1869 if {$matchinglines == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1870 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1871 } elseif {!$didsel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1872 findselectline [lindex $matchinglines 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1873 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1874 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1875
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1876 proc findselectline {l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1877 global findloc commentend ctext
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1878 selectline $l 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1879 if {$findloc == "All fields" || $findloc == "Comments"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1880 # highlight the matches in the comments
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1881 set f [$ctext get 1.0 $commentend]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1882 set matches [findmatches $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1883 foreach match $matches {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1884 set start [lindex $match 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1885 set end [expr [lindex $match 1] + 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1886 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1887 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1888 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1889 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1890
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1891 proc findnext {restart} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1892 global matchinglines selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1893 if {![info exists matchinglines]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1894 if {$restart} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1895 dofind
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1896 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1897 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1898 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1899 if {![info exists selectedline]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1900 foreach l $matchinglines {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1901 if {$l > $selectedline} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1902 findselectline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1903 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1904 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1905 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1906 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1907 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1908
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1909 proc findprev {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1910 global matchinglines selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1911 if {![info exists matchinglines]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1912 dofind
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1913 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1914 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1915 if {![info exists selectedline]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1916 set prev {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1917 foreach l $matchinglines {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1918 if {$l >= $selectedline} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1919 set prev $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1920 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1921 if {$prev != {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1922 findselectline $prev
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1923 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1924 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1925 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1926 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1927
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1928 proc findlocchange {name ix op} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1929 global findloc findtype findtypemenu
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1930 if {$findloc == "Pickaxe"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1931 set findtype Exact
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1932 set state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1933 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1934 set state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1935 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1936 $findtypemenu entryconf 1 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1937 $findtypemenu entryconf 2 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1938 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1939
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1940 proc stopfindproc {{done 0}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1941 global findprocpid findprocfile findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1942 global ctext findoldcursor phase maincursor textcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1943 global findinprogress
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1944
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1945 catch {unset findids}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1946 if {[info exists findprocpid]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1947 if {!$done} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1948 catch {exec kill $findprocpid}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1949 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1950 catch {close $findprocfile}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1951 unset findprocpid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1952 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1953 if {[info exists findinprogress]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1954 unset findinprogress
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1955 if {$phase != "incrdraw"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1956 . config -cursor $maincursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1957 settextcursor $textcursor
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1958 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1959 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1960 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1961
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1962 proc findpatches {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1963 global findstring selectedline numcommits
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1964 global findprocpid findprocfile
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1965 global finddidsel ctext lineid findinprogress
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1966 global findinsertpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1967 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1968
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1969 if {$numcommits == 0} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1970
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1971 # make a list of all the ids to search, starting at the one
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1972 # after the selected line (if any)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1973 if {[info exists selectedline]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1974 set l $selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1975 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1976 set l -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1977 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1978 set inputids {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1979 for {set i 0} {$i < $numcommits} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1980 if {[incr l] >= $numcommits} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1981 set l 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1982 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1983 append inputids $lineid($l) "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1984 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1985
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1986 if {[catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1987 set f [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree --stdin -s -r -S$findstring << $inputids] r]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1988 } err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1989 error_popup "Error starting search process: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1990 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1991 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1992
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1993 set findinsertpos end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1994 set findprocfile $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1995 set findprocpid [pid $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1996 fconfigure $f -blocking 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1997 fileevent $f readable readfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1998 set finddidsel 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
1999 . config -cursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2000 settextcursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2001 set findinprogress 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2002 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2003
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2004 proc readfindproc {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2005 global findprocfile finddidsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2006 global idline matchinglines findinsertpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2007
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2008 set n [gets $findprocfile line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2009 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2010 if {[eof $findprocfile]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2011 stopfindproc 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2012 if {!$finddidsel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2013 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2014 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2015 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2016 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2017 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2018 if {![regexp {^[0-9a-f]{12}} $line id]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2019 error_popup "Can't parse git-diff-tree output: $line"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2020 stopfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2021 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2022 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2023 if {![info exists idline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2024 puts stderr "spurious id: $id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2025 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2026 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2027 set l $idline($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2028 insertmatch $l $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2029 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2030
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2031 proc insertmatch {l id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2032 global matchinglines findinsertpos finddidsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2033
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2034 if {$findinsertpos == "end"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2035 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2036 set matchinglines [linsert $matchinglines 0 $l]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2037 set findinsertpos 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2038 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2039 lappend matchinglines $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2040 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2041 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2042 set matchinglines [linsert $matchinglines $findinsertpos $l]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2043 incr findinsertpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2044 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2045 markheadline $l $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2046 if {!$finddidsel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2047 findselectline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2048 set finddidsel 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2049 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2050 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2051
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2052 proc findfiles {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2053 global selectedline numcommits lineid ctext
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2054 global ffileline finddidsel parents nparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2055 global findinprogress findstartline findinsertpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2056 global treediffs fdiffids fdiffsneeded fdiffpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2057 global findmergefiles
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2058 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2059
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2060 if {$numcommits == 0} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2061
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2062 if {[info exists selectedline]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2063 set l [expr {$selectedline + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2064 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2065 set l 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2066 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2067 set ffileline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2068 set findstartline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2069 set diffsneeded {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2070 set fdiffsneeded {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2071 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2072 set id $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2073 if {$findmergefiles || $nparents($id) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2074 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2075 if {![info exists treediffs([list $id $p])]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2076 append diffsneeded "$id $p\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2077 lappend fdiffsneeded [list $id $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2078 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2079 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2080 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2081 if {[incr l] >= $numcommits} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2082 set l 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2083 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2084 if {$l == $findstartline} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2085 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2086
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2087 # start off a git-diff-tree process if needed
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2088 if {$diffsneeded ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2089 if {[catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2090 set df [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r --stdin << $diffsneeded] r]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2091 } err ]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2092 error_popup "Error starting search process: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2093 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2094 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2095 catch {unset fdiffids}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2096 set fdiffpos 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2097 fconfigure $df -blocking 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2098 fileevent $df readable [list readfilediffs $df]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2099 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2100
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2101 set finddidsel 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2102 set findinsertpos end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2103 set id $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2104 set p [lindex $parents($id) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2105 . config -cursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2106 settextcursor watch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2107 set findinprogress 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2108 findcont [list $id $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2109 update
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2110 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2111
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2112 proc readfilediffs {df} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2113 global findids fdiffids fdiffs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2114
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2115 set n [gets $df line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2116 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2117 if {[eof $df]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2118 donefilediff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2119 if {[catch {close $df} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2120 stopfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2121 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2122 error_popup "Error in hg debug-diff-tree: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2123 } elseif {[info exists findids]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2124 set ids $findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2125 stopfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2126 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2127 error_popup "Couldn't find diffs for {$ids}"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2128 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2129 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2130 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2131 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2132 if {[regexp {^([0-9a-f]{12}) \(from ([0-9a-f]{12})\)} $line match id p]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2133 # start of a new string of diffs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2134 donefilediff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2135 set fdiffids [list $id $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2136 set fdiffs {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2137 } elseif {[string match ":*" $line]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2138 lappend fdiffs [lindex $line 5]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2139 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2140 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2141
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2142 proc donefilediff {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2143 global fdiffids fdiffs treediffs findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2144 global fdiffsneeded fdiffpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2145
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2146 if {[info exists fdiffids]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2147 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2148 && $fdiffpos < [llength $fdiffsneeded]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2149 # git-diff-tree doesn't output anything for a commit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2150 # which doesn't change anything
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2151 set nullids [lindex $fdiffsneeded $fdiffpos]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2152 set treediffs($nullids) {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2153 if {[info exists findids] && $nullids eq $findids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2154 unset findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2155 findcont $nullids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2156 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2157 incr fdiffpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2158 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2159 incr fdiffpos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2160
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2161 if {![info exists treediffs($fdiffids)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2162 set treediffs($fdiffids) $fdiffs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2163 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2164 if {[info exists findids] && $fdiffids eq $findids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2165 unset findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2166 findcont $fdiffids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2167 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2168 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2169 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2170
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2171 proc findcont {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2172 global findids treediffs parents nparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2173 global ffileline findstartline finddidsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2174 global lineid numcommits matchinglines findinprogress
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2175 global findmergefiles
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2176
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2177 set id [lindex $ids 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2178 set p [lindex $ids 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2179 set pi [lsearch -exact $parents($id) $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2180 set l $ffileline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2181 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2182 if {$findmergefiles || $nparents($id) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2183 if {![info exists treediffs($ids)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2184 set findids $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2185 set ffileline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2186 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2187 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2188 set doesmatch 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2189 foreach f $treediffs($ids) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2190 set x [findmatches $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2191 if {$x != {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2192 set doesmatch 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2193 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2194 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2195 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2196 if {$doesmatch} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2197 insertmatch $l $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2198 set pi $nparents($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2199 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2200 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2201 set pi $nparents($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2202 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2203 if {[incr pi] >= $nparents($id)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2204 set pi 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2205 if {[incr l] >= $numcommits} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2206 set l 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2207 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2208 if {$l == $findstartline} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2209 set id $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2210 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2211 set p [lindex $parents($id) $pi]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2212 set ids [list $id $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2213 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2214 stopfindproc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2215 if {!$finddidsel} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2216 bell
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2217 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2218 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2219
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2220 # mark a commit as matching by putting a yellow background
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2221 # behind the headline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2222 proc markheadline {l id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2223 global canv mainfont linehtag commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2224
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2225 set bbox [$canv bbox $linehtag($l)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2226 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2227 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2228 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2229
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2230 # mark the bits of a headline, author or date that match a find string
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2231 proc markmatches {canv l str tag matches font} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2232 set bbox [$canv bbox $tag]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2233 set x0 [lindex $bbox 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2234 set y0 [lindex $bbox 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2235 set y1 [lindex $bbox 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2236 foreach match $matches {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2237 set start [lindex $match 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2238 set end [lindex $match 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2239 if {$start > $end} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2240 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2241 set xlen [font measure $font [string range $str 0 [expr $end]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2242 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2243 -outline {} -tags matches -fill yellow]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2244 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2245 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2246 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2247
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2248 proc unmarkmatches {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2249 global matchinglines findids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2250 allcanvs delete matches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2251 catch {unset matchinglines}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2252 catch {unset findids}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2253 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2254
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2255 proc selcanvline {w x y} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2256 global canv canvy0 ctext linespc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2257 global lineid linehtag linentag linedtag rowtextx
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2258 set ymax [lindex [$canv cget -scrollregion] 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2259 if {$ymax == {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2260 set yfrac [lindex [$canv yview] 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2261 set y [expr {$y + $yfrac * $ymax}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2262 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2263 if {$l < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2264 set l 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2265 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2266 if {$w eq $canv} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2267 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2268 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2269 unmarkmatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2270 selectline $l 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2271 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2272
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2273 proc commit_descriptor {p} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2274 global commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2275 set l "..."
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2276 if {[info exists commitinfo($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2277 set l [lindex $commitinfo($p) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2278 set r [lindex $commitinfo($p) 6]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2279 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2280 return "$r:$p ($l)"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2281 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2282
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2283 # append some text to the ctext widget, and make any SHA1 ID
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2284 # that we know about be a clickable link.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2285 proc appendwithlinks {text} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2286 global ctext idline linknum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2287
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2288 set start [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2289 $ctext insert end $text
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2290 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2291 set links [regexp -indices -all -inline {[0-9a-f]{12}} $text]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2292 foreach l $links {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2293 set s [lindex $l 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2294 set e [lindex $l 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2295 set linkid [string range $text $s $e]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2296 if {![info exists idline($linkid)]} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2297 incr e
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2298 $ctext tag add link "$start + $s c" "$start + $e c"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2299 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2300 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2301 incr linknum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2302 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2303 $ctext tag conf link -foreground blue -underline 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2304 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2305 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2306 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2307
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2308 proc selectline {l isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2309 global canv canv2 canv3 ctext commitinfo selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2310 global lineid linehtag linentag linedtag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2311 global canvy0 linespc parents nparents children
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2312 global cflist currentid sha1entry
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2313 global commentend idtags idline linknum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2314
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2315 $canv delete hover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2316 normalline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2317 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2318 $canv delete secsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2319 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2320 -tags secsel -fill [$canv cget -selectbackground]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2321 $canv lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2322 $canv2 delete secsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2323 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2324 -tags secsel -fill [$canv2 cget -selectbackground]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2325 $canv2 lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2326 $canv3 delete secsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2327 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2328 -tags secsel -fill [$canv3 cget -selectbackground]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2329 $canv3 lower $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2330 set y [expr {$canvy0 + $l * $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2331 set ymax [lindex [$canv cget -scrollregion] 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2332 set ytop [expr {$y - $linespc - 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2333 set ybot [expr {$y + $linespc + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2334 set wnow [$canv yview]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2335 set wtop [expr [lindex $wnow 0] * $ymax]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2336 set wbot [expr [lindex $wnow 1] * $ymax]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2337 set wh [expr {$wbot - $wtop}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2338 set newtop $wtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2339 if {$ytop < $wtop} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2340 if {$ybot < $wtop} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2341 set newtop [expr {$y - $wh / 2.0}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2342 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2343 set newtop $ytop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2344 if {$newtop > $wtop - $linespc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2345 set newtop [expr {$wtop - $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2346 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2347 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2348 } elseif {$ybot > $wbot} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2349 if {$ytop > $wbot} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2350 set newtop [expr {$y - $wh / 2.0}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2351 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2352 set newtop [expr {$ybot - $wh}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2353 if {$newtop < $wtop + $linespc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2354 set newtop [expr {$wtop + $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2355 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2356 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2357 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2358 if {$newtop != $wtop} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2359 if {$newtop < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2360 set newtop 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2361 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2362 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2363 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2364
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2365 if {$isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2366 addtohistory [list selectline $l 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2367 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2368
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2369 set selectedline $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2370
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2371 set id $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2372 set currentid $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2373 $sha1entry delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2374 $sha1entry insert 0 $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2375 $sha1entry selection from 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2376 $sha1entry selection to end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2377
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2378 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2379 $ctext delete 0.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2380 set linknum 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2381 $ctext mark set fmark.0 0.0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2382 $ctext mark gravity fmark.0 left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2383 set info $commitinfo($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2384 $ctext insert end "Revision: [lindex $info 6]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2385 if {[llength [lindex $info 7]] > 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2386 $ctext insert end "Branch: [lindex $info 7]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2387 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2388 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2389 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2390 if {[info exists idtags($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2391 $ctext insert end "Tags:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2392 foreach tag $idtags($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2393 $ctext insert end " $tag"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2394 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2395 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2396 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2397
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2398 set comment {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2399 if {[info exists parents($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2400 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2401 append comment "Parent: [commit_descriptor $p]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2402 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2403 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2404 if {[info exists children($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2405 foreach c $children($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2406 append comment "Child: [commit_descriptor $c]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2407 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2408 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2409 append comment "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2410 append comment [lindex $info 5]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2411
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2412 # make anything that looks like a SHA1 ID be a clickable link
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2413 appendwithlinks $comment
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2414
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2415 $ctext tag delete Comments
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2416 $ctext tag remove found 1.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2417 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2418 set commentend [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2419
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2420 $cflist delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2421 $cflist insert end "Comments"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2422 if {$nparents($id) <= 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2423 set parent "null"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2424 if {$nparents($id) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2425 set parent $parents($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2426 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2427 startdiff [concat $id $parent]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2428 } elseif {$nparents($id) > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2429 mergediff $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2430 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2431 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2432
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2433 proc selnextline {dir} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2434 global selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2435 if {![info exists selectedline]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2436 set l [expr $selectedline + $dir]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2437 unmarkmatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2438 selectline $l 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2439 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2440
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2441 proc unselectline {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2442 global selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2443
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2444 catch {unset selectedline}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2445 allcanvs delete secsel
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2446 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2447
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2448 proc addtohistory {cmd} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2449 global history historyindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2450
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2451 if {$historyindex > 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2452 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2453 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2454 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2455
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2456 if {$historyindex < [llength $history]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2457 set history [lreplace $history $historyindex end $cmd]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2458 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2459 lappend history $cmd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2460 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2461 incr historyindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2462 if {$historyindex > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2463 .ctop.top.bar.leftbut conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2464 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2465 .ctop.top.bar.leftbut conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2466 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2467 .ctop.top.bar.rightbut conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2468 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2469
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2470 proc goback {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2471 global history historyindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2472
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2473 if {$historyindex > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2474 incr historyindex -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2475 set cmd [lindex $history [expr {$historyindex - 1}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2476 eval $cmd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2477 .ctop.top.bar.rightbut conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2478 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2479 if {$historyindex <= 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2480 .ctop.top.bar.leftbut conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2481 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2482 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2483
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2484 proc goforw {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2485 global history historyindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2486
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2487 if {$historyindex < [llength $history]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2488 set cmd [lindex $history $historyindex]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2489 incr historyindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2490 eval $cmd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2491 .ctop.top.bar.leftbut conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2492 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2493 if {$historyindex >= [llength $history]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2494 .ctop.top.bar.rightbut conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2495 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2496 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2497
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2498 proc mergediff {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2499 global parents diffmergeid diffmergegca mergefilelist diffpindex
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2500
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2501 set diffmergeid $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2502 set diffpindex -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2503 set diffmergegca [findgca $parents($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2504 if {[info exists mergefilelist($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2505 if {$mergefilelist($id) ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2506 showmergediff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2507 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2508 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2509 contmergediff {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2510 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2511 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2512
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2513 proc findgca {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2514 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2515 set gca {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2516 foreach id $ids {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2517 if {$gca eq {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2518 set gca $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2519 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2520 if {[catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2521 set gca [exec $env(HG) --config ui.report_untrusted=false debug-merge-base $gca $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2522 } err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2523 return {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2524 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2525 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2526 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2527 return $gca
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2528 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2529
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2530 proc contmergediff {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2531 global diffmergeid diffpindex parents nparents diffmergegca
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2532 global treediffs mergefilelist diffids treepending
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2533
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2534 # diff the child against each of the parents, and diff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2535 # each of the parents against the GCA.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2536 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2537 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2538 set ids [list [lindex $ids 1] $diffmergegca]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2539 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2540 if {[incr diffpindex] >= $nparents($diffmergeid)} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2541 set p [lindex $parents($diffmergeid) $diffpindex]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2542 set ids [list $diffmergeid $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2543 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2544 if {![info exists treediffs($ids)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2545 set diffids $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2546 if {![info exists treepending]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2547 gettreediffs $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2548 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2549 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2550 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2551 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2552
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2553 # If a file in some parent is different from the child and also
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2554 # different from the GCA, then it's interesting.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2555 # If we don't have a GCA, then a file is interesting if it is
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2556 # different from the child in all the parents.
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2557 if {$diffmergegca ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2558 set files {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2559 foreach p $parents($diffmergeid) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2560 set gcadiffs $treediffs([list $p $diffmergegca])
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2561 foreach f $treediffs([list $diffmergeid $p]) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2562 if {[lsearch -exact $files $f] < 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2563 && [lsearch -exact $gcadiffs $f] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2564 lappend files $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2565 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2566 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2567 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2568 set files [lsort $files]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2569 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2570 set p [lindex $parents($diffmergeid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2571 set files $treediffs([list $diffmergeid $p])
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2572 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2573 set p [lindex $parents($diffmergeid) $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2574 set df $treediffs([list $diffmergeid $p])
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2575 set nf {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2576 foreach f $files {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2577 if {[lsearch -exact $df $f] >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2578 lappend nf $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2579 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2580 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2581 set files $nf
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2582 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2583 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2584
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2585 set mergefilelist($diffmergeid) $files
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2586 if {$files ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2587 showmergediff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2588 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2589 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2590
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2591 proc showmergediff {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2592 global cflist diffmergeid mergefilelist parents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2593 global diffopts diffinhunk currentfile currenthunk filelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2594 global diffblocked groupfilelast mergefds groupfilenum grouphunks
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2595 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2596
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2597 set files $mergefilelist($diffmergeid)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2598 foreach f $files {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2599 $cflist insert end $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2600 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2601 set env(GIT_DIFF_OPTS) $diffopts
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2602 set flist {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2603 catch {unset currentfile}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2604 catch {unset currenthunk}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2605 catch {unset filelines}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2606 catch {unset groupfilenum}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2607 catch {unset grouphunks}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2608 set groupfilelast -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2609 foreach p $parents($diffmergeid) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2610 set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $p $diffmergeid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2611 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2612 if {[catch {set f [open $cmd r]} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2613 error_popup "Error getting diffs: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2614 foreach f $flist {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2615 catch {close $f}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2616 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2617 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2618 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2619 lappend flist $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2620 set ids [list $diffmergeid $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2621 set mergefds($ids) $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2622 set diffinhunk($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2623 set diffblocked($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2624 fconfigure $f -blocking 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2625 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2626 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2627 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2628
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2629 proc getmergediffline {f ids id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2630 global diffmergeid diffinhunk diffoldlines diffnewlines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2631 global currentfile currenthunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2632 global diffoldstart diffnewstart diffoldlno diffnewlno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2633 global diffblocked mergefilelist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2634 global noldlines nnewlines difflcounts filelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2635
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2636 set n [gets $f line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2637 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2638 if {![eof $f]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2639 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2640
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2641 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2642 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2643 close $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2644 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2645 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2646 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2647
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2648 if {$diffinhunk($ids) != 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2649 set fi $currentfile($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2650 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2651 # continuing an existing hunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2652 set line [string range $line 1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2653 set p [lindex $ids 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2654 if {$match eq "-" || $match eq " "} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2655 set filelines($p,$fi,$diffoldlno($ids)) $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2656 incr diffoldlno($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2657 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2658 if {$match eq "+" || $match eq " "} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2659 set filelines($id,$fi,$diffnewlno($ids)) $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2660 incr diffnewlno($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2661 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2662 if {$match eq " "} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2663 if {$diffinhunk($ids) == 2} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2664 lappend difflcounts($ids) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2665 [list $noldlines($ids) $nnewlines($ids)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2666 set noldlines($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2667 set diffinhunk($ids) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2668 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2669 incr noldlines($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2670 } elseif {$match eq "-" || $match eq "+"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2671 if {$diffinhunk($ids) == 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2672 lappend difflcounts($ids) [list $noldlines($ids)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2673 set noldlines($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2674 set nnewlines($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2675 set diffinhunk($ids) 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2676 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2677 if {$match eq "-"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2678 incr noldlines($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2679 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2680 incr nnewlines($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2681 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2682 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2683 # and if it's \ No newline at end of line, then what?
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2684 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2685 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2686 # end of a hunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2687 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2688 lappend difflcounts($ids) [list $noldlines($ids)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2689 } elseif {$diffinhunk($ids) == 2
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2690 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2691 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2692 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2693 set currenthunk($ids) [list $currentfile($ids) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2694 $diffoldstart($ids) $diffnewstart($ids) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2695 $diffoldlno($ids) $diffnewlno($ids) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2696 $difflcounts($ids)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2697 set diffinhunk($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2698 # -1 = need to block, 0 = unblocked, 1 = is blocked
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2699 set diffblocked($ids) -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2700 processhunks
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2701 if {$diffblocked($ids) == -1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2702 fileevent $f readable {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2703 set diffblocked($ids) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2704 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2705 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2706
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2707 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2708 # eof
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2709 if {!$diffblocked($ids)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2710 close $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2711 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2712 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2713 processhunks
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2714 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2715 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2716 # start of a new file
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2717 set currentfile($ids) \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2718 [lsearch -exact $mergefilelist($diffmergeid) $fname]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2719 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2720 $line match f1l f1c f2l f2c rest]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2721 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2722 # start of a new hunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2723 if {$f1l == 0 && $f1c == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2724 set f1l 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2725 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2726 if {$f2l == 0 && $f2c == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2727 set f2l 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2728 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2729 set diffinhunk($ids) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2730 set diffoldstart($ids) $f1l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2731 set diffnewstart($ids) $f2l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2732 set diffoldlno($ids) $f1l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2733 set diffnewlno($ids) $f2l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2734 set difflcounts($ids) {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2735 set noldlines($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2736 set nnewlines($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2737 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2738 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2739 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2740
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2741 proc processhunks {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2742 global diffmergeid parents nparents currenthunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2743 global mergefilelist diffblocked mergefds
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2744 global grouphunks grouplinestart grouplineend groupfilenum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2745
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2746 set nfiles [llength $mergefilelist($diffmergeid)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2747 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2748 set fi $nfiles
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2749 set lno 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2750 # look for the earliest hunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2751 foreach p $parents($diffmergeid) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2752 set ids [list $diffmergeid $p]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2753 if {![info exists currenthunk($ids)]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2754 set i [lindex $currenthunk($ids) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2755 set l [lindex $currenthunk($ids) 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2756 if {$i < $fi || ($i == $fi && $l < $lno)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2757 set fi $i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2758 set lno $l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2759 set pi $p
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2760 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2761 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2762
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2763 if {$fi < $nfiles} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2764 set ids [list $diffmergeid $pi]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2765 set hunk $currenthunk($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2766 unset currenthunk($ids)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2767 if {$diffblocked($ids) > 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2768 fileevent $mergefds($ids) readable \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2769 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2770 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2771 set diffblocked($ids) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2772
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2773 if {[info exists groupfilenum] && $groupfilenum == $fi
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2774 && $lno <= $grouplineend} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2775 # add this hunk to the pending group
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2776 lappend grouphunks($pi) $hunk
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2777 set endln [lindex $hunk 4]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2778 if {$endln > $grouplineend} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2779 set grouplineend $endln
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2780 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2781 continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2782 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2783 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2784
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2785 # succeeding stuff doesn't belong in this group, so
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2786 # process the group now
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2787 if {[info exists groupfilenum]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2788 processgroup
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2789 unset groupfilenum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2790 unset grouphunks
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2791 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2792
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2793 if {$fi >= $nfiles} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2794
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2795 # start a new group
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2796 set groupfilenum $fi
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2797 set grouphunks($pi) [list $hunk]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2798 set grouplinestart $lno
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2799 set grouplineend [lindex $hunk 4]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2800 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2801 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2802
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2803 proc processgroup {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2804 global groupfilelast groupfilenum difffilestart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2805 global mergefilelist diffmergeid ctext filelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2806 global parents diffmergeid diffoffset
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2807 global grouphunks grouplinestart grouplineend nparents
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2808 global mergemax
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2809
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2810 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2811 set id $diffmergeid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2812 set f $groupfilenum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2813 if {$groupfilelast != $f} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2814 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2815 set here [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2816 set difffilestart($f) $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2817 set mark fmark.[expr {$f + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2818 $ctext mark set $mark $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2819 $ctext mark gravity $mark left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2820 set header [lindex $mergefilelist($id) $f]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2821 set l [expr {(78 - [string length $header]) / 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2822 set pad [string range "----------------------------------------" 1 $l]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2823 $ctext insert end "$pad $header $pad\n" filesep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2824 set groupfilelast $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2825 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2826 set diffoffset($p) 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2827 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2828 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2829
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2830 $ctext insert end "@@" msep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2831 set nlines [expr {$grouplineend - $grouplinestart}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2832 set events {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2833 set pnum 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2834 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2835 set startline [expr {$grouplinestart + $diffoffset($p)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2836 set ol $startline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2837 set nl $grouplinestart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2838 if {[info exists grouphunks($p)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2839 foreach h $grouphunks($p) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2840 set l [lindex $h 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2841 if {$nl < $l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2842 for {} {$nl < $l} {incr nl} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2843 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2844 incr ol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2845 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2846 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2847 foreach chunk [lindex $h 5] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2848 if {[llength $chunk] == 2} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2849 set olc [lindex $chunk 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2850 set nlc [lindex $chunk 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2851 set nnl [expr {$nl + $nlc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2852 lappend events [list $nl $nnl $pnum $olc $nlc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2853 incr ol $olc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2854 set nl $nnl
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2855 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2856 incr ol [lindex $chunk 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2857 incr nl [lindex $chunk 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2858 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2859 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2860 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2861 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2862 if {$nl < $grouplineend} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2863 for {} {$nl < $grouplineend} {incr nl} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2864 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2865 incr ol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2866 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2867 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2868 set nlines [expr {$ol - $startline}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2869 $ctext insert end " -$startline,$nlines" msep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2870 incr pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2871 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2872
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2873 set nlines [expr {$grouplineend - $grouplinestart}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2874 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2875
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2876 set events [lsort -integer -index 0 $events]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2877 set nevents [llength $events]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2878 set nmerge $nparents($diffmergeid)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2879 set l $grouplinestart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2880 for {set i 0} {$i < $nevents} {set i $j} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2881 set nl [lindex $events $i 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2882 while {$l < $nl} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2883 $ctext insert end " $filelines($id,$f,$l)\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2884 incr l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2885 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2886 set e [lindex $events $i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2887 set enl [lindex $e 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2888 set j $i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2889 set active {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2890 while 1 {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2891 set pnum [lindex $e 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2892 set olc [lindex $e 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2893 set nlc [lindex $e 4]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2894 if {![info exists delta($pnum)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2895 set delta($pnum) [expr {$olc - $nlc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2896 lappend active $pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2897 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2898 incr delta($pnum) [expr {$olc - $nlc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2899 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2900 if {[incr j] >= $nevents} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2901 set e [lindex $events $j]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2902 if {[lindex $e 0] >= $enl} break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2903 if {[lindex $e 1] > $enl} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2904 set enl [lindex $e 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2905 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2906 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2907 set nlc [expr {$enl - $l}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2908 set ncol mresult
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2909 set bestpn -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2910 if {[llength $active] == $nmerge - 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2911 # no diff for one of the parents, i.e. it's identical
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2912 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2913 if {![info exists delta($pnum)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2914 if {$pnum < $mergemax} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2915 lappend ncol m$pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2916 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2917 lappend ncol mmax
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2918 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2919 break
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2920 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2921 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2922 } elseif {[llength $active] == $nmerge} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2923 # all parents are different, see if one is very similar
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2924 set bestsim 30
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2925 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2926 set sim [similarity $pnum $l $nlc $f \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2927 [lrange $events $i [expr {$j-1}]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2928 if {$sim > $bestsim} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2929 set bestsim $sim
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2930 set bestpn $pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2931 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2932 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2933 if {$bestpn >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2934 lappend ncol m$bestpn
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2935 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2936 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2937 set pnum -1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2938 foreach p $parents($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2939 incr pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2940 if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2941 set olc [expr {$nlc + $delta($pnum)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2942 set ol [expr {$l + $diffoffset($p)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2943 incr diffoffset($p) $delta($pnum)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2944 unset delta($pnum)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2945 for {} {$olc > 0} {incr olc -1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2946 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2947 incr ol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2948 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2949 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2950 set endl [expr {$l + $nlc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2951 if {$bestpn >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2952 # show this pretty much as a normal diff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2953 set p [lindex $parents($id) $bestpn]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2954 set ol [expr {$l + $diffoffset($p)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2955 incr diffoffset($p) $delta($bestpn)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2956 unset delta($bestpn)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2957 for {set k $i} {$k < $j} {incr k} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2958 set e [lindex $events $k]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2959 if {[lindex $e 2] != $bestpn} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2960 set nl [lindex $e 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2961 set ol [expr {$ol + $nl - $l}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2962 for {} {$l < $nl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2963 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2964 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2965 set c [lindex $e 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2966 for {} {$c > 0} {incr c -1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2967 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2968 incr ol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2969 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2970 set nl [lindex $e 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2971 for {} {$l < $nl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2972 $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2973 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2974 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2975 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2976 for {} {$l < $endl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2977 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2978 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2979 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2980 while {$l < $grouplineend} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2981 $ctext insert end " $filelines($id,$f,$l)\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2982 incr l
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2983 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2984 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2985 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2986
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2987 proc similarity {pnum l nlc f events} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2988 global diffmergeid parents diffoffset filelines
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2989
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2990 set id $diffmergeid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2991 set p [lindex $parents($id) $pnum]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2992 set ol [expr {$l + $diffoffset($p)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2993 set endl [expr {$l + $nlc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2994 set same 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2995 set diff 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2996 foreach e $events {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2997 if {[lindex $e 2] != $pnum} continue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2998 set nl [lindex $e 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
2999 set ol [expr {$ol + $nl - $l}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3000 for {} {$l < $nl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3001 incr same [string length $filelines($id,$f,$l)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3002 incr same
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3003 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3004 set oc [lindex $e 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3005 for {} {$oc > 0} {incr oc -1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3006 incr diff [string length $filelines($p,$f,$ol)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3007 incr diff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3008 incr ol
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3009 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3010 set nl [lindex $e 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3011 for {} {$l < $nl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3012 incr diff [string length $filelines($id,$f,$l)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3013 incr diff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3014 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3015 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3016 for {} {$l < $endl} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3017 incr same [string length $filelines($id,$f,$l)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3018 incr same
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3019 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3020 if {$same == 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3021 return 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3022 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3023 return [expr {200 * $same / (2 * $same + $diff)}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3024 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3025
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3026 proc startdiff {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3027 global treediffs diffids treepending diffmergeid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3028
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3029 set diffids $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3030 catch {unset diffmergeid}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3031 if {![info exists treediffs($ids)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3032 if {![info exists treepending]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3033 gettreediffs $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3034 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3035 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3036 addtocflist $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3037 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3038 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3039
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3040 proc addtocflist {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3041 global treediffs cflist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3042 foreach f $treediffs($ids) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3043 $cflist insert end $f
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3044 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3045 getblobdiffs $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3046 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3047
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3048 proc gettreediffs {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3049 global treediff parents treepending env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3050 set treepending $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3051 set treediff {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3052 set id [lindex $ids 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3053 set p [lindex $ids 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3054 if [catch {set gdtf [open "|{$env(HG)} --config ui.report_untrusted=false debug-diff-tree -r $p $id" r]}] return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3055 fconfigure $gdtf -blocking 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3056 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3057 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3058
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3059 proc gettreediffline {gdtf ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3060 global treediff treediffs treepending diffids diffmergeid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3061
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3062 set n [gets $gdtf line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3063 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3064 if {![eof $gdtf]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3065 close $gdtf
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3066 set treediffs($ids) $treediff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3067 unset treepending
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3068 if {$ids != $diffids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3069 gettreediffs $diffids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3070 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3071 if {[info exists diffmergeid]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3072 contmergediff $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3073 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3074 addtocflist $ids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3075 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3076 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3077 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3078 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3079 set tab1 [expr [string first "\t" $line] + 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3080 set tab2 [expr [string first "\t" $line $tab1] - 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3081 set file [string range $line $tab1 $tab2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3082 lappend treediff $file
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3083 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3084
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3085 proc getblobdiffs {ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3086 global diffopts blobdifffd diffids env curdifftag curtagstart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3087 global difffilestart nextupdate diffinhdr treediffs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3088
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3089 set id [lindex $ids 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3090 set p [lindex $ids 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3091 set env(GIT_DIFF_OPTS) $diffopts
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3092 set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r -p -C $p $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3093 if {[catch {set bdf [open $cmd r]} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3094 puts "error getting diffs: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3095 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3096 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3097 set diffinhdr 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3098 fconfigure $bdf -blocking 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3099 set blobdifffd($ids) $bdf
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3100 set curdifftag Comments
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3101 set curtagstart 0.0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3102 catch {unset difffilestart}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3103 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3104 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3105 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3106
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3107 proc getblobdiffline {bdf ids} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3108 global diffids blobdifffd ctext curdifftag curtagstart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3109 global diffnexthead diffnextnote difffilestart
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3110 global nextupdate diffinhdr treediffs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3111 global gaudydiff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3112
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3113 set n [gets $bdf line]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3114 if {$n < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3115 if {[eof $bdf]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3116 close $bdf
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3117 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3118 $ctext tag add $curdifftag $curtagstart end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3119 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3120 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3121 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3122 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3123 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3124 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3125 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3126 regsub -all "\r" $line "" line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3127 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3128 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3129 # start of a new file
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3130 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3131 $ctext tag add $curdifftag $curtagstart end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3132 set curtagstart [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3133 set header $newname
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3134 set here [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3135 set i [lsearch -exact $treediffs($diffids) $fname]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3136 if {$i >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3137 set difffilestart($i) $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3138 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3139 $ctext mark set fmark.$i $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3140 $ctext mark gravity fmark.$i left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3141 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3142 if {$newname != $fname} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3143 set i [lsearch -exact $treediffs($diffids) $newname]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3144 if {$i >= 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3145 set difffilestart($i) $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3146 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3147 $ctext mark set fmark.$i $here
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3148 $ctext mark gravity fmark.$i left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3149 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3150 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3151 set curdifftag "f:$fname"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3152 $ctext tag delete $curdifftag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3153 set l [expr {(78 - [string length $header]) / 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3154 set pad [string range "----------------------------------------" 1 $l]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3155 $ctext insert end "$pad $header $pad\n" filesep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3156 set diffinhdr 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3157 } elseif {[regexp {^(---|\+\+\+) } $line] && $diffinhdr} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3158 set diffinhdr 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3159 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3160 $line match f1l f1c f2l f2c rest]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3161 if {$gaudydiff} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3162 $ctext insert end "\t" hunksep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3163 $ctext insert end " $f1l " d0 " $f2l " d1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3164 $ctext insert end " $rest \n" hunksep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3165 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3166 $ctext insert end "$line\n" hunksep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3167 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3168 set diffinhdr 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3169 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3170 set x [string range $line 0 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3171 if {$x == "-" || $x == "+"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3172 set tag [expr {$x == "+"}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3173 if {$gaudydiff} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3174 set line [string range $line 1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3175 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3176 $ctext insert end "$line\n" d$tag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3177 } elseif {$x == " "} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3178 if {$gaudydiff} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3179 set line [string range $line 1 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3180 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3181 $ctext insert end "$line\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3182 } elseif {$diffinhdr || $x == "\\"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3183 # e.g. "\ No newline at end of file"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3184 $ctext insert end "$line\n" filesep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3185 } elseif {$line != ""} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3186 # Something else we don't recognize
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3187 if {$curdifftag != "Comments"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3188 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3189 $ctext tag add $curdifftag $curtagstart end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3190 set curtagstart [$ctext index "end - 1c"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3191 set curdifftag Comments
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3192 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3193 $ctext insert end "$line\n" filesep
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3194 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3195 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3196 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3197 if {[clock clicks -milliseconds] >= $nextupdate} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3198 incr nextupdate 100
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3199 fileevent $bdf readable {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3200 update
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3201 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3202 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3203 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3204
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3205 proc nextfile {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3206 global difffilestart ctext
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3207 set here [$ctext index @0,0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3208 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3209 if {[$ctext compare $difffilestart($i) > $here]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3210 if {![info exists pos]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3211 || [$ctext compare $difffilestart($i) < $pos]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3212 set pos $difffilestart($i)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3213 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3214 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3215 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3216 if {[info exists pos]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3217 $ctext yview $pos
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3218 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3219 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3220
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3221 proc listboxsel {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3222 global ctext cflist currentid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3223 if {![info exists currentid]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3224 set sel [lsort [$cflist curselection]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3225 if {$sel eq {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3226 set first [lindex $sel 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3227 catch {$ctext yview fmark.$first}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3228 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3229
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3230 proc setcoords {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3231 global linespc charspc canvx0 canvy0 mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3232 global xspc1 xspc2 lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3233
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3234 set linespc [font metrics $mainfont -linespace]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3235 set charspc [font measure $mainfont "m"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3236 set canvy0 [expr 3 + 0.5 * $linespc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3237 set canvx0 [expr 3 + 0.5 * $linespc]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3238 set lthickness [expr {int($linespc / 9) + 1}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3239 set xspc1(0) $linespc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3240 set xspc2 $linespc
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3241 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3242
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3243 proc redisplay {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3244 global stopped redisplaying phase
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3245 if {$stopped > 1} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3246 if {$phase == "getcommits"} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3247 set redisplaying 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3248 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3249 set stopped 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3250 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3251 drawgraph
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3252 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3253 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3254
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3255 proc incrfont {inc} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3256 global mainfont namefont textfont ctext canv phase
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3257 global stopped entries curidfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3258 unmarkmatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3259 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3260 set curidfont [lreplace $curidfont 1 1 [expr {[lindex $curidfont 1] + $inc}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3261 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3262 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3263 setcoords
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3264 $ctext conf -font $textfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3265 $ctext tag conf filesep -font [concat $textfont bold]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3266 foreach e $entries {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3267 $e conf -font $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3268 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3269 if {$phase == "getcommits"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3270 $canv itemconf textitems -font $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3271 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3272 redisplay
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3273 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3274
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3275 proc clearsha1 {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3276 global sha1entry sha1string
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3277 if {[string length $sha1string] == 40} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3278 $sha1entry delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3279 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3280 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3281
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3282 proc sha1change {n1 n2 op} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3283 global sha1string currentid sha1but
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3284 if {$sha1string == {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3285 || ([info exists currentid] && $sha1string == $currentid)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3286 set state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3287 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3288 set state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3289 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3290 if {[$sha1but cget -state] == $state} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3291 if {$state == "normal"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3292 $sha1but conf -state normal -relief raised -text "Goto: "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3293 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3294 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3295 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3296 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3297
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3298 proc gotocommit {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3299 global sha1string currentid idline tagids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3300 global lineid numcommits
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3301
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3302 if {$sha1string == {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3303 || ([info exists currentid] && $sha1string == $currentid)} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3304 if {[info exists tagids($sha1string)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3305 set id $tagids($sha1string)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3306 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3307 set id [string tolower $sha1string]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3308 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3309 set matches {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3310 for {set l 0} {$l < $numcommits} {incr l} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3311 if {[string match $id* $lineid($l)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3312 lappend matches $lineid($l)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3313 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3314 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3315 if {$matches ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3316 if {[llength $matches] > 1} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3317 error_popup "Short SHA1 id $id is ambiguous"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3318 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3319 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3320 set id [lindex $matches 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3321 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3322 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3323 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3324 if {[info exists idline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3325 selectline $idline($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3326 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3327 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3328 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3329 set type "SHA1 id"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3330 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3331 set type "Tag"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3332 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3333 error_popup "$type $sha1string is not known"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3334 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3335
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3336 proc lineenter {x y id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3337 global hoverx hovery hoverid hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3338 global commitinfo canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3339
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3340 if {![info exists commitinfo($id)]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3341 set hoverx $x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3342 set hovery $y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3343 set hoverid $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3344 if {[info exists hovertimer]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3345 after cancel $hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3346 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3347 set hovertimer [after 500 linehover]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3348 $canv delete hover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3349 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3350
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3351 proc linemotion {x y id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3352 global hoverx hovery hoverid hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3353
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3354 if {[info exists hoverid] && $id == $hoverid} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3355 set hoverx $x
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3356 set hovery $y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3357 if {[info exists hovertimer]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3358 after cancel $hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3359 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3360 set hovertimer [after 500 linehover]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3361 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3362 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3363
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3364 proc lineleave {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3365 global hoverid hovertimer canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3366
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3367 if {[info exists hoverid] && $id == $hoverid} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3368 $canv delete hover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3369 if {[info exists hovertimer]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3370 after cancel $hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3371 unset hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3372 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3373 unset hoverid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3374 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3375 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3376
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3377 proc linehover {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3378 global hoverx hovery hoverid hovertimer
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3379 global canv linespc lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3380 global commitinfo mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3381
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3382 set text [lindex $commitinfo($hoverid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3383 set ymax [lindex [$canv cget -scrollregion] 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3384 if {$ymax == {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3385 set yfrac [lindex [$canv yview] 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3386 set x [expr {$hoverx + 2 * $linespc}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3387 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3388 set x0 [expr {$x - 2 * $lthickness}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3389 set y0 [expr {$y - 2 * $lthickness}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3390 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3391 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3392 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3393 -fill \#ffff80 -outline black -width 1 -tags hover]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3394 $canv raise $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3395 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3396 $canv raise $t
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3397 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3398
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3399 proc clickisonarrow {id y} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3400 global mainline mainlinearrow sidelines lthickness
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3401
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3402 set thresh [expr {2 * $lthickness + 6}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3403 if {[info exists mainline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3404 if {$mainlinearrow($id) ne "none"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3405 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3406 return "up"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3407 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3408 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3409 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3410 if {[info exists sidelines($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3411 foreach ls $sidelines($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3412 set coords [lindex $ls 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3413 set arrow [lindex $ls 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3414 if {$arrow eq "first" || $arrow eq "both"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3415 if {abs([lindex $coords 1] - $y) < $thresh} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3416 return "up"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3417 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3418 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3419 if {$arrow eq "last" || $arrow eq "both"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3420 if {abs([lindex $coords end] - $y) < $thresh} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3421 return "down"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3422 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3423 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3424 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3425 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3426 return {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3427 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3428
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3429 proc arrowjump {id dirn y} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3430 global mainline sidelines canv
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3431
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3432 set yt {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3433 if {$dirn eq "down"} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3434 if {[info exists mainline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3435 set y1 [lindex $mainline($id) 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3436 if {$y1 > $y} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3437 set yt $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3438 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3439 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3440 if {[info exists sidelines($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3441 foreach ls $sidelines($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3442 set y1 [lindex $ls 0 1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3443 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3444 set yt $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3445 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3446 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3447 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3448 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3449 if {[info exists sidelines($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3450 foreach ls $sidelines($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3451 set y1 [lindex $ls 0 end]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3452 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3453 set yt $y1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3454 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3455 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3456 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3457 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3458 if {$yt eq {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3459 set ymax [lindex [$canv cget -scrollregion] 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3460 if {$ymax eq {} || $ymax <= 0} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3461 set view [$canv yview]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3462 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3463 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3464 if {$yfrac < 0} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3465 set yfrac 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3466 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3467 $canv yview moveto $yfrac
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3468 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3469
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3470 proc lineclick {x y id isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3471 global ctext commitinfo children cflist canv thickerline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3472
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3473 unmarkmatches
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3474 unselectline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3475 normalline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3476 $canv delete hover
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3477 # draw this line thicker than normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3478 drawlines $id 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3479 set thickerline $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3480 if {$isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3481 set ymax [lindex [$canv cget -scrollregion] 3]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3482 if {$ymax eq {}} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3483 set yfrac [lindex [$canv yview] 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3484 set y [expr {$y + $yfrac * $ymax}]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3485 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3486 set dirn [clickisonarrow $id $y]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3487 if {$dirn ne {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3488 arrowjump $id $dirn $y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3489 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3490 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3491
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3492 if {$isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3493 addtohistory [list lineclick $x $y $id 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3494 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3495 # fill the details pane with info about this line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3496 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3497 $ctext delete 0.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3498 $ctext tag conf link -foreground blue -underline 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3499 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3500 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3501 $ctext insert end "Parent:\t"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3502 $ctext insert end $id [list link link0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3503 $ctext tag bind link0 <1> [list selbyid $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3504 set info $commitinfo($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3505 $ctext insert end "\n\t[lindex $info 0]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3506 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3507 $ctext insert end "\tDate:\t[lindex $info 2]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3508 if {[info exists children($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3509 $ctext insert end "\nChildren:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3510 set i 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3511 foreach child $children($id) {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3512 incr i
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3513 set info $commitinfo($child)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3514 $ctext insert end "\n\t"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3515 $ctext insert end $child [list link link$i]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3516 $ctext tag bind link$i <1> [list selbyid $child]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3517 $ctext insert end "\n\t[lindex $info 0]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3518 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3519 $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3520 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3521 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3522 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3523
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3524 $cflist delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3525 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3526
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3527 proc normalline {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3528 global thickerline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3529 if {[info exists thickerline]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3530 drawlines $thickerline 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3531 unset thickerline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3532 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3533 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3534
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3535 proc selbyid {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3536 global idline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3537 if {[info exists idline($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3538 selectline $idline($id) 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3539 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3540 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3541
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3542 proc mstime {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3543 global startmstime
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3544 if {![info exists startmstime]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3545 set startmstime [clock clicks -milliseconds]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3546 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3547 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3548 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3549
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3550 proc rowmenu {x y id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3551 global rowctxmenu idline selectedline rowmenuid hgvdiff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3552
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3553 if {![info exists selectedline] || $idline($id) eq $selectedline} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3554 set state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3555 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3556 set state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3557 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3558 $rowctxmenu entryconfigure 0 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3559 $rowctxmenu entryconfigure 1 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3560 $rowctxmenu entryconfigure 2 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3561 if { $hgvdiff ne "" } {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3562 $rowctxmenu entryconfigure 6 -state $state
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3563 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3564 set rowmenuid $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3565 tk_popup $rowctxmenu $x $y
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3566 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3567
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3568 proc diffvssel {dirn} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3569 global rowmenuid selectedline lineid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3570
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3571 if {![info exists selectedline]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3572 if {$dirn} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3573 set oldid $lineid($selectedline)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3574 set newid $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3575 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3576 set oldid $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3577 set newid $lineid($selectedline)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3578 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3579 addtohistory [list doseldiff $oldid $newid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3580 doseldiff $oldid $newid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3581 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3582
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3583 proc doseldiff {oldid newid} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3584 global ctext cflist
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3585 global commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3586
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3587 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3588 $ctext delete 0.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3589 $ctext mark set fmark.0 0.0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3590 $ctext mark gravity fmark.0 left
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3591 $cflist delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3592 $cflist insert end "Top"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3593 $ctext insert end "From "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3594 $ctext tag conf link -foreground blue -underline 1
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3595 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3596 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3597 $ctext tag bind link0 <1> [list selbyid $oldid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3598 $ctext insert end $oldid [list link link0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3599 $ctext insert end "\n "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3600 $ctext insert end [lindex $commitinfo($oldid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3601 $ctext insert end "\n\nTo "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3602 $ctext tag bind link1 <1> [list selbyid $newid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3603 $ctext insert end $newid [list link link1]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3604 $ctext insert end "\n "
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3605 $ctext insert end [lindex $commitinfo($newid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3606 $ctext insert end "\n"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3607 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3608 $ctext tag delete Comments
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3609 $ctext tag remove found 1.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3610 startdiff [list $newid $oldid]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3611 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3612
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3613 proc mkpatch {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3614 global rowmenuid currentid commitinfo patchtop patchnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3615
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3616 if {![info exists currentid]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3617 set oldid $currentid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3618 set oldhead [lindex $commitinfo($oldid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3619 set newid $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3620 set newhead [lindex $commitinfo($newid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3621 set top .patch
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3622 set patchtop $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3623 catch {destroy $top}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3624 toplevel $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3625 label $top.title -text "Generate patch"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3626 grid $top.title - -pady 10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3627 label $top.from -text "From:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3628 entry $top.fromsha1 -width 40 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3629 $top.fromsha1 insert 0 $oldid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3630 $top.fromsha1 conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3631 grid $top.from $top.fromsha1 -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3632 entry $top.fromhead -width 60 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3633 $top.fromhead insert 0 $oldhead
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3634 $top.fromhead conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3635 grid x $top.fromhead -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3636 label $top.to -text "To:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3637 entry $top.tosha1 -width 40 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3638 $top.tosha1 insert 0 $newid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3639 $top.tosha1 conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3640 grid $top.to $top.tosha1 -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3641 entry $top.tohead -width 60 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3642 $top.tohead insert 0 $newhead
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3643 $top.tohead conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3644 grid x $top.tohead -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3645 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3646 grid $top.rev x -pady 10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3647 label $top.flab -text "Output file:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3648 entry $top.fname -width 60
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3649 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3650 incr patchnum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3651 grid $top.flab $top.fname -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3652 frame $top.buts
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3653 button $top.buts.gen -text "Generate" -command mkpatchgo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3654 button $top.buts.can -text "Cancel" -command mkpatchcan
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3655 grid $top.buts.gen $top.buts.can
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3656 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3657 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3658 grid $top.buts - -pady 10 -sticky ew
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3659 focus $top.fname
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3660 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3661
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3662 proc mkpatchrev {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3663 global patchtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3664
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3665 set oldid [$patchtop.fromsha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3666 set oldhead [$patchtop.fromhead get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3667 set newid [$patchtop.tosha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3668 set newhead [$patchtop.tohead get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3669 foreach e [list fromsha1 fromhead tosha1 tohead] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3670 v [list $newid $newhead $oldid $oldhead] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3671 $patchtop.$e conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3672 $patchtop.$e delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3673 $patchtop.$e insert 0 $v
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3674 $patchtop.$e conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3675 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3676 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3677
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3678 proc mkpatchgo {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3679 global patchtop env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3680
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3681 set oldid [$patchtop.fromsha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3682 set newid [$patchtop.tosha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3683 set fname [$patchtop.fname get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3684 if {[catch {exec $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $oldid $newid >$fname &} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3685 error_popup "Error creating patch: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3686 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3687 catch {destroy $patchtop}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3688 unset patchtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3689 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3690
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3691 proc mkpatchcan {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3692 global patchtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3693
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3694 catch {destroy $patchtop}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3695 unset patchtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3696 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3697
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3698 proc mktag {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3699 global rowmenuid mktagtop commitinfo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3700
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3701 set top .maketag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3702 set mktagtop $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3703 catch {destroy $top}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3704 toplevel $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3705 label $top.title -text "Create tag"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3706 grid $top.title - -pady 10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3707 label $top.id -text "ID:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3708 entry $top.sha1 -width 40 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3709 $top.sha1 insert 0 $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3710 $top.sha1 conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3711 grid $top.id $top.sha1 -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3712 entry $top.head -width 60 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3713 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3714 $top.head conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3715 grid x $top.head -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3716 label $top.tlab -text "Tag name:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3717 entry $top.tag -width 60
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3718 grid $top.tlab $top.tag -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3719 frame $top.buts
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3720 button $top.buts.gen -text "Create" -command mktaggo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3721 button $top.buts.can -text "Cancel" -command mktagcan
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3722 grid $top.buts.gen $top.buts.can
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3723 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3724 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3725 grid $top.buts - -pady 10 -sticky ew
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3726 focus $top.tag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3727 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3728
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3729 proc domktag {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3730 global mktagtop env tagids idtags
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3731
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3732 set id [$mktagtop.sha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3733 set tag [$mktagtop.tag get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3734 if {$tag == {}} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3735 error_popup "No tag name specified"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3736 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3737 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3738 if {[info exists tagids($tag)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3739 error_popup "Tag \"$tag\" already exists"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3740 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3741 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3742 if {[catch {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3743 set out [exec $env(HG) --config ui.report_untrusted=false tag -r $id $tag]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3744 } err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3745 error_popup "Error creating tag: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3746 return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3747 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3748
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3749 set tagids($tag) $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3750 lappend idtags($id) $tag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3751 redrawtags $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3752 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3753
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3754 proc redrawtags {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3755 global canv linehtag idline idpos selectedline
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3756
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3757 if {![info exists idline($id)]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3758 $canv delete tag.$id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3759 set xt [eval drawtags $id $idpos($id)]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3760 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3761 if {[info exists selectedline] && $selectedline == $idline($id)} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3762 selectline $selectedline 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3763 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3764 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3765
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3766 proc mktagcan {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3767 global mktagtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3768
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3769 catch {destroy $mktagtop}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3770 unset mktagtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3771 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3772
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3773 proc mktaggo {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3774 domktag
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3775 mktagcan
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3776 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3777
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3778 proc writecommit {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3779 global rowmenuid wrcomtop commitinfo wrcomcmd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3780
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3781 set top .writecommit
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3782 set wrcomtop $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3783 catch {destroy $top}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3784 toplevel $top
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3785 label $top.title -text "Write commit to file"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3786 grid $top.title - -pady 10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3787 label $top.id -text "ID:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3788 entry $top.sha1 -width 40 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3789 $top.sha1 insert 0 $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3790 $top.sha1 conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3791 grid $top.id $top.sha1 -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3792 entry $top.head -width 60 -relief flat
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3793 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3794 $top.head conf -state readonly
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3795 grid x $top.head -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3796 label $top.clab -text "Command:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3797 entry $top.cmd -width 60 -textvariable wrcomcmd
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3798 grid $top.clab $top.cmd -sticky w -pady 10
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3799 label $top.flab -text "Output file:"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3800 entry $top.fname -width 60
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3801 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3802 grid $top.flab $top.fname -sticky w
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3803 frame $top.buts
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3804 button $top.buts.gen -text "Write" -command wrcomgo
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3805 button $top.buts.can -text "Cancel" -command wrcomcan
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3806 grid $top.buts.gen $top.buts.can
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3807 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3808 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3809 grid $top.buts - -pady 10 -sticky ew
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3810 focus $top.fname
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3811 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3812
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3813 proc wrcomgo {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3814 global wrcomtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3815
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3816 set id [$wrcomtop.sha1 get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3817 set cmd "echo $id | [$wrcomtop.cmd get]"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3818 set fname [$wrcomtop.fname get]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3819 if {[catch {exec sh -c $cmd > $fname &} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3820 error_popup "Error writing commit: $err"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3821 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3822 catch {destroy $wrcomtop}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3823 unset wrcomtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3824 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3825
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3826 proc wrcomcan {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3827 global wrcomtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3828
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3829 catch {destroy $wrcomtop}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3830 unset wrcomtop
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3831 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3832
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3833 proc listrefs {id} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3834 global idtags idheads idotherrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3835
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3836 set x {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3837 if {[info exists idtags($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3838 set x $idtags($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3839 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3840 set y {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3841 if {[info exists idheads($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3842 set y $idheads($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3843 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3844 set z {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3845 if {[info exists idotherrefs($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3846 set z $idotherrefs($id)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3847 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3848 return [list $x $y $z]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3849 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3850
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3851 proc rereadrefs {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3852 global idtags idheads idotherrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3853 global tagids headids otherrefids
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3854
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3855 set refids [concat [array names idtags] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3856 [array names idheads] [array names idotherrefs]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3857 foreach id $refids {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3858 if {![info exists ref($id)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3859 set ref($id) [listrefs $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3860 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3861 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3862 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3863 catch {unset $v}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3864 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3865 readrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3866 set refids [lsort -unique [concat $refids [array names idtags] \
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3867 [array names idheads] [array names idotherrefs]]]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3868 foreach id $refids {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3869 set v [listrefs $id]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3870 if {![info exists ref($id)] || $ref($id) != $v} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3871 redrawtags $id
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3872 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3873 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3874 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3875
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3876 proc vdiff {withparent} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3877 global env rowmenuid selectedline lineid hgvdiff
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3878
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3879 if {![info exists rowmenuid]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3880 set curid $rowmenuid
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3881
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3882 if {$withparent} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3883 set parents [exec $env(HG) --config ui.report_untrusted=false parents --rev $curid --template "{node}\n"]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3884 set firstparent [lindex [split $parents "\n"] 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3885 set otherid $firstparent
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3886 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3887 if {![info exists selectedline]} return
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3888 set otherid $lineid($selectedline)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3889 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3890 set range "$otherid:$curid"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3891 if {[catch {exec $env(HG) --config ui.report_untrusted=false $hgvdiff -r $range} err]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3892 # Ignore errors, this is just visualization
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3893 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3894 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3895
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3896 proc showtag {tag isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3897 global ctext cflist tagcontents tagids linknum
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3898
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3899 if {$isnew} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3900 addtohistory [list showtag $tag 0]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3901 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3902 $ctext conf -state normal
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3903 $ctext delete 0.0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3904 set linknum 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3905 if {[info exists tagcontents($tag)]} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3906 set text $tagcontents($tag)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3907 } else {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3908 set text "Tag: $tag\nId: $tagids($tag)"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3909 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3910 appendwithlinks $text
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3911 $ctext conf -state disabled
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3912 $cflist delete 0 end
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3913 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3914
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3915 proc doquit {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3916 global stopped
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3917 set stopped 100
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3918 destroy .
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3919 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3920
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3921 proc getconfig {} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3922 global env
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3923
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3924 set lines [exec $env(HG) debug-config]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3925 regsub -all "\r\n" $lines "\n" config
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3926 set config {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3927 foreach line [split $lines "\n"] {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3928 regsub "^(k|v)=" $line "" line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3929 lappend config $line
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3930 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3931 return $config
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3932 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3933
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3934 # defaults...
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3935 set datemode 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3936 set boldnames 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3937 set diffopts "-U 5 -p"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3938 set wrcomcmd "\"\$HG\" --config ui.report_untrusted=false debug-diff-tree --stdin -p --pretty"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3939
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3940 set mainfont {Helvetica 9}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3941 set curidfont {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3942 set textfont {Courier 9}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3943 set findmergefiles 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3944 set gaudydiff 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3945 set maxgraphpct 50
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3946 set maxwidth 16
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3947
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3948 set colors {green red blue magenta darkgrey brown orange}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3949 set authorcolors {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3950 black blue deeppink mediumorchid blue burlywood4 goldenrod slateblue red2 navy dimgrey
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3951 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3952 set bgcolor white
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3953
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3954 # This color should probably be some system color (provided by tk),
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3955 # but as the bgcolor has always been set to white, I choose to ignore
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3956 set fgcolor black
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3957 set diffaddcolor "#00a000"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3958 set diffremcolor red
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3959 set diffmerge1color red
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3960 set diffmerge2color blue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3961 set hunksepcolor blue
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3962
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3963 catch {source ~/.hgk}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3964
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3965 if {$curidfont == ""} { # initialize late based on current mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3966 set curidfont "$mainfont bold italic underline"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3967 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3968
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3969 set namefont $mainfont
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3970 if {$boldnames} {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3971 lappend namefont bold
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3972 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3973
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3974 set revtreeargs {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3975 foreach arg $argv {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3976 switch -regexp -- $arg {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3977 "^$" { }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3978 "^-b" { set boldnames 1 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3979 "^-d" { set datemode 1 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3980 default {
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3981 lappend revtreeargs $arg
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3982 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3983 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3984 }
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3985
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3986 set history {}
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3987 set historyindex 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3988
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3989 set stopped 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3990 set redisplaying 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3991 set stuffsaved 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3992 set patchnum 0
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3993
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3994 array set config [getconfig]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3995 set hgvdiff $config(vdiff)
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3996 setcoords
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3997 makewindow
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3998 readrefs
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
3999 set hgroot [exec $env(HG) root]
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
4000 wm title . "hgk $hgroot"
2e52f00a3c94 Update whole hg distribution to 1.5.2
Dmitry Neverov <dmitry.neverov@jetbrains.com>
parents:
diff changeset
4001 getcommits $revtreeargs