Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1 | #!/bin/sh |
| 2 | # Tcl ignores the next line -*- tcl -*- \ |
| 3 | exec wish "$0" -- "${1+$@}" |
| 4 | |
| 5 | # Copyright (C) 2005 Paul Mackerras. All rights reserved. |
| 6 | # This program is free software; it may be used, copied, modified |
| 7 | # and distributed under the terms of the GNU General Public Licence, |
| 8 | # either version 2, or (at your option) any later version. |
| 9 | |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 10 | proc getcommits {rargs} { |
Paul Mackerras | e2ede2b | 2005-06-27 10:37:11 +1000 | [diff] [blame] | 11 | global commits commfd phase canv mainfont env |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 12 | global startmsecs nextupdate |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 13 | global ctext maincursor textcursor leftover |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 14 | |
Paul Mackerras | e2ede2b | 2005-06-27 10:37:11 +1000 | [diff] [blame] | 15 | # check that we can find a .git directory somewhere... |
| 16 | if {[info exists env(GIT_DIR)]} { |
| 17 | set gitdir $env(GIT_DIR) |
| 18 | } else { |
| 19 | set gitdir ".git" |
| 20 | } |
| 21 | if {![file isdirectory $gitdir]} { |
| 22 | error_popup "Cannot find the git directory \"$gitdir\"." |
| 23 | exit 1 |
| 24 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 25 | set commits {} |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 26 | set phase getcommits |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 27 | set startmsecs [clock clicks -milliseconds] |
| 28 | set nextupdate [expr $startmsecs + 100] |
Paul Mackerras | 2efef4b | 2005-06-21 10:20:04 +1000 | [diff] [blame] | 29 | if [catch { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 30 | set parse_args [concat --default HEAD $rargs] |
Paul Mackerras | 2efef4b | 2005-06-21 10:20:04 +1000 | [diff] [blame] | 31 | set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] |
| 32 | }] { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 33 | # if git-rev-parse failed for some reason... |
Paul Mackerras | 2efef4b | 2005-06-21 10:20:04 +1000 | [diff] [blame] | 34 | if {$rargs == {}} { |
| 35 | set rargs HEAD |
| 36 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 37 | set parsed_args $rargs |
Paul Mackerras | 2efef4b | 2005-06-21 10:20:04 +1000 | [diff] [blame] | 38 | } |
| 39 | if [catch { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 40 | set commfd [open "|git-rev-list --header --merge-order $parsed_args" r] |
Paul Mackerras | 2efef4b | 2005-06-21 10:20:04 +1000 | [diff] [blame] | 41 | } err] { |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 42 | puts stderr "Error executing git-rev-list: $err" |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 43 | exit 1 |
| 44 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 45 | set leftover {} |
| 46 | fconfigure $commfd -blocking 0 -translation binary |
| 47 | fileevent $commfd readable "getcommitlines $commfd" |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 48 | $canv delete all |
| 49 | $canv create text 3 3 -anchor nw -text "Reading commits..." \ |
| 50 | -font $mainfont -tags textitems |
Paul Mackerras | ea13cba | 2005-06-16 10:54:04 +0000 | [diff] [blame] | 51 | . config -cursor watch |
| 52 | $ctext config -cursor watch |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 53 | } |
| 54 | |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 55 | proc getcommitlines {commfd} { |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 56 | global commits parents cdate children nchildren |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 57 | global commitlisted phase commitinfo nextupdate |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 58 | global stopped redisplaying leftover |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 59 | |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 60 | set stuff [read $commfd] |
| 61 | if {$stuff == {}} { |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 62 | if {![eof $commfd]} return |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 63 | # this works around what is apparently a bug in Tcl... |
| 64 | fconfigure $commfd -blocking 1 |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 65 | if {![catch {close $commfd} err]} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 66 | after idle finishcommits |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 67 | return |
| 68 | } |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 69 | if {[string range $err 0 4] == "usage"} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 70 | set err \ |
| 71 | {Gitk: error reading commits: bad arguments to git-rev-list. |
| 72 | (Note: arguments to gitk are passed to git-rev-list |
| 73 | to allow selection of commits to be displayed.)} |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 74 | } else { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 75 | set err "Error reading commits: $err" |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 76 | } |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 77 | error_popup $err |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 78 | exit 1 |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 79 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 80 | set start 0 |
| 81 | while 1 { |
| 82 | set i [string first "\0" $stuff $start] |
| 83 | if {$i < 0} { |
Paul Mackerras | 7e952e7 | 2005-06-27 20:04:26 +1000 | [diff] [blame] | 84 | append leftover [string range $stuff $start end] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 85 | return |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 86 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 87 | set cmit [string range $stuff $start [expr {$i - 1}]] |
| 88 | if {$start == 0} { |
| 89 | set cmit "$leftover$cmit" |
Paul Mackerras | 7e952e7 | 2005-06-27 20:04:26 +1000 | [diff] [blame] | 90 | set leftover {} |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 91 | } |
| 92 | set start [expr {$i + 1}] |
| 93 | if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} { |
Paul Mackerras | 7e952e7 | 2005-06-27 20:04:26 +1000 | [diff] [blame] | 94 | set shortcmit $cmit |
| 95 | if {[string length $shortcmit] > 80} { |
| 96 | set shortcmit "[string range $shortcmit 0 80]..." |
| 97 | } |
| 98 | error_popup "Can't parse git-rev-list output: {$shortcmit}" |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 99 | exit 1 |
| 100 | } |
| 101 | set cmit [string range $cmit 41 end] |
| 102 | lappend commits $id |
| 103 | set commitlisted($id) 1 |
| 104 | parsecommit $id $cmit 1 |
| 105 | drawcommit $id |
| 106 | if {[clock clicks -milliseconds] >= $nextupdate} { |
| 107 | doupdate |
| 108 | } |
| 109 | while {$redisplaying} { |
| 110 | set redisplaying 0 |
| 111 | if {$stopped == 1} { |
| 112 | set stopped 0 |
| 113 | set phase "getcommits" |
| 114 | foreach id $commits { |
| 115 | drawcommit $id |
| 116 | if {$stopped} break |
| 117 | if {[clock clicks -milliseconds] >= $nextupdate} { |
| 118 | doupdate |
| 119 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 120 | } |
| 121 | } |
| 122 | } |
| 123 | } |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 124 | } |
| 125 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 126 | proc doupdate {} { |
| 127 | global commfd nextupdate |
| 128 | |
| 129 | incr nextupdate 100 |
| 130 | fileevent $commfd readable {} |
| 131 | update |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 132 | fileevent $commfd readable "getcommitlines $commfd" |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 133 | } |
| 134 | |
| 135 | proc readcommit {id} { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 136 | if [catch {set contents [exec git-cat-file commit $id]}] return |
| 137 | parsecommit $id $contents 0 |
| 138 | } |
| 139 | |
| 140 | proc parsecommit {id contents listed} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 141 | global commitinfo children nchildren parents nparents cdate ncleft |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 142 | |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 143 | set inhdr 1 |
| 144 | set comment {} |
| 145 | set headline {} |
| 146 | set auname {} |
| 147 | set audate {} |
| 148 | set comname {} |
| 149 | set comdate {} |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 150 | if {![info exists nchildren($id)]} { |
| 151 | set children($id) {} |
| 152 | set nchildren($id) 0 |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 153 | set ncleft($id) 0 |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 154 | } |
| 155 | set parents($id) {} |
| 156 | set nparents($id) 0 |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 157 | foreach line [split $contents "\n"] { |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 158 | if {$inhdr} { |
| 159 | if {$line == {}} { |
| 160 | set inhdr 0 |
| 161 | } else { |
| 162 | set tag [lindex $line 0] |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 163 | if {$tag == "parent"} { |
| 164 | set p [lindex $line 1] |
| 165 | if {![info exists nchildren($p)]} { |
| 166 | set children($p) {} |
| 167 | set nchildren($p) 0 |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 168 | set ncleft($p) 0 |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 169 | } |
| 170 | lappend parents($id) $p |
| 171 | incr nparents($id) |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 172 | # sometimes we get a commit that lists a parent twice... |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 173 | if {$listed && [lsearch -exact $children($p) $id] < 0} { |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 174 | lappend children($p) $id |
| 175 | incr nchildren($p) |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 176 | incr ncleft($p) |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 177 | } |
| 178 | } elseif {$tag == "author"} { |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 179 | set x [expr {[llength $line] - 2}] |
| 180 | set audate [lindex $line $x] |
| 181 | set auname [lrange $line 1 [expr {$x - 1}]] |
| 182 | } elseif {$tag == "committer"} { |
| 183 | set x [expr {[llength $line] - 2}] |
| 184 | set comdate [lindex $line $x] |
| 185 | set comname [lrange $line 1 [expr {$x - 1}]] |
| 186 | } |
| 187 | } |
| 188 | } else { |
| 189 | if {$comment == {}} { |
Paul Mackerras | 806ce09 | 2005-06-22 18:15:15 +1000 | [diff] [blame] | 190 | set headline [string trim $line] |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 191 | } else { |
| 192 | append comment "\n" |
| 193 | } |
Paul Mackerras | 806ce09 | 2005-06-22 18:15:15 +1000 | [diff] [blame] | 194 | if {!$listed} { |
| 195 | # git-rev-list indents the comment by 4 spaces; |
| 196 | # if we got this via git-cat-file, add the indentation |
| 197 | append comment " " |
| 198 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 199 | append comment $line |
| 200 | } |
| 201 | } |
| 202 | if {$audate != {}} { |
| 203 | set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] |
| 204 | } |
| 205 | if {$comdate != {}} { |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 206 | set cdate($id) $comdate |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 207 | set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] |
| 208 | } |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 209 | set commitinfo($id) [list $headline $auname $audate \ |
| 210 | $comname $comdate $comment] |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 211 | } |
| 212 | |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 213 | proc readrefs {} { |
Paul Mackerras | c2f6a02 | 2005-06-10 07:54:49 +0000 | [diff] [blame] | 214 | global tagids idtags headids idheads |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 215 | set tags [glob -nocomplain -types f .git/refs/tags/*] |
| 216 | foreach f $tags { |
| 217 | catch { |
| 218 | set fd [open $f r] |
| 219 | set line [read $fd] |
| 220 | if {[regexp {^[0-9a-f]{40}} $line id]} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 221 | set direct [file tail $f] |
| 222 | set tagids($direct) $id |
| 223 | lappend idtags($id) $direct |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 224 | set contents [split [exec git-cat-file tag $id] "\n"] |
| 225 | set obj {} |
| 226 | set type {} |
| 227 | set tag {} |
| 228 | foreach l $contents { |
| 229 | if {$l == {}} break |
| 230 | switch -- [lindex $l 0] { |
| 231 | "object" {set obj [lindex $l 1]} |
| 232 | "type" {set type [lindex $l 1]} |
| 233 | "tag" {set tag [string range $l 4 end]} |
| 234 | } |
| 235 | } |
| 236 | if {$obj != {} && $type == "commit" && $tag != {}} { |
| 237 | set tagids($tag) $obj |
| 238 | lappend idtags($obj) $tag |
| 239 | } |
| 240 | } |
Paul Mackerras | c2f6a02 | 2005-06-10 07:54:49 +0000 | [diff] [blame] | 241 | close $fd |
| 242 | } |
| 243 | } |
| 244 | set heads [glob -nocomplain -types f .git/refs/heads/*] |
| 245 | foreach f $heads { |
| 246 | catch { |
| 247 | set fd [open $f r] |
| 248 | set line [read $fd 40] |
| 249 | if {[regexp {^[0-9a-f]{40}} $line id]} { |
| 250 | set head [file tail $f] |
| 251 | set headids($head) $line |
| 252 | lappend idheads($line) $head |
| 253 | } |
| 254 | close $fd |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 255 | } |
| 256 | } |
| 257 | } |
| 258 | |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 259 | proc error_popup msg { |
| 260 | set w .error |
| 261 | toplevel $w |
| 262 | wm transient $w . |
| 263 | message $w.m -text $msg -justify center -aspect 400 |
| 264 | pack $w.m -side top -fill x -padx 20 -pady 20 |
| 265 | button $w.ok -text OK -command "destroy $w" |
| 266 | pack $w.ok -side bottom -fill x |
| 267 | bind $w <Visibility> "grab $w; focus $w" |
| 268 | tkwait window $w |
| 269 | } |
| 270 | |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 271 | proc makewindow {} { |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 272 | global canv canv2 canv3 linespc charspc ctext cflist textfont |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 273 | global findtype findtypemenu findloc findstring fstring geometry |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 274 | global entries sha1entry sha1string sha1but |
Paul Mackerras | ea13cba | 2005-06-16 10:54:04 +0000 | [diff] [blame] | 275 | global maincursor textcursor |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 276 | global rowctxmenu |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 277 | |
| 278 | menu .bar |
| 279 | .bar add cascade -label "File" -menu .bar.file |
| 280 | menu .bar.file |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 281 | .bar.file add command -label "Quit" -command doquit |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 282 | menu .bar.help |
| 283 | .bar add cascade -label "Help" -menu .bar.help |
| 284 | .bar.help add command -label "About gitk" -command about |
| 285 | . configure -menu .bar |
| 286 | |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 287 | if {![info exists geometry(canv1)]} { |
| 288 | set geometry(canv1) [expr 45 * $charspc] |
| 289 | set geometry(canv2) [expr 30 * $charspc] |
| 290 | set geometry(canv3) [expr 15 * $charspc] |
| 291 | set geometry(canvh) [expr 25 * $linespc + 4] |
| 292 | set geometry(ctextw) 80 |
| 293 | set geometry(ctexth) 30 |
| 294 | set geometry(cflistw) 30 |
| 295 | } |
Paul Mackerras | 0327d27 | 2005-05-10 00:23:42 +0000 | [diff] [blame] | 296 | panedwindow .ctop -orient vertical |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 297 | if {[info exists geometry(width)]} { |
| 298 | .ctop conf -width $geometry(width) -height $geometry(height) |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 299 | set texth [expr {$geometry(height) - $geometry(canvh) - 56}] |
| 300 | set geometry(ctexth) [expr {($texth - 8) / |
| 301 | [font metrics $textfont -linespace]}] |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 302 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 303 | frame .ctop.top |
| 304 | frame .ctop.top.bar |
| 305 | pack .ctop.top.bar -side bottom -fill x |
| 306 | set cscroll .ctop.top.csb |
| 307 | scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 |
| 308 | pack $cscroll -side right -fill y |
| 309 | panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 |
| 310 | pack .ctop.top.clist -side top -fill both -expand 1 |
| 311 | .ctop add .ctop.top |
| 312 | set canv .ctop.top.clist.canv |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 313 | canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 314 | -bg white -bd 0 \ |
| 315 | -yscrollincr $linespc -yscrollcommand "$cscroll set" |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 316 | .ctop.top.clist add $canv |
| 317 | set canv2 .ctop.top.clist.canv2 |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 318 | canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 319 | -bg white -bd 0 -yscrollincr $linespc |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 320 | .ctop.top.clist add $canv2 |
| 321 | set canv3 .ctop.top.clist.canv3 |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 322 | canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 323 | -bg white -bd 0 -yscrollincr $linespc |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 324 | .ctop.top.clist add $canv3 |
Paul Mackerras | 43bddeb | 2005-05-15 23:19:18 +0000 | [diff] [blame] | 325 | bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 326 | |
| 327 | set sha1entry .ctop.top.bar.sha1 |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 328 | set entries $sha1entry |
| 329 | set sha1but .ctop.top.bar.sha1label |
| 330 | button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ |
| 331 | -command gotocommit -width 8 |
| 332 | $sha1but conf -disabledforeground [$sha1but cget -foreground] |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 333 | pack .ctop.top.bar.sha1label -side left |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 334 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
| 335 | trace add variable sha1string write sha1change |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 336 | pack $sha1entry -side left -pady 2 |
| 337 | button .ctop.top.bar.findbut -text "Find" -command dofind |
| 338 | pack .ctop.top.bar.findbut -side left |
| 339 | set findstring {} |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 340 | set fstring .ctop.top.bar.findstring |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 341 | lappend entries $fstring |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 342 | entry $fstring -width 30 -font $textfont -textvariable findstring |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 343 | pack $fstring -side left -expand 1 -fill x |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 344 | set findtype Exact |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 345 | set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ |
| 346 | findtype Exact IgnCase Regexp] |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 347 | set findloc "All fields" |
| 348 | tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 349 | Comments Author Committer Files Pickaxe |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 350 | pack .ctop.top.bar.findloc -side right |
| 351 | pack .ctop.top.bar.findtype -side right |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 352 | # for making sure type==Exact whenever loc==Pickaxe |
| 353 | trace add variable findloc write findlocchange |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 354 | |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 355 | panedwindow .ctop.cdet -orient horizontal |
| 356 | .ctop add .ctop.cdet |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 357 | frame .ctop.cdet.left |
| 358 | set ctext .ctop.cdet.left.ctext |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 359 | text $ctext -bg white -state disabled -font $textfont \ |
| 360 | -width $geometry(ctextw) -height $geometry(ctexth) \ |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 361 | -yscrollcommand ".ctop.cdet.left.sb set" |
| 362 | scrollbar .ctop.cdet.left.sb -command "$ctext yview" |
| 363 | pack .ctop.cdet.left.sb -side right -fill y |
| 364 | pack $ctext -side left -fill both -expand 1 |
| 365 | .ctop.cdet add .ctop.cdet.left |
| 366 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 367 | $ctext tag conf filesep -font [concat $textfont bold] |
| 368 | $ctext tag conf hunksep -back blue -fore white |
| 369 | $ctext tag conf d0 -back "#ff8080" |
| 370 | $ctext tag conf d1 -back green |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 371 | $ctext tag conf found -back yellow |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 372 | |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 373 | frame .ctop.cdet.right |
| 374 | set cflist .ctop.cdet.right.cfiles |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 375 | listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 376 | -yscrollcommand ".ctop.cdet.right.sb set" |
| 377 | scrollbar .ctop.cdet.right.sb -command "$cflist yview" |
| 378 | pack .ctop.cdet.right.sb -side right -fill y |
| 379 | pack $cflist -side left -fill both -expand 1 |
| 380 | .ctop.cdet add .ctop.cdet.right |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 381 | bind .ctop.cdet <Configure> {resizecdetpanes %W %w} |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 382 | |
Paul Mackerras | 0327d27 | 2005-05-10 00:23:42 +0000 | [diff] [blame] | 383 | pack .ctop -side top -fill both -expand 1 |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 384 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 385 | bindall <1> {selcanvline %W %x %y} |
| 386 | #bindall <B1-Motion> {selcanvline %W %x %y} |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 387 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
| 388 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 389 | bindall <2> "allcanvs scan mark 0 %y" |
| 390 | bindall <B2-Motion> "allcanvs scan dragto 0 %y" |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 391 | bind . <Key-Up> "selnextline -1" |
| 392 | bind . <Key-Down> "selnextline 1" |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 393 | bind . <Key-Prior> "allcanvs yview scroll -1 pages" |
| 394 | bind . <Key-Next> "allcanvs yview scroll 1 pages" |
| 395 | bindkey <Key-Delete> "$ctext yview scroll -1 pages" |
| 396 | bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" |
| 397 | bindkey <Key-space> "$ctext yview scroll 1 pages" |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 398 | bindkey p "selnextline -1" |
| 399 | bindkey n "selnextline 1" |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 400 | bindkey b "$ctext yview scroll -1 pages" |
| 401 | bindkey d "$ctext yview scroll 18 units" |
| 402 | bindkey u "$ctext yview scroll -18 units" |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 403 | bindkey / {findnext 1} |
| 404 | bindkey <Key-Return> {findnext 0} |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 405 | bindkey ? findprev |
Paul Mackerras | 39ad857 | 2005-05-19 12:35:53 +0000 | [diff] [blame] | 406 | bindkey f nextfile |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 407 | bind . <Control-q> doquit |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 408 | bind . <Control-f> dofind |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 409 | bind . <Control-g> {findnext 0} |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 410 | bind . <Control-r> findprev |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 411 | bind . <Control-equal> {incrfont 1} |
| 412 | bind . <Control-KP_Add> {incrfont 1} |
| 413 | bind . <Control-minus> {incrfont -1} |
| 414 | bind . <Control-KP_Subtract> {incrfont -1} |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 415 | bind $cflist <<ListboxSelect>> listboxsel |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 416 | bind . <Destroy> {savestuff %W} |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 417 | bind . <Button-1> "click %W" |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 418 | bind $fstring <Key-Return> dofind |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 419 | bind $sha1entry <Key-Return> gotocommit |
Paul Mackerras | ee3dc72 | 2005-06-25 16:37:13 +1000 | [diff] [blame] | 420 | bind $sha1entry <<PasteSelection>> clearsha1 |
Paul Mackerras | ea13cba | 2005-06-16 10:54:04 +0000 | [diff] [blame] | 421 | |
| 422 | set maincursor [. cget -cursor] |
| 423 | set textcursor [$ctext cget -cursor] |
Paul Mackerras | 84ba734 | 2005-06-17 00:12:26 +0000 | [diff] [blame] | 424 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 425 | set rowctxmenu .rowctxmenu |
| 426 | menu $rowctxmenu -tearoff 0 |
| 427 | $rowctxmenu add command -label "Diff this -> selected" \ |
| 428 | -command {diffvssel 0} |
| 429 | $rowctxmenu add command -label "Diff selected -> this" \ |
| 430 | -command {diffvssel 1} |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 431 | $rowctxmenu add command -label "Make patch" -command mkpatch |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 432 | $rowctxmenu add command -label "Create tag" -command mktag |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 433 | $rowctxmenu add command -label "Write commit to file" -command writecommit |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 434 | } |
| 435 | |
| 436 | # when we make a key binding for the toplevel, make sure |
| 437 | # it doesn't get triggered when that key is pressed in the |
| 438 | # find string entry widget. |
| 439 | proc bindkey {ev script} { |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 440 | global entries |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 441 | bind . $ev $script |
| 442 | set escript [bind Entry $ev] |
| 443 | if {$escript == {}} { |
| 444 | set escript [bind Entry <Key>] |
| 445 | } |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 446 | foreach e $entries { |
| 447 | bind $e $ev "$escript; break" |
| 448 | } |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 449 | } |
| 450 | |
| 451 | # set the focus back to the toplevel for any click outside |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 452 | # the entry widgets |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 453 | proc click {w} { |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 454 | global entries |
| 455 | foreach e $entries { |
| 456 | if {$w == $e} return |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 457 | } |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 458 | focus . |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 459 | } |
| 460 | |
| 461 | proc savestuff {w} { |
| 462 | global canv canv2 canv3 ctext cflist mainfont textfont |
| 463 | global stuffsaved |
| 464 | if {$stuffsaved} return |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 465 | if {![winfo viewable .]} return |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 466 | catch { |
| 467 | set f [open "~/.gitk-new" w] |
| 468 | puts $f "set mainfont {$mainfont}" |
| 469 | puts $f "set textfont {$textfont}" |
| 470 | puts $f "set geometry(width) [winfo width .ctop]" |
| 471 | puts $f "set geometry(height) [winfo height .ctop]" |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 472 | puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" |
| 473 | puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" |
| 474 | puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" |
| 475 | puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 476 | set wid [expr {([winfo width $ctext] - 8) \ |
| 477 | / [font measure $textfont "0"]}] |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 478 | puts $f "set geometry(ctextw) $wid" |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 479 | set wid [expr {([winfo width $cflist] - 11) \ |
| 480 | / [font measure [$cflist cget -font] "0"]}] |
| 481 | puts $f "set geometry(cflistw) $wid" |
| 482 | close $f |
| 483 | file rename -force "~/.gitk-new" "~/.gitk" |
| 484 | } |
| 485 | set stuffsaved 1 |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 486 | } |
| 487 | |
Paul Mackerras | 43bddeb | 2005-05-15 23:19:18 +0000 | [diff] [blame] | 488 | proc resizeclistpanes {win w} { |
| 489 | global oldwidth |
| 490 | if [info exists oldwidth($win)] { |
| 491 | set s0 [$win sash coord 0] |
| 492 | set s1 [$win sash coord 1] |
| 493 | if {$w < 60} { |
| 494 | set sash0 [expr {int($w/2 - 2)}] |
| 495 | set sash1 [expr {int($w*5/6 - 2)}] |
| 496 | } else { |
| 497 | set factor [expr {1.0 * $w / $oldwidth($win)}] |
| 498 | set sash0 [expr {int($factor * [lindex $s0 0])}] |
| 499 | set sash1 [expr {int($factor * [lindex $s1 0])}] |
| 500 | if {$sash0 < 30} { |
| 501 | set sash0 30 |
| 502 | } |
| 503 | if {$sash1 < $sash0 + 20} { |
| 504 | set sash1 [expr $sash0 + 20] |
| 505 | } |
| 506 | if {$sash1 > $w - 10} { |
| 507 | set sash1 [expr $w - 10] |
| 508 | if {$sash0 > $sash1 - 20} { |
| 509 | set sash0 [expr $sash1 - 20] |
| 510 | } |
| 511 | } |
| 512 | } |
| 513 | $win sash place 0 $sash0 [lindex $s0 1] |
| 514 | $win sash place 1 $sash1 [lindex $s1 1] |
| 515 | } |
| 516 | set oldwidth($win) $w |
| 517 | } |
| 518 | |
| 519 | proc resizecdetpanes {win w} { |
| 520 | global oldwidth |
| 521 | if [info exists oldwidth($win)] { |
| 522 | set s0 [$win sash coord 0] |
| 523 | if {$w < 60} { |
| 524 | set sash0 [expr {int($w*3/4 - 2)}] |
| 525 | } else { |
| 526 | set factor [expr {1.0 * $w / $oldwidth($win)}] |
| 527 | set sash0 [expr {int($factor * [lindex $s0 0])}] |
| 528 | if {$sash0 < 45} { |
| 529 | set sash0 45 |
| 530 | } |
| 531 | if {$sash0 > $w - 15} { |
| 532 | set sash0 [expr $w - 15] |
| 533 | } |
| 534 | } |
| 535 | $win sash place 0 $sash0 [lindex $s0 1] |
| 536 | } |
| 537 | set oldwidth($win) $w |
| 538 | } |
| 539 | |
Paul Mackerras | b5721c7 | 2005-05-10 12:08:22 +0000 | [diff] [blame] | 540 | proc allcanvs args { |
| 541 | global canv canv2 canv3 |
| 542 | eval $canv $args |
| 543 | eval $canv2 $args |
| 544 | eval $canv3 $args |
| 545 | } |
| 546 | |
| 547 | proc bindall {event action} { |
| 548 | global canv canv2 canv3 |
| 549 | bind $canv $event $action |
| 550 | bind $canv2 $event $action |
| 551 | bind $canv3 $event $action |
| 552 | } |
| 553 | |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 554 | proc about {} { |
| 555 | set w .about |
| 556 | if {[winfo exists $w]} { |
| 557 | raise $w |
| 558 | return |
| 559 | } |
| 560 | toplevel $w |
| 561 | wm title $w "About gitk" |
| 562 | message $w.m -text { |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 563 | Gitk version 1.2 |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 564 | |
| 565 | Copyright © 2005 Paul Mackerras |
| 566 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 567 | Use and redistribute under the terms of the GNU General Public License} \ |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 568 | -justify center -aspect 400 |
| 569 | pack $w.m -side top -fill x -padx 20 -pady 20 |
| 570 | button $w.ok -text Close -command "destroy $w" |
| 571 | pack $w.ok -side bottom |
| 572 | } |
| 573 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 574 | proc assigncolor {id} { |
| 575 | global commitinfo colormap commcolors colors nextcolor |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 576 | global parents nparents children nchildren |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 577 | global cornercrossings crossings |
| 578 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 579 | if [info exists colormap($id)] return |
| 580 | set ncolors [llength $colors] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 581 | if {$nparents($id) <= 1 && $nchildren($id) == 1} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 582 | set child [lindex $children($id) 0] |
| 583 | if {[info exists colormap($child)] |
| 584 | && $nparents($child) == 1} { |
| 585 | set colormap($id) $colormap($child) |
| 586 | return |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 587 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 588 | } |
| 589 | set badcolors {} |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 590 | if {[info exists cornercrossings($id)]} { |
| 591 | foreach x $cornercrossings($id) { |
| 592 | if {[info exists colormap($x)] |
| 593 | && [lsearch -exact $badcolors $colormap($x)] < 0} { |
| 594 | lappend badcolors $colormap($x) |
| 595 | } |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 596 | } |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 597 | if {[llength $badcolors] >= $ncolors} { |
| 598 | set badcolors {} |
| 599 | } |
| 600 | } |
| 601 | set origbad $badcolors |
| 602 | if {[llength $badcolors] < $ncolors - 1} { |
| 603 | if {[info exists crossings($id)]} { |
| 604 | foreach x $crossings($id) { |
| 605 | if {[info exists colormap($x)] |
| 606 | && [lsearch -exact $badcolors $colormap($x)] < 0} { |
| 607 | lappend badcolors $colormap($x) |
| 608 | } |
| 609 | } |
| 610 | if {[llength $badcolors] >= $ncolors} { |
| 611 | set badcolors $origbad |
| 612 | } |
| 613 | } |
| 614 | set origbad $badcolors |
| 615 | } |
| 616 | if {[llength $badcolors] < $ncolors - 1} { |
| 617 | foreach child $children($id) { |
| 618 | if {[info exists colormap($child)] |
| 619 | && [lsearch -exact $badcolors $colormap($child)] < 0} { |
| 620 | lappend badcolors $colormap($child) |
| 621 | } |
| 622 | if {[info exists parents($child)]} { |
| 623 | foreach p $parents($child) { |
| 624 | if {[info exists colormap($p)] |
| 625 | && [lsearch -exact $badcolors $colormap($p)] < 0} { |
| 626 | lappend badcolors $colormap($p) |
| 627 | } |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 628 | } |
| 629 | } |
| 630 | } |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 631 | if {[llength $badcolors] >= $ncolors} { |
| 632 | set badcolors $origbad |
| 633 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 634 | } |
| 635 | for {set i 0} {$i <= $ncolors} {incr i} { |
| 636 | set c [lindex $colors $nextcolor] |
| 637 | if {[incr nextcolor] >= $ncolors} { |
| 638 | set nextcolor 0 |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 639 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 640 | if {[lsearch -exact $badcolors $c]} break |
| 641 | } |
| 642 | set colormap($id) $c |
| 643 | } |
| 644 | |
| 645 | proc initgraph {} { |
| 646 | global canvy canvy0 lineno numcommits lthickness nextcolor linespc |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 647 | global mainline sidelines |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 648 | global nchildren ncleft |
| 649 | |
| 650 | allcanvs delete all |
| 651 | set nextcolor 0 |
| 652 | set canvy $canvy0 |
| 653 | set lineno -1 |
| 654 | set numcommits 0 |
| 655 | set lthickness [expr {int($linespc / 9) + 1}] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 656 | catch {unset mainline} |
| 657 | catch {unset sidelines} |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 658 | foreach id [array names nchildren] { |
| 659 | set ncleft($id) $nchildren($id) |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 660 | } |
| 661 | } |
| 662 | |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 663 | proc bindline {t id} { |
| 664 | global canv |
| 665 | |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 666 | $canv bind $t <Enter> "lineenter %x %y $id" |
| 667 | $canv bind $t <Motion> "linemotion %x %y $id" |
| 668 | $canv bind $t <Leave> "lineleave $id" |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 669 | $canv bind $t <Button-1> "lineclick %x %y $id" |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 670 | } |
| 671 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 672 | proc drawcommitline {level} { |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 673 | global parents children nparents nchildren todo |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 674 | global canv canv2 canv3 mainfont namefont canvx0 canvy linespc |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 675 | global lineid linehtag linentag linedtag commitinfo |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 676 | global colormap numcommits currentparents dupparents |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 677 | global oldlevel oldnlines oldtodo |
| 678 | global idtags idline idheads |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 679 | global lineno lthickness mainline sidelines |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 680 | global commitlisted rowtextx idpos |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 681 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 682 | incr numcommits |
| 683 | incr lineno |
| 684 | set id [lindex $todo $level] |
| 685 | set lineid($lineno) $id |
| 686 | set idline($id) $lineno |
| 687 | set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] |
| 688 | if {![info exists commitinfo($id)]} { |
| 689 | readcommit $id |
| 690 | if {![info exists commitinfo($id)]} { |
| 691 | set commitinfo($id) {"No commit information available"} |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 692 | set nparents($id) 0 |
| 693 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 694 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 695 | assigncolor $id |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 696 | set currentparents {} |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 697 | set dupparents {} |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 698 | if {[info exists commitlisted($id)] && [info exists parents($id)]} { |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 699 | foreach p $parents($id) { |
| 700 | if {[lsearch -exact $currentparents $p] < 0} { |
| 701 | lappend currentparents $p |
| 702 | } else { |
| 703 | # remember that this parent was listed twice |
| 704 | lappend dupparents $p |
| 705 | } |
| 706 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 707 | } |
| 708 | set x [expr $canvx0 + $level * $linespc] |
| 709 | set y1 $canvy |
| 710 | set canvy [expr $canvy + $linespc] |
| 711 | allcanvs conf -scrollregion \ |
| 712 | [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 713 | if {[info exists mainline($id)]} { |
| 714 | lappend mainline($id) $x $y1 |
| 715 | set t [$canv create line $mainline($id) \ |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 716 | -width $lthickness -fill $colormap($id)] |
| 717 | $canv lower $t |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 718 | bindline $t $id |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 719 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 720 | if {[info exists sidelines($id)]} { |
| 721 | foreach ls $sidelines($id) { |
| 722 | set coords [lindex $ls 0] |
| 723 | set thick [lindex $ls 1] |
| 724 | set t [$canv create line $coords -fill $colormap($id) \ |
| 725 | -width [expr {$thick * $lthickness}]] |
| 726 | $canv lower $t |
| 727 | bindline $t $id |
| 728 | } |
| 729 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 730 | set orad [expr {$linespc / 3}] |
| 731 | set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ |
| 732 | [expr $x + $orad - 1] [expr $y1 + $orad - 1] \ |
| 733 | -fill $ofill -outline black -width 1] |
| 734 | $canv raise $t |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 735 | $canv bind $t <1> {selcanvline {} %x %y} |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 736 | set xt [expr $canvx0 + [llength $todo] * $linespc] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 737 | if {[llength $currentparents] > 2} { |
| 738 | set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 739 | } |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 740 | set rowtextx($lineno) $xt |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 741 | set idpos($id) [list $x $xt $y1] |
| 742 | if {[info exists idtags($id)] || [info exists idheads($id)]} { |
| 743 | set xt [drawtags $id $x $xt $y1] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 744 | } |
| 745 | set headline [lindex $commitinfo($id) 0] |
| 746 | set name [lindex $commitinfo($id) 1] |
| 747 | set date [lindex $commitinfo($id) 2] |
| 748 | set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ |
| 749 | -text $headline -font $mainfont ] |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 750 | $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id" |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 751 | set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ |
| 752 | -text $name -font $namefont] |
| 753 | set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ |
| 754 | -text $date -font $mainfont] |
| 755 | } |
| 756 | |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 757 | proc drawtags {id x xt y1} { |
| 758 | global idtags idheads |
| 759 | global linespc lthickness |
| 760 | global canv mainfont |
| 761 | |
| 762 | set marks {} |
| 763 | set ntags 0 |
| 764 | if {[info exists idtags($id)]} { |
| 765 | set marks $idtags($id) |
| 766 | set ntags [llength $marks] |
| 767 | } |
| 768 | if {[info exists idheads($id)]} { |
| 769 | set marks [concat $marks $idheads($id)] |
| 770 | } |
| 771 | if {$marks eq {}} { |
| 772 | return $xt |
| 773 | } |
| 774 | |
| 775 | set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
| 776 | set yt [expr $y1 - 0.5 * $linespc] |
| 777 | set yb [expr $yt + $linespc - 1] |
| 778 | set xvals {} |
| 779 | set wvals {} |
| 780 | foreach tag $marks { |
| 781 | set wid [font measure $mainfont $tag] |
| 782 | lappend xvals $xt |
| 783 | lappend wvals $wid |
| 784 | set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
| 785 | } |
| 786 | set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ |
| 787 | -width $lthickness -fill black -tags tag.$id] |
| 788 | $canv lower $t |
| 789 | foreach tag $marks x $xvals wid $wvals { |
| 790 | set xl [expr $x + $delta] |
| 791 | set xr [expr $x + $delta + $wid + $lthickness] |
| 792 | if {[incr ntags -1] >= 0} { |
| 793 | # draw a tag |
| 794 | $canv create polygon $x [expr $yt + $delta] $xl $yt\ |
| 795 | $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
| 796 | -width 1 -outline black -fill yellow -tags tag.$id |
| 797 | } else { |
| 798 | # draw a head |
| 799 | set xl [expr $xl - $delta/2] |
| 800 | $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
| 801 | -width 1 -outline black -fill green -tags tag.$id |
| 802 | } |
| 803 | $canv create text $xl $y1 -anchor w -text $tag \ |
| 804 | -font $mainfont -tags tag.$id |
| 805 | } |
| 806 | return $xt |
| 807 | } |
| 808 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 809 | proc updatetodo {level noshortcut} { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 810 | global currentparents ncleft todo |
| 811 | global mainline oldlevel oldtodo oldnlines |
| 812 | global canvx0 canvy linespc mainline |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 813 | global commitinfo |
| 814 | |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 815 | set oldlevel $level |
| 816 | set oldtodo $todo |
| 817 | set oldnlines [llength $todo] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 818 | if {!$noshortcut && [llength $currentparents] == 1} { |
| 819 | set p [lindex $currentparents 0] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 820 | if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { |
| 821 | set ncleft($p) 0 |
| 822 | set x [expr $canvx0 + $level * $linespc] |
| 823 | set y [expr $canvy - $linespc] |
| 824 | set mainline($p) [list $x $y] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 825 | set todo [lreplace $todo $level $level $p] |
| 826 | return 0 |
| 827 | } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 828 | } |
| 829 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 830 | set todo [lreplace $todo $level $level] |
| 831 | set i $level |
| 832 | foreach p $currentparents { |
| 833 | incr ncleft($p) -1 |
| 834 | set k [lsearch -exact $todo $p] |
| 835 | if {$k < 0} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 836 | set todo [linsert $todo $i $p] |
| 837 | incr i |
| 838 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 839 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 840 | return 1 |
| 841 | } |
| 842 | |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 843 | proc notecrossings {id lo hi corner} { |
| 844 | global oldtodo crossings cornercrossings |
| 845 | |
| 846 | for {set i $lo} {[incr i] < $hi} {} { |
| 847 | set p [lindex $oldtodo $i] |
| 848 | if {$p == {}} continue |
| 849 | if {$i == $corner} { |
| 850 | if {![info exists cornercrossings($id)] |
| 851 | || [lsearch -exact $cornercrossings($id) $p] < 0} { |
| 852 | lappend cornercrossings($id) $p |
| 853 | } |
| 854 | if {![info exists cornercrossings($p)] |
| 855 | || [lsearch -exact $cornercrossings($p) $id] < 0} { |
| 856 | lappend cornercrossings($p) $id |
| 857 | } |
| 858 | } else { |
| 859 | if {![info exists crossings($id)] |
| 860 | || [lsearch -exact $crossings($id) $p] < 0} { |
| 861 | lappend crossings($id) $p |
| 862 | } |
| 863 | if {![info exists crossings($p)] |
| 864 | || [lsearch -exact $crossings($p) $id] < 0} { |
| 865 | lappend crossings($p) $id |
| 866 | } |
| 867 | } |
| 868 | } |
| 869 | } |
| 870 | |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 871 | proc drawslants {} { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 872 | global canv mainline sidelines canvx0 canvy linespc |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 873 | global oldlevel oldtodo todo currentparents dupparents |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 874 | global lthickness linespc canvy colormap |
| 875 | |
| 876 | set y1 [expr $canvy - $linespc] |
| 877 | set y2 $canvy |
| 878 | set i -1 |
| 879 | foreach id $oldtodo { |
| 880 | incr i |
| 881 | if {$id == {}} continue |
| 882 | set xi [expr {$canvx0 + $i * $linespc}] |
| 883 | if {$i == $oldlevel} { |
| 884 | foreach p $currentparents { |
| 885 | set j [lsearch -exact $todo $p] |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 886 | set coords [list $xi $y1] |
| 887 | set xj [expr {$canvx0 + $j * $linespc}] |
| 888 | if {$j < $i - 1} { |
| 889 | lappend coords [expr $xj + $linespc] $y1 |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 890 | notecrossings $p $j $i [expr {$j + 1}] |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 891 | } elseif {$j > $i + 1} { |
| 892 | lappend coords [expr $xj - $linespc] $y1 |
Paul Mackerras | 6c20ff3 | 2005-06-22 19:53:32 +1000 | [diff] [blame] | 893 | notecrossings $p $i $j [expr {$j - 1}] |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 894 | } |
| 895 | if {[lsearch -exact $dupparents $p] >= 0} { |
| 896 | # draw a double-width line to indicate the doubled parent |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 897 | lappend coords $xj $y2 |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 898 | lappend sidelines($p) [list $coords 2] |
| 899 | if {![info exists mainline($p)]} { |
| 900 | set mainline($p) [list $xj $y2] |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 901 | } |
| 902 | } else { |
| 903 | # normal case, no parent duplicated |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 904 | if {![info exists mainline($p)]} { |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 905 | if {$i != $j} { |
| 906 | lappend coords $xj $y2 |
| 907 | } |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 908 | set mainline($p) $coords |
Paul Mackerras | 84ba734 | 2005-06-17 00:12:26 +0000 | [diff] [blame] | 909 | } else { |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 910 | lappend coords $xj $y2 |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 911 | lappend sidelines($p) [list $coords 1] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 912 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 913 | } |
| 914 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 915 | } elseif {[lindex $todo $i] != $id} { |
| 916 | set j [lsearch -exact $todo $id] |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 917 | set xj [expr {$canvx0 + $j * $linespc}] |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 918 | lappend mainline($id) $xi $y1 $xj $y2 |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 919 | } |
| 920 | } |
| 921 | } |
| 922 | |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 923 | proc decidenext {{noread 0}} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 924 | global parents children nchildren ncleft todo |
| 925 | global canv canv2 canv3 mainfont namefont canvx0 canvy linespc |
| 926 | global datemode cdate |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 927 | global commitinfo |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 928 | global currentparents oldlevel oldnlines oldtodo |
| 929 | global lineno lthickness |
| 930 | |
| 931 | # remove the null entry if present |
| 932 | set nullentry [lsearch -exact $todo {}] |
| 933 | if {$nullentry >= 0} { |
| 934 | set todo [lreplace $todo $nullentry $nullentry] |
| 935 | } |
| 936 | |
| 937 | # choose which one to do next time around |
| 938 | set todol [llength $todo] |
| 939 | set level -1 |
| 940 | set latest {} |
| 941 | for {set k $todol} {[incr k -1] >= 0} {} { |
| 942 | set p [lindex $todo $k] |
| 943 | if {$ncleft($p) == 0} { |
| 944 | if {$datemode} { |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 945 | if {![info exists commitinfo($p)]} { |
| 946 | if {$noread} { |
| 947 | return {} |
| 948 | } |
| 949 | readcommit $p |
| 950 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 951 | if {$latest == {} || $cdate($p) > $latest} { |
| 952 | set level $k |
| 953 | set latest $cdate($p) |
| 954 | } |
| 955 | } else { |
| 956 | set level $k |
| 957 | break |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 958 | } |
| 959 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 960 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 961 | if {$level < 0} { |
| 962 | if {$todo != {}} { |
| 963 | puts "ERROR: none of the pending commits can be done yet:" |
| 964 | foreach p $todo { |
Paul Mackerras | b490a99 | 2005-06-22 10:25:38 +1000 | [diff] [blame] | 965 | puts " $p ($ncleft($p))" |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 966 | } |
| 967 | } |
| 968 | return -1 |
| 969 | } |
| 970 | |
| 971 | # If we are reducing, put in a null entry |
| 972 | if {$todol < $oldnlines} { |
| 973 | if {$nullentry >= 0} { |
| 974 | set i $nullentry |
| 975 | while {$i < $todol |
| 976 | && [lindex $oldtodo $i] == [lindex $todo $i]} { |
| 977 | incr i |
| 978 | } |
| 979 | } else { |
| 980 | set i $oldlevel |
| 981 | if {$level >= $i} { |
| 982 | incr i |
| 983 | } |
| 984 | } |
| 985 | if {$i < $todol} { |
| 986 | set todo [linsert $todo $i {}] |
| 987 | if {$level >= $i} { |
| 988 | incr level |
| 989 | } |
| 990 | } |
| 991 | } |
| 992 | return $level |
| 993 | } |
| 994 | |
| 995 | proc drawcommit {id} { |
| 996 | global phase todo nchildren datemode nextupdate |
| 997 | global startcommits |
| 998 | |
| 999 | if {$phase != "incrdraw"} { |
| 1000 | set phase incrdraw |
| 1001 | set todo $id |
| 1002 | set startcommits $id |
| 1003 | initgraph |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1004 | drawcommitline 0 |
| 1005 | updatetodo 0 $datemode |
| 1006 | } else { |
| 1007 | if {$nchildren($id) == 0} { |
| 1008 | lappend todo $id |
| 1009 | lappend startcommits $id |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1010 | } |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 1011 | set level [decidenext 1] |
| 1012 | if {$level == {} || $id != [lindex $todo $level]} { |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1013 | return |
| 1014 | } |
| 1015 | while 1 { |
| 1016 | drawslants |
| 1017 | drawcommitline $level |
| 1018 | if {[updatetodo $level $datemode]} { |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 1019 | set level [decidenext 1] |
| 1020 | if {$level == {}} break |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1021 | } |
| 1022 | set id [lindex $todo $level] |
| 1023 | if {![info exists commitlisted($id)]} { |
| 1024 | break |
| 1025 | } |
| 1026 | if {[clock clicks -milliseconds] >= $nextupdate} { |
| 1027 | doupdate |
| 1028 | if {$stopped} break |
| 1029 | } |
| 1030 | } |
| 1031 | } |
| 1032 | } |
| 1033 | |
| 1034 | proc finishcommits {} { |
| 1035 | global phase |
| 1036 | global startcommits |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 1037 | global canv mainfont ctext maincursor textcursor |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1038 | |
| 1039 | if {$phase != "incrdraw"} { |
| 1040 | $canv delete all |
| 1041 | $canv create text 3 3 -anchor nw -text "No commits selected" \ |
| 1042 | -font $mainfont -tags textitems |
| 1043 | set phase {} |
Paul Mackerras | 8a0a74a | 2005-06-27 13:38:29 +1000 | [diff] [blame] | 1044 | } else { |
| 1045 | drawslants |
| 1046 | set level [decidenext] |
| 1047 | drawrest $level [llength $startcommits] |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1048 | } |
Paul Mackerras | ea13cba | 2005-06-16 10:54:04 +0000 | [diff] [blame] | 1049 | . config -cursor $maincursor |
| 1050 | $ctext config -cursor $textcursor |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1051 | } |
| 1052 | |
| 1053 | proc drawgraph {} { |
| 1054 | global nextupdate startmsecs startcommits todo |
| 1055 | |
| 1056 | if {$startcommits == {}} return |
| 1057 | set startmsecs [clock clicks -milliseconds] |
| 1058 | set nextupdate [expr $startmsecs + 100] |
| 1059 | initgraph |
| 1060 | set todo [lindex $startcommits 0] |
| 1061 | drawrest 0 1 |
| 1062 | } |
| 1063 | |
| 1064 | proc drawrest {level startix} { |
| 1065 | global phase stopped redisplaying selectedline |
| 1066 | global datemode currentparents todo |
| 1067 | global numcommits |
| 1068 | global nextupdate startmsecs startcommits idline |
| 1069 | |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 1070 | if {$level >= 0} { |
| 1071 | set phase drawgraph |
| 1072 | set startid [lindex $startcommits $startix] |
| 1073 | set startline -1 |
| 1074 | if {$startid != {}} { |
| 1075 | set startline $idline($startid) |
| 1076 | } |
| 1077 | while 1 { |
| 1078 | if {$stopped} break |
| 1079 | drawcommitline $level |
| 1080 | set hard [updatetodo $level $datemode] |
| 1081 | if {$numcommits == $startline} { |
| 1082 | lappend todo $startid |
| 1083 | set hard 1 |
| 1084 | incr startix |
| 1085 | set startid [lindex $startcommits $startix] |
| 1086 | set startline -1 |
| 1087 | if {$startid != {}} { |
| 1088 | set startline $idline($startid) |
| 1089 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1090 | } |
Paul Mackerras | a823a91 | 2005-06-21 10:01:38 +1000 | [diff] [blame] | 1091 | if {$hard} { |
| 1092 | set level [decidenext] |
| 1093 | if {$level < 0} break |
| 1094 | drawslants |
| 1095 | } |
| 1096 | if {[clock clicks -milliseconds] >= $nextupdate} { |
| 1097 | update |
| 1098 | incr nextupdate 100 |
| 1099 | } |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1100 | } |
| 1101 | } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1102 | set phase {} |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1103 | set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] |
Paul Mackerras | 84ba734 | 2005-06-17 00:12:26 +0000 | [diff] [blame] | 1104 | #puts "overall $drawmsecs ms for $numcommits commits" |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1105 | if {$redisplaying} { |
| 1106 | if {$stopped == 0 && [info exists selectedline]} { |
| 1107 | selectline $selectedline |
| 1108 | } |
| 1109 | if {$stopped == 1} { |
| 1110 | set stopped 0 |
| 1111 | after idle drawgraph |
| 1112 | } else { |
| 1113 | set redisplaying 0 |
| 1114 | } |
| 1115 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1116 | } |
| 1117 | |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1118 | proc findmatches {f} { |
| 1119 | global findtype foundstring foundstrlen |
| 1120 | if {$findtype == "Regexp"} { |
| 1121 | set matches [regexp -indices -all -inline $foundstring $f] |
| 1122 | } else { |
| 1123 | if {$findtype == "IgnCase"} { |
| 1124 | set str [string tolower $f] |
| 1125 | } else { |
| 1126 | set str $f |
| 1127 | } |
| 1128 | set matches {} |
| 1129 | set i 0 |
| 1130 | while {[set j [string first $foundstring $str $i]] >= 0} { |
| 1131 | lappend matches [list $j [expr $j+$foundstrlen-1]] |
| 1132 | set i [expr $j + $foundstrlen] |
| 1133 | } |
| 1134 | } |
| 1135 | return $matches |
| 1136 | } |
| 1137 | |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1138 | proc dofind {} { |
| 1139 | global findtype findloc findstring markedmatches commitinfo |
| 1140 | global numcommits lineid linehtag linentag linedtag |
| 1141 | global mainfont namefont canv canv2 canv3 selectedline |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1142 | global matchinglines foundstring foundstrlen |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1143 | |
| 1144 | stopfindproc |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1145 | unmarkmatches |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1146 | focus . |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1147 | set matchinglines {} |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1148 | if {$findloc == "Pickaxe"} { |
| 1149 | findpatches |
| 1150 | return |
| 1151 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1152 | if {$findtype == "IgnCase"} { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1153 | set foundstring [string tolower $findstring] |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1154 | } else { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1155 | set foundstring $findstring |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1156 | } |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1157 | set foundstrlen [string length $findstring] |
| 1158 | if {$foundstrlen == 0} return |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1159 | if {$findloc == "Files"} { |
| 1160 | findfiles |
| 1161 | return |
| 1162 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1163 | if {![info exists selectedline]} { |
| 1164 | set oldsel -1 |
| 1165 | } else { |
| 1166 | set oldsel $selectedline |
| 1167 | } |
| 1168 | set didsel 0 |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1169 | set fldtypes {Headline Author Date Committer CDate Comment} |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1170 | for {set l 0} {$l < $numcommits} {incr l} { |
| 1171 | set id $lineid($l) |
| 1172 | set info $commitinfo($id) |
| 1173 | set doesmatch 0 |
| 1174 | foreach f $info ty $fldtypes { |
| 1175 | if {$findloc != "All fields" && $findloc != $ty} { |
| 1176 | continue |
| 1177 | } |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1178 | set matches [findmatches $f] |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1179 | if {$matches == {}} continue |
| 1180 | set doesmatch 1 |
| 1181 | if {$ty == "Headline"} { |
| 1182 | markmatches $canv $l $f $linehtag($l) $matches $mainfont |
| 1183 | } elseif {$ty == "Author"} { |
| 1184 | markmatches $canv2 $l $f $linentag($l) $matches $namefont |
| 1185 | } elseif {$ty == "Date"} { |
| 1186 | markmatches $canv3 $l $f $linedtag($l) $matches $mainfont |
| 1187 | } |
| 1188 | } |
| 1189 | if {$doesmatch} { |
| 1190 | lappend matchinglines $l |
| 1191 | if {!$didsel && $l > $oldsel} { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1192 | findselectline $l |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1193 | set didsel 1 |
| 1194 | } |
| 1195 | } |
| 1196 | } |
| 1197 | if {$matchinglines == {}} { |
| 1198 | bell |
| 1199 | } elseif {!$didsel} { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1200 | findselectline [lindex $matchinglines 0] |
| 1201 | } |
| 1202 | } |
| 1203 | |
| 1204 | proc findselectline {l} { |
| 1205 | global findloc commentend ctext |
| 1206 | selectline $l |
| 1207 | if {$findloc == "All fields" || $findloc == "Comments"} { |
| 1208 | # highlight the matches in the comments |
| 1209 | set f [$ctext get 1.0 $commentend] |
| 1210 | set matches [findmatches $f] |
| 1211 | foreach match $matches { |
| 1212 | set start [lindex $match 0] |
| 1213 | set end [expr [lindex $match 1] + 1] |
| 1214 | $ctext tag add found "1.0 + $start c" "1.0 + $end c" |
| 1215 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1216 | } |
| 1217 | } |
| 1218 | |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1219 | proc findnext {restart} { |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1220 | global matchinglines selectedline |
| 1221 | if {![info exists matchinglines]} { |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1222 | if {$restart} { |
| 1223 | dofind |
| 1224 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1225 | return |
| 1226 | } |
| 1227 | if {![info exists selectedline]} return |
| 1228 | foreach l $matchinglines { |
| 1229 | if {$l > $selectedline} { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1230 | findselectline $l |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1231 | return |
| 1232 | } |
| 1233 | } |
| 1234 | bell |
| 1235 | } |
| 1236 | |
| 1237 | proc findprev {} { |
| 1238 | global matchinglines selectedline |
| 1239 | if {![info exists matchinglines]} { |
| 1240 | dofind |
| 1241 | return |
| 1242 | } |
| 1243 | if {![info exists selectedline]} return |
| 1244 | set prev {} |
| 1245 | foreach l $matchinglines { |
| 1246 | if {$l >= $selectedline} break |
| 1247 | set prev $l |
| 1248 | } |
| 1249 | if {$prev != {}} { |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1250 | findselectline $prev |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1251 | } else { |
| 1252 | bell |
| 1253 | } |
| 1254 | } |
| 1255 | |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1256 | proc findlocchange {name ix op} { |
| 1257 | global findloc findtype findtypemenu |
| 1258 | if {$findloc == "Pickaxe"} { |
| 1259 | set findtype Exact |
| 1260 | set state disabled |
| 1261 | } else { |
| 1262 | set state normal |
| 1263 | } |
| 1264 | $findtypemenu entryconf 1 -state $state |
| 1265 | $findtypemenu entryconf 2 -state $state |
| 1266 | } |
| 1267 | |
| 1268 | proc stopfindproc {{done 0}} { |
| 1269 | global findprocpid findprocfile findids |
| 1270 | global ctext findoldcursor phase maincursor textcursor |
| 1271 | global findinprogress |
| 1272 | |
| 1273 | catch {unset findids} |
| 1274 | if {[info exists findprocpid]} { |
| 1275 | if {!$done} { |
| 1276 | catch {exec kill $findprocpid} |
| 1277 | } |
| 1278 | catch {close $findprocfile} |
| 1279 | unset findprocpid |
| 1280 | } |
| 1281 | if {[info exists findinprogress]} { |
| 1282 | unset findinprogress |
| 1283 | if {$phase != "incrdraw"} { |
| 1284 | . config -cursor $maincursor |
| 1285 | $ctext config -cursor $textcursor |
| 1286 | } |
| 1287 | } |
| 1288 | } |
| 1289 | |
| 1290 | proc findpatches {} { |
| 1291 | global findstring selectedline numcommits |
| 1292 | global findprocpid findprocfile |
| 1293 | global finddidsel ctext lineid findinprogress |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1294 | global findinsertpos |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1295 | |
| 1296 | if {$numcommits == 0} return |
| 1297 | |
| 1298 | # make a list of all the ids to search, starting at the one |
| 1299 | # after the selected line (if any) |
| 1300 | if {[info exists selectedline]} { |
| 1301 | set l $selectedline |
| 1302 | } else { |
| 1303 | set l -1 |
| 1304 | } |
| 1305 | set inputids {} |
| 1306 | for {set i 0} {$i < $numcommits} {incr i} { |
| 1307 | if {[incr l] >= $numcommits} { |
| 1308 | set l 0 |
| 1309 | } |
| 1310 | append inputids $lineid($l) "\n" |
| 1311 | } |
| 1312 | |
| 1313 | if {[catch { |
| 1314 | set f [open [list | git-diff-tree --stdin -s -r -S$findstring \ |
| 1315 | << $inputids] r] |
| 1316 | } err]} { |
| 1317 | error_popup "Error starting search process: $err" |
| 1318 | return |
| 1319 | } |
| 1320 | |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1321 | set findinsertpos end |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1322 | set findprocfile $f |
| 1323 | set findprocpid [pid $f] |
| 1324 | fconfigure $f -blocking 0 |
| 1325 | fileevent $f readable readfindproc |
| 1326 | set finddidsel 0 |
| 1327 | . config -cursor watch |
| 1328 | $ctext config -cursor watch |
| 1329 | set findinprogress 1 |
| 1330 | } |
| 1331 | |
| 1332 | proc readfindproc {} { |
| 1333 | global findprocfile finddidsel |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1334 | global idline matchinglines findinsertpos |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1335 | |
| 1336 | set n [gets $findprocfile line] |
| 1337 | if {$n < 0} { |
| 1338 | if {[eof $findprocfile]} { |
| 1339 | stopfindproc 1 |
| 1340 | if {!$finddidsel} { |
| 1341 | bell |
| 1342 | } |
| 1343 | } |
| 1344 | return |
| 1345 | } |
| 1346 | if {![regexp {^[0-9a-f]{40}} $line id]} { |
| 1347 | error_popup "Can't parse git-diff-tree output: $line" |
| 1348 | stopfindproc |
| 1349 | return |
| 1350 | } |
| 1351 | if {![info exists idline($id)]} { |
| 1352 | puts stderr "spurious id: $id" |
| 1353 | return |
| 1354 | } |
| 1355 | set l $idline($id) |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1356 | insertmatch $l $id |
| 1357 | } |
| 1358 | |
| 1359 | proc insertmatch {l id} { |
| 1360 | global matchinglines findinsertpos finddidsel |
| 1361 | |
| 1362 | if {$findinsertpos == "end"} { |
| 1363 | if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { |
| 1364 | set matchinglines [linsert $matchinglines 0 $l] |
| 1365 | set findinsertpos 1 |
| 1366 | } else { |
| 1367 | lappend matchinglines $l |
| 1368 | } |
| 1369 | } else { |
| 1370 | set matchinglines [linsert $matchinglines $findinsertpos $l] |
| 1371 | incr findinsertpos |
| 1372 | } |
| 1373 | markheadline $l $id |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1374 | if {!$finddidsel} { |
| 1375 | findselectline $l |
| 1376 | set finddidsel 1 |
| 1377 | } |
| 1378 | } |
| 1379 | |
| 1380 | proc findfiles {} { |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1381 | global selectedline numcommits lineid ctext |
| 1382 | global ffileline finddidsel parents nparents |
| 1383 | global findinprogress findstartline findinsertpos |
| 1384 | global treediffs fdiffids fdiffsneeded fdiffpos |
| 1385 | global findmergefiles |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1386 | |
| 1387 | if {$numcommits == 0} return |
| 1388 | |
| 1389 | if {[info exists selectedline]} { |
| 1390 | set l [expr {$selectedline + 1}] |
| 1391 | } else { |
| 1392 | set l 0 |
| 1393 | } |
| 1394 | set ffileline $l |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1395 | set findstartline $l |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1396 | set diffsneeded {} |
| 1397 | set fdiffsneeded {} |
| 1398 | while 1 { |
| 1399 | set id $lineid($l) |
| 1400 | if {$findmergefiles || $nparents($id) == 1} { |
| 1401 | foreach p $parents($id) { |
| 1402 | if {![info exists treediffs([list $id $p])]} { |
| 1403 | append diffsneeded "$id $p\n" |
| 1404 | lappend fdiffsneeded [list $id $p] |
| 1405 | } |
| 1406 | } |
| 1407 | } |
| 1408 | if {[incr l] >= $numcommits} { |
| 1409 | set l 0 |
| 1410 | } |
| 1411 | if {$l == $findstartline} break |
| 1412 | } |
| 1413 | |
| 1414 | # start off a git-diff-tree process if needed |
| 1415 | if {$diffsneeded ne {}} { |
| 1416 | if {[catch { |
| 1417 | set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r] |
| 1418 | } err ]} { |
| 1419 | error_popup "Error starting search process: $err" |
| 1420 | return |
| 1421 | } |
| 1422 | catch {unset fdiffids} |
| 1423 | set fdiffpos 0 |
| 1424 | fconfigure $df -blocking 0 |
| 1425 | fileevent $df readable [list readfilediffs $df] |
| 1426 | } |
| 1427 | |
| 1428 | set finddidsel 0 |
| 1429 | set findinsertpos end |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1430 | set id $lineid($l) |
| 1431 | set p [lindex $parents($id) 0] |
| 1432 | . config -cursor watch |
| 1433 | $ctext config -cursor watch |
| 1434 | set findinprogress 1 |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1435 | findcont [list $id $p] |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1436 | update |
| 1437 | } |
| 1438 | |
| 1439 | proc readfilediffs {df} { |
| 1440 | global findids fdiffids fdiffs |
| 1441 | |
| 1442 | set n [gets $df line] |
| 1443 | if {$n < 0} { |
| 1444 | if {[eof $df]} { |
| 1445 | donefilediff |
| 1446 | if {[catch {close $df} err]} { |
| 1447 | stopfindproc |
| 1448 | bell |
| 1449 | error_popup "Error in git-diff-tree: $err" |
| 1450 | } elseif {[info exists findids]} { |
| 1451 | set ids $findids |
| 1452 | stopfindproc |
| 1453 | bell |
| 1454 | error_popup "Couldn't find diffs for {$ids}" |
| 1455 | } |
| 1456 | } |
| 1457 | return |
| 1458 | } |
| 1459 | if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} { |
| 1460 | # start of a new string of diffs |
| 1461 | donefilediff |
| 1462 | set fdiffids [list $id $p] |
| 1463 | set fdiffs {} |
| 1464 | } elseif {[string match ":*" $line]} { |
| 1465 | lappend fdiffs [lindex $line 5] |
| 1466 | } |
| 1467 | } |
| 1468 | |
| 1469 | proc donefilediff {} { |
| 1470 | global fdiffids fdiffs treediffs findids |
| 1471 | global fdiffsneeded fdiffpos |
| 1472 | |
| 1473 | if {[info exists fdiffids]} { |
| 1474 | while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids |
| 1475 | && $fdiffpos < [llength $fdiffsneeded]} { |
| 1476 | # git-diff-tree doesn't output anything for a commit |
| 1477 | # which doesn't change anything |
| 1478 | set nullids [lindex $fdiffsneeded $fdiffpos] |
| 1479 | set treediffs($nullids) {} |
| 1480 | if {[info exists findids] && $nullids eq $findids} { |
| 1481 | unset findids |
| 1482 | findcont $nullids |
| 1483 | } |
| 1484 | incr fdiffpos |
| 1485 | } |
| 1486 | incr fdiffpos |
| 1487 | |
| 1488 | if {![info exists treediffs($fdiffids)]} { |
| 1489 | set treediffs($fdiffids) $fdiffs |
| 1490 | } |
| 1491 | if {[info exists findids] && $fdiffids eq $findids} { |
| 1492 | unset findids |
| 1493 | findcont $fdiffids |
| 1494 | } |
| 1495 | } |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1496 | } |
| 1497 | |
| 1498 | proc findcont {ids} { |
| 1499 | global findids treediffs parents nparents treepending |
| 1500 | global ffileline findstartline finddidsel |
| 1501 | global lineid numcommits matchinglines findinprogress |
| 1502 | global findmergefiles |
| 1503 | |
| 1504 | set id [lindex $ids 0] |
| 1505 | set p [lindex $ids 1] |
| 1506 | set pi [lsearch -exact $parents($id) $p] |
| 1507 | set l $ffileline |
| 1508 | while 1 { |
| 1509 | if {$findmergefiles || $nparents($id) == 1} { |
| 1510 | if {![info exists treediffs($ids)]} { |
| 1511 | set findids $ids |
| 1512 | set ffileline $l |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1513 | return |
| 1514 | } |
| 1515 | set doesmatch 0 |
| 1516 | foreach f $treediffs($ids) { |
| 1517 | set x [findmatches $f] |
| 1518 | if {$x != {}} { |
| 1519 | set doesmatch 1 |
| 1520 | break |
| 1521 | } |
| 1522 | } |
| 1523 | if {$doesmatch} { |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1524 | insertmatch $l $id |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1525 | set pi $nparents($id) |
| 1526 | } |
| 1527 | } else { |
| 1528 | set pi $nparents($id) |
| 1529 | } |
| 1530 | if {[incr pi] >= $nparents($id)} { |
| 1531 | set pi 0 |
| 1532 | if {[incr l] >= $numcommits} { |
| 1533 | set l 0 |
| 1534 | } |
| 1535 | if {$l == $findstartline} break |
| 1536 | set id $lineid($l) |
| 1537 | } |
| 1538 | set p [lindex $parents($id) $pi] |
| 1539 | set ids [list $id $p] |
| 1540 | } |
| 1541 | stopfindproc |
| 1542 | if {!$finddidsel} { |
| 1543 | bell |
| 1544 | } |
| 1545 | } |
| 1546 | |
| 1547 | # mark a commit as matching by putting a yellow background |
| 1548 | # behind the headline |
| 1549 | proc markheadline {l id} { |
| 1550 | global canv mainfont linehtag commitinfo |
| 1551 | |
| 1552 | set bbox [$canv bbox $linehtag($l)] |
| 1553 | set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] |
| 1554 | $canv lower $t |
| 1555 | } |
| 1556 | |
| 1557 | # mark the bits of a headline, author or date that match a find string |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1558 | proc markmatches {canv l str tag matches font} { |
| 1559 | set bbox [$canv bbox $tag] |
| 1560 | set x0 [lindex $bbox 0] |
| 1561 | set y0 [lindex $bbox 1] |
| 1562 | set y1 [lindex $bbox 3] |
| 1563 | foreach match $matches { |
| 1564 | set start [lindex $match 0] |
| 1565 | set end [lindex $match 1] |
| 1566 | if {$start > $end} continue |
| 1567 | set xoff [font measure $font [string range $str 0 [expr $start-1]]] |
| 1568 | set xlen [font measure $font [string range $str 0 [expr $end]]] |
| 1569 | set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ |
| 1570 | -outline {} -tags matches -fill yellow] |
| 1571 | $canv lower $t |
| 1572 | } |
| 1573 | } |
| 1574 | |
| 1575 | proc unmarkmatches {} { |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1576 | global matchinglines findids |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1577 | allcanvs delete matches |
| 1578 | catch {unset matchinglines} |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1579 | catch {unset findids} |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1580 | } |
| 1581 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1582 | proc selcanvline {w x y} { |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1583 | global canv canvy0 ctext linespc selectedline |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1584 | global lineid linehtag linentag linedtag rowtextx |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1585 | set ymax [lindex [$canv cget -scrollregion] 3] |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 1586 | if {$ymax == {}} return |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1587 | set yfrac [lindex [$canv yview] 0] |
| 1588 | set y [expr {$y + $yfrac * $ymax}] |
| 1589 | set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] |
| 1590 | if {$l < 0} { |
| 1591 | set l 0 |
| 1592 | } |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1593 | if {$w eq $canv} { |
| 1594 | if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return |
| 1595 | } |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1596 | unmarkmatches |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1597 | selectline $l |
| 1598 | } |
| 1599 | |
| 1600 | proc selectline {l} { |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1601 | global canv canv2 canv3 ctext commitinfo selectedline |
| 1602 | global lineid linehtag linentag linedtag |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1603 | global canvy0 linespc parents nparents |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1604 | global cflist currentid sha1entry |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1605 | global commentend seenfile idtags |
Paul Mackerras | 84ba734 | 2005-06-17 00:12:26 +0000 | [diff] [blame] | 1606 | $canv delete hover |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1607 | if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1608 | $canv delete secsel |
| 1609 | set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ |
| 1610 | -tags secsel -fill [$canv cget -selectbackground]] |
| 1611 | $canv lower $t |
| 1612 | $canv2 delete secsel |
| 1613 | set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ |
| 1614 | -tags secsel -fill [$canv2 cget -selectbackground]] |
| 1615 | $canv2 lower $t |
| 1616 | $canv3 delete secsel |
| 1617 | set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ |
| 1618 | -tags secsel -fill [$canv3 cget -selectbackground]] |
| 1619 | $canv3 lower $t |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1620 | set y [expr {$canvy0 + $l * $linespc}] |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1621 | set ymax [lindex [$canv cget -scrollregion] 3] |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1622 | set ytop [expr {$y - $linespc - 1}] |
| 1623 | set ybot [expr {$y + $linespc + 1}] |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1624 | set wnow [$canv yview] |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1625 | set wtop [expr [lindex $wnow 0] * $ymax] |
| 1626 | set wbot [expr [lindex $wnow 1] * $ymax] |
| 1627 | set wh [expr {$wbot - $wtop}] |
| 1628 | set newtop $wtop |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1629 | if {$ytop < $wtop} { |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1630 | if {$ybot < $wtop} { |
| 1631 | set newtop [expr {$y - $wh / 2.0}] |
| 1632 | } else { |
| 1633 | set newtop $ytop |
| 1634 | if {$newtop > $wtop - $linespc} { |
| 1635 | set newtop [expr {$wtop - $linespc}] |
| 1636 | } |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1637 | } |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1638 | } elseif {$ybot > $wbot} { |
| 1639 | if {$ytop > $wbot} { |
| 1640 | set newtop [expr {$y - $wh / 2.0}] |
| 1641 | } else { |
| 1642 | set newtop [expr {$ybot - $wh}] |
| 1643 | if {$newtop < $wtop + $linespc} { |
| 1644 | set newtop [expr {$wtop + $linespc}] |
| 1645 | } |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1646 | } |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1647 | } |
| 1648 | if {$newtop != $wtop} { |
| 1649 | if {$newtop < 0} { |
| 1650 | set newtop 0 |
| 1651 | } |
| 1652 | allcanvs yview moveto [expr $newtop * 1.0 / $ymax] |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1653 | } |
| 1654 | set selectedline $l |
| 1655 | |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1656 | set id $lineid($l) |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 1657 | set currentid $id |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1658 | $sha1entry delete 0 end |
| 1659 | $sha1entry insert 0 $id |
| 1660 | $sha1entry selection from 0 |
| 1661 | $sha1entry selection to end |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1662 | |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1663 | $ctext conf -state normal |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1664 | $ctext delete 0.0 end |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1665 | $ctext mark set fmark.0 0.0 |
| 1666 | $ctext mark gravity fmark.0 left |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1667 | set info $commitinfo($id) |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1668 | $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" |
| 1669 | $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 1670 | if {[info exists idtags($id)]} { |
| 1671 | $ctext insert end "Tags:" |
| 1672 | foreach tag $idtags($id) { |
| 1673 | $ctext insert end " $tag" |
| 1674 | } |
| 1675 | $ctext insert end "\n" |
| 1676 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1677 | $ctext insert end "\n" |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1678 | $ctext insert end [lindex $info 5] |
| 1679 | $ctext insert end "\n" |
| 1680 | $ctext tag delete Comments |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1681 | $ctext tag remove found 1.0 end |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1682 | $ctext conf -state disabled |
Paul Mackerras | df3d83b | 2005-05-17 23:23:07 +0000 | [diff] [blame] | 1683 | set commentend [$ctext index "end - 1c"] |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1684 | |
| 1685 | $cflist delete 0 end |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1686 | $cflist insert end "Comments" |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1687 | startdiff $id $parents($id) |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1688 | } |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1689 | |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1690 | proc startdiff {id vs} { |
| 1691 | global diffpending diffpindex |
| 1692 | global diffindex difffilestart seenfile |
| 1693 | global curdifftag curtagstart |
| 1694 | |
| 1695 | set diffpending $vs |
| 1696 | set diffpindex 0 |
| 1697 | catch {unset seenfile} |
| 1698 | set diffindex 0 |
| 1699 | catch {unset difffilestart} |
| 1700 | set curdifftag Comments |
| 1701 | set curtagstart 0.0 |
| 1702 | contdiff [list $id [lindex $vs 0]] |
| 1703 | } |
| 1704 | |
| 1705 | proc contdiff {ids} { |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1706 | global treediffs diffids treepending |
| 1707 | |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1708 | if {![info exists treediffs($ids)]} { |
| 1709 | set diffids $ids |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1710 | if {![info exists treepending]} { |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1711 | gettreediffs $ids |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1712 | } |
| 1713 | } else { |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1714 | addtocflist $ids |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1715 | } |
| 1716 | } |
| 1717 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1718 | proc selnextline {dir} { |
| 1719 | global selectedline |
| 1720 | if {![info exists selectedline]} return |
| 1721 | set l [expr $selectedline + $dir] |
Paul Mackerras | 98f350e | 2005-05-15 05:56:51 +0000 | [diff] [blame] | 1722 | unmarkmatches |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1723 | selectline $l |
Paul Mackerras | 5ad588d | 2005-05-10 01:02:55 +0000 | [diff] [blame] | 1724 | } |
| 1725 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1726 | proc addtocflist {ids} { |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1727 | global treediffs cflist diffpindex |
| 1728 | |
| 1729 | set colors {black blue green red cyan magenta} |
| 1730 | set color [lindex $colors [expr {$diffpindex % [llength $colors]}]] |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1731 | foreach f $treediffs($ids) { |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1732 | $cflist insert end $f |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1733 | $cflist itemconf end -foreground $color |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1734 | } |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1735 | getblobdiffs $ids |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1736 | } |
| 1737 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1738 | proc gettreediffs {ids} { |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1739 | global treediffs parents treepending |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1740 | set treepending $ids |
| 1741 | set treediffs($ids) {} |
| 1742 | set id [lindex $ids 0] |
| 1743 | set p [lindex $ids 1] |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1744 | if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return |
| 1745 | fconfigure $gdtf -blocking 0 |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1746 | fileevent $gdtf readable "gettreediffline $gdtf {$ids}" |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1747 | } |
| 1748 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1749 | proc gettreediffline {gdtf ids} { |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 1750 | global treediffs treepending diffids |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1751 | set n [gets $gdtf line] |
| 1752 | if {$n < 0} { |
| 1753 | if {![eof $gdtf]} return |
| 1754 | close $gdtf |
| 1755 | unset treepending |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1756 | if {[info exists diffids]} { |
| 1757 | if {$ids != $diffids} { |
| 1758 | gettreediffs $diffids |
| 1759 | } else { |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 1760 | addtocflist $ids |
| 1761 | } |
| 1762 | } |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1763 | return |
| 1764 | } |
Paul Mackerras | d4e95cb | 2005-06-01 00:02:13 +0000 | [diff] [blame] | 1765 | set file [lindex $line 5] |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1766 | lappend treediffs($ids) $file |
Paul Mackerras | d2610d1 | 2005-05-11 00:45:38 +0000 | [diff] [blame] | 1767 | } |
| 1768 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1769 | proc getblobdiffs {ids} { |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1770 | global diffopts blobdifffd diffids env |
| 1771 | global nextupdate |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1772 | |
| 1773 | set id [lindex $ids 0] |
| 1774 | set p [lindex $ids 1] |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1775 | set env(GIT_DIFF_OPTS) $diffopts |
| 1776 | if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] { |
| 1777 | puts "error getting diffs: $err" |
| 1778 | return |
| 1779 | } |
| 1780 | fconfigure $bdf -blocking 0 |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1781 | set blobdifffd($ids) $bdf |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1782 | fileevent $bdf readable [list getblobdiffline $bdf $ids] |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1783 | set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1784 | } |
| 1785 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1786 | proc getblobdiffline {bdf ids} { |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1787 | global diffids blobdifffd ctext curdifftag curtagstart seenfile |
Paul Mackerras | 39ad857 | 2005-05-19 12:35:53 +0000 | [diff] [blame] | 1788 | global diffnexthead diffnextnote diffindex difffilestart |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1789 | global nextupdate diffpending diffpindex |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1790 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1791 | set n [gets $bdf line] |
| 1792 | if {$n < 0} { |
| 1793 | if {[eof $bdf]} { |
| 1794 | close $bdf |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1795 | if {$ids == $diffids && $bdf == $blobdifffd($ids)} { |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1796 | $ctext tag add $curdifftag $curtagstart end |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1797 | set seenfile($curdifftag) 1 |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1798 | if {[incr diffpindex] < [llength $diffpending]} { |
| 1799 | set id [lindex $ids 0] |
| 1800 | set p [lindex $diffpending $diffpindex] |
| 1801 | contdiff [list $id $p] |
| 1802 | } |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1803 | } |
| 1804 | } |
| 1805 | return |
| 1806 | } |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1807 | if {$ids != $diffids || $bdf != $blobdifffd($ids)} { |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1808 | return |
| 1809 | } |
| 1810 | $ctext conf -state normal |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1811 | if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} { |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1812 | # start of a new file |
| 1813 | $ctext insert end "\n" |
| 1814 | $ctext tag add $curdifftag $curtagstart end |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1815 | set seenfile($curdifftag) 1 |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1816 | set curtagstart [$ctext index "end - 1c"] |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1817 | set header $fname |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1818 | if {[info exists diffnexthead]} { |
| 1819 | set fname $diffnexthead |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1820 | set header "$diffnexthead ($diffnextnote)" |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1821 | unset diffnexthead |
| 1822 | } |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1823 | set here [$ctext index "end - 1c"] |
| 1824 | set difffilestart($diffindex) $here |
Paul Mackerras | 39ad857 | 2005-05-19 12:35:53 +0000 | [diff] [blame] | 1825 | incr diffindex |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1826 | # start mark names at fmark.1 for first file |
| 1827 | $ctext mark set fmark.$diffindex $here |
| 1828 | $ctext mark gravity fmark.$diffindex left |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1829 | set curdifftag "f:$fname" |
| 1830 | $ctext tag delete $curdifftag |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1831 | set l [expr {(78 - [string length $header]) / 2}] |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1832 | set pad [string range "----------------------------------------" 1 $l] |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1833 | $ctext insert end "$pad $header $pad\n" filesep |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1834 | } elseif {[string range $line 0 2] == "+++"} { |
| 1835 | # no need to do anything with this |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1836 | } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} { |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1837 | set diffnexthead $fn |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1838 | set diffnextnote "created, mode $m" |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1839 | } elseif {[string range $line 0 8] == "Deleted: "} { |
| 1840 | set diffnexthead [string range $line 9 end] |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1841 | set diffnextnote "deleted" |
Paul Mackerras | 39ad857 | 2005-05-19 12:35:53 +0000 | [diff] [blame] | 1842 | } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} { |
| 1843 | # save the filename in case the next thing is "new file mode ..." |
| 1844 | set diffnexthead $fn |
| 1845 | set diffnextnote "modified" |
| 1846 | } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} { |
| 1847 | set diffnextnote "new file, mode $m" |
| 1848 | } elseif {[string range $line 0 11] == "deleted file"} { |
| 1849 | set diffnextnote "deleted" |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1850 | } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
| 1851 | $line match f1l f1c f2l f2c rest]} { |
| 1852 | $ctext insert end "\t" hunksep |
| 1853 | $ctext insert end " $f1l " d0 " $f2l " d1 |
| 1854 | $ctext insert end " $rest \n" hunksep |
| 1855 | } else { |
| 1856 | set x [string range $line 0 0] |
| 1857 | if {$x == "-" || $x == "+"} { |
| 1858 | set tag [expr {$x == "+"}] |
| 1859 | set line [string range $line 1 end] |
| 1860 | $ctext insert end "$line\n" d$tag |
| 1861 | } elseif {$x == " "} { |
| 1862 | set line [string range $line 1 end] |
| 1863 | $ctext insert end "$line\n" |
Paul Mackerras | 5842215 | 2005-05-19 10:56:42 +0000 | [diff] [blame] | 1864 | } elseif {$x == "\\"} { |
| 1865 | # e.g. "\ No newline at end of file" |
| 1866 | $ctext insert end "$line\n" filesep |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1867 | } else { |
| 1868 | # Something else we don't recognize |
| 1869 | if {$curdifftag != "Comments"} { |
| 1870 | $ctext insert end "\n" |
| 1871 | $ctext tag add $curdifftag $curtagstart end |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 1872 | set seenfile($curdifftag) 1 |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1873 | set curtagstart [$ctext index "end - 1c"] |
| 1874 | set curdifftag Comments |
| 1875 | } |
| 1876 | $ctext insert end "$line\n" filesep |
| 1877 | } |
| 1878 | } |
| 1879 | $ctext conf -state disabled |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1880 | if {[clock clicks -milliseconds] >= $nextupdate} { |
| 1881 | incr nextupdate 100 |
| 1882 | fileevent $bdf readable {} |
| 1883 | update |
| 1884 | fileevent $bdf readable "getblobdiffline $bdf {$ids}" |
| 1885 | } |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1886 | } |
| 1887 | |
Paul Mackerras | 39ad857 | 2005-05-19 12:35:53 +0000 | [diff] [blame] | 1888 | proc nextfile {} { |
| 1889 | global difffilestart ctext |
| 1890 | set here [$ctext index @0,0] |
| 1891 | for {set i 0} {[info exists difffilestart($i)]} {incr i} { |
| 1892 | if {[$ctext compare $difffilestart($i) > $here]} { |
| 1893 | $ctext yview $difffilestart($i) |
| 1894 | break |
| 1895 | } |
| 1896 | } |
| 1897 | } |
| 1898 | |
Paul Mackerras | e5c2d85 | 2005-05-11 23:44:54 +0000 | [diff] [blame] | 1899 | proc listboxsel {} { |
Paul Mackerras | e2ed432 | 2005-07-17 03:39:44 -0400 | [diff] [blame^] | 1900 | global ctext cflist currentid treediffs |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 1901 | if {![info exists currentid]} return |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 1902 | set sel [lsort [$cflist curselection]] |
| 1903 | if {$sel eq {}} return |
| 1904 | set first [lindex $sel 0] |
| 1905 | catch {$ctext yview fmark.$first} |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1906 | } |
| 1907 | |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1908 | proc setcoords {} { |
| 1909 | global linespc charspc canvx0 canvy0 mainfont |
| 1910 | set linespc [font metrics $mainfont -linespace] |
| 1911 | set charspc [font measure $mainfont "m"] |
| 1912 | set canvy0 [expr 3 + 0.5 * $linespc] |
| 1913 | set canvx0 [expr 3 + 0.5 * $linespc] |
Paul Mackerras | 9a40c50 | 2005-05-12 23:46:16 +0000 | [diff] [blame] | 1914 | } |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1915 | |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1916 | proc redisplay {} { |
| 1917 | global selectedline stopped redisplaying phase |
| 1918 | if {$stopped > 1} return |
| 1919 | if {$phase == "getcommits"} return |
| 1920 | set redisplaying 1 |
Paul Mackerras | 9ccbdfb | 2005-06-16 00:27:23 +0000 | [diff] [blame] | 1921 | if {$phase == "drawgraph" || $phase == "incrdraw"} { |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1922 | set stopped 1 |
| 1923 | } else { |
| 1924 | drawgraph |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1925 | } |
| 1926 | } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1927 | |
| 1928 | proc incrfont {inc} { |
| 1929 | global mainfont namefont textfont selectedline ctext canv phase |
Paul Mackerras | cfb4563 | 2005-05-31 12:14:42 +0000 | [diff] [blame] | 1930 | global stopped entries |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1931 | unmarkmatches |
| 1932 | set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] |
| 1933 | set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] |
| 1934 | set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] |
| 1935 | setcoords |
| 1936 | $ctext conf -font $textfont |
| 1937 | $ctext tag conf filesep -font [concat $textfont bold] |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 1938 | foreach e $entries { |
| 1939 | $e conf -font $mainfont |
| 1940 | } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1941 | if {$phase == "getcommits"} { |
| 1942 | $canv itemconf textitems -font $mainfont |
| 1943 | } |
| 1944 | redisplay |
Paul Mackerras | 1db95b0 | 2005-05-09 04:08:39 +0000 | [diff] [blame] | 1945 | } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 1946 | |
Paul Mackerras | ee3dc72 | 2005-06-25 16:37:13 +1000 | [diff] [blame] | 1947 | proc clearsha1 {} { |
| 1948 | global sha1entry sha1string |
| 1949 | if {[string length $sha1string] == 40} { |
| 1950 | $sha1entry delete 0 end |
| 1951 | } |
| 1952 | } |
| 1953 | |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 1954 | proc sha1change {n1 n2 op} { |
| 1955 | global sha1string currentid sha1but |
| 1956 | if {$sha1string == {} |
| 1957 | || ([info exists currentid] && $sha1string == $currentid)} { |
| 1958 | set state disabled |
| 1959 | } else { |
| 1960 | set state normal |
| 1961 | } |
| 1962 | if {[$sha1but cget -state] == $state} return |
| 1963 | if {$state == "normal"} { |
| 1964 | $sha1but conf -state normal -relief raised -text "Goto: " |
| 1965 | } else { |
| 1966 | $sha1but conf -state disabled -relief flat -text "SHA1 ID: " |
| 1967 | } |
| 1968 | } |
| 1969 | |
| 1970 | proc gotocommit {} { |
| 1971 | global sha1string currentid idline tagids |
| 1972 | if {$sha1string == {} |
| 1973 | || ([info exists currentid] && $sha1string == $currentid)} return |
| 1974 | if {[info exists tagids($sha1string)]} { |
| 1975 | set id $tagids($sha1string) |
| 1976 | } else { |
| 1977 | set id [string tolower $sha1string] |
| 1978 | } |
| 1979 | if {[info exists idline($id)]} { |
| 1980 | selectline $idline($id) |
| 1981 | return |
| 1982 | } |
| 1983 | if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} { |
| 1984 | set type "SHA1 id" |
| 1985 | } else { |
| 1986 | set type "Tag" |
| 1987 | } |
| 1988 | error_popup "$type $sha1string is not known" |
| 1989 | } |
| 1990 | |
Paul Mackerras | 84ba734 | 2005-06-17 00:12:26 +0000 | [diff] [blame] | 1991 | proc lineenter {x y id} { |
| 1992 | global hoverx hovery hoverid hovertimer |
| 1993 | global commitinfo canv |
| 1994 | |
| 1995 | if {![info exists commitinfo($id)]} return |
| 1996 | set hoverx $x |
| 1997 | set hovery $y |
| 1998 | set hoverid $id |
| 1999 | if {[info exists hovertimer]} { |
| 2000 | after cancel $hovertimer |
| 2001 | } |
| 2002 | set hovertimer [after 500 linehover] |
| 2003 | $canv delete hover |
| 2004 | } |
| 2005 | |
| 2006 | proc linemotion {x y id} { |
| 2007 | global hoverx hovery hoverid hovertimer |
| 2008 | |
| 2009 | if {[info exists hoverid] && $id == $hoverid} { |
| 2010 | set hoverx $x |
| 2011 | set hovery $y |
| 2012 | if {[info exists hovertimer]} { |
| 2013 | after cancel $hovertimer |
| 2014 | } |
| 2015 | set hovertimer [after 500 linehover] |
| 2016 | } |
| 2017 | } |
| 2018 | |
| 2019 | proc lineleave {id} { |
| 2020 | global hoverid hovertimer canv |
| 2021 | |
| 2022 | if {[info exists hoverid] && $id == $hoverid} { |
| 2023 | $canv delete hover |
| 2024 | if {[info exists hovertimer]} { |
| 2025 | after cancel $hovertimer |
| 2026 | unset hovertimer |
| 2027 | } |
| 2028 | unset hoverid |
| 2029 | } |
| 2030 | } |
| 2031 | |
| 2032 | proc linehover {} { |
| 2033 | global hoverx hovery hoverid hovertimer |
| 2034 | global canv linespc lthickness |
| 2035 | global commitinfo mainfont |
| 2036 | |
| 2037 | set text [lindex $commitinfo($hoverid) 0] |
| 2038 | set ymax [lindex [$canv cget -scrollregion] 3] |
| 2039 | if {$ymax == {}} return |
| 2040 | set yfrac [lindex [$canv yview] 0] |
| 2041 | set x [expr {$hoverx + 2 * $linespc}] |
| 2042 | set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] |
| 2043 | set x0 [expr {$x - 2 * $lthickness}] |
| 2044 | set y0 [expr {$y - 2 * $lthickness}] |
| 2045 | set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] |
| 2046 | set y1 [expr {$y + $linespc + 2 * $lthickness}] |
| 2047 | set t [$canv create rectangle $x0 $y0 $x1 $y1 \ |
| 2048 | -fill \#ffff80 -outline black -width 1 -tags hover] |
| 2049 | $canv raise $t |
| 2050 | set t [$canv create text $x $y -anchor nw -text $text -tags hover] |
| 2051 | $canv raise $t |
| 2052 | } |
| 2053 | |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 2054 | proc lineclick {x y id} { |
| 2055 | global ctext commitinfo children cflist canv |
| 2056 | |
| 2057 | unmarkmatches |
| 2058 | $canv delete hover |
| 2059 | # fill the details pane with info about this line |
| 2060 | $ctext conf -state normal |
| 2061 | $ctext delete 0.0 end |
| 2062 | $ctext insert end "Parent:\n " |
| 2063 | catch {destroy $ctext.$id} |
| 2064 | button $ctext.$id -text "Go:" -command "selbyid $id" \ |
| 2065 | -padx 4 -pady 0 |
| 2066 | $ctext window create end -window $ctext.$id -align center |
| 2067 | set info $commitinfo($id) |
| 2068 | $ctext insert end "\t[lindex $info 0]\n" |
| 2069 | $ctext insert end "\tAuthor:\t[lindex $info 1]\n" |
| 2070 | $ctext insert end "\tDate:\t[lindex $info 2]\n" |
| 2071 | $ctext insert end "\tID:\t$id\n" |
| 2072 | if {[info exists children($id)]} { |
| 2073 | $ctext insert end "\nChildren:" |
| 2074 | foreach child $children($id) { |
| 2075 | $ctext insert end "\n " |
| 2076 | catch {destroy $ctext.$child} |
| 2077 | button $ctext.$child -text "Go:" -command "selbyid $child" \ |
| 2078 | -padx 4 -pady 0 |
| 2079 | $ctext window create end -window $ctext.$child -align center |
| 2080 | set info $commitinfo($child) |
| 2081 | $ctext insert end "\t[lindex $info 0]" |
| 2082 | } |
| 2083 | } |
| 2084 | $ctext conf -state disabled |
| 2085 | |
| 2086 | $cflist delete 0 end |
| 2087 | } |
| 2088 | |
| 2089 | proc selbyid {id} { |
| 2090 | global idline |
| 2091 | if {[info exists idline($id)]} { |
| 2092 | selectline $idline($id) |
| 2093 | } |
| 2094 | } |
| 2095 | |
| 2096 | proc mstime {} { |
| 2097 | global startmstime |
| 2098 | if {![info exists startmstime]} { |
| 2099 | set startmstime [clock clicks -milliseconds] |
| 2100 | } |
| 2101 | return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] |
| 2102 | } |
| 2103 | |
| 2104 | proc rowmenu {x y id} { |
| 2105 | global rowctxmenu idline selectedline rowmenuid |
| 2106 | |
| 2107 | if {![info exists selectedline] || $idline($id) eq $selectedline} { |
| 2108 | set state disabled |
| 2109 | } else { |
| 2110 | set state normal |
| 2111 | } |
| 2112 | $rowctxmenu entryconfigure 0 -state $state |
| 2113 | $rowctxmenu entryconfigure 1 -state $state |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2114 | $rowctxmenu entryconfigure 2 -state $state |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 2115 | set rowmenuid $id |
| 2116 | tk_popup $rowctxmenu $x $y |
| 2117 | } |
| 2118 | |
| 2119 | proc diffvssel {dirn} { |
| 2120 | global rowmenuid selectedline lineid |
| 2121 | global ctext cflist |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 2122 | global commitinfo |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 2123 | |
| 2124 | if {![info exists selectedline]} return |
| 2125 | if {$dirn} { |
| 2126 | set oldid $lineid($selectedline) |
| 2127 | set newid $rowmenuid |
| 2128 | } else { |
| 2129 | set oldid $rowmenuid |
| 2130 | set newid $lineid($selectedline) |
| 2131 | } |
| 2132 | $ctext conf -state normal |
| 2133 | $ctext delete 0.0 end |
| 2134 | $ctext mark set fmark.0 0.0 |
| 2135 | $ctext mark gravity fmark.0 left |
| 2136 | $cflist delete 0 end |
| 2137 | $cflist insert end "Top" |
| 2138 | $ctext insert end "From $oldid\n " |
| 2139 | $ctext insert end [lindex $commitinfo($oldid) 0] |
| 2140 | $ctext insert end "\n\nTo $newid\n " |
| 2141 | $ctext insert end [lindex $commitinfo($newid) 0] |
| 2142 | $ctext insert end "\n" |
| 2143 | $ctext conf -state disabled |
| 2144 | $ctext tag delete Comments |
| 2145 | $ctext tag remove found 1.0 end |
Paul Mackerras | 14c9dbd | 2005-07-16 21:53:55 -0400 | [diff] [blame] | 2146 | startdiff [list $newid $oldid] |
Paul Mackerras | c8dfbcf | 2005-06-25 15:39:21 +1000 | [diff] [blame] | 2147 | } |
| 2148 | |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2149 | proc mkpatch {} { |
| 2150 | global rowmenuid currentid commitinfo patchtop patchnum |
| 2151 | |
| 2152 | if {![info exists currentid]} return |
| 2153 | set oldid $currentid |
| 2154 | set oldhead [lindex $commitinfo($oldid) 0] |
| 2155 | set newid $rowmenuid |
| 2156 | set newhead [lindex $commitinfo($newid) 0] |
| 2157 | set top .patch |
| 2158 | set patchtop $top |
| 2159 | catch {destroy $top} |
| 2160 | toplevel $top |
| 2161 | label $top.title -text "Generate patch" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2162 | grid $top.title - -pady 10 |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2163 | label $top.from -text "From:" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2164 | entry $top.fromsha1 -width 40 -relief flat |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2165 | $top.fromsha1 insert 0 $oldid |
| 2166 | $top.fromsha1 conf -state readonly |
| 2167 | grid $top.from $top.fromsha1 -sticky w |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2168 | entry $top.fromhead -width 60 -relief flat |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2169 | $top.fromhead insert 0 $oldhead |
| 2170 | $top.fromhead conf -state readonly |
| 2171 | grid x $top.fromhead -sticky w |
| 2172 | label $top.to -text "To:" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2173 | entry $top.tosha1 -width 40 -relief flat |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2174 | $top.tosha1 insert 0 $newid |
| 2175 | $top.tosha1 conf -state readonly |
| 2176 | grid $top.to $top.tosha1 -sticky w |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2177 | entry $top.tohead -width 60 -relief flat |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2178 | $top.tohead insert 0 $newhead |
| 2179 | $top.tohead conf -state readonly |
| 2180 | grid x $top.tohead -sticky w |
| 2181 | button $top.rev -text "Reverse" -command mkpatchrev -padx 5 |
| 2182 | grid $top.rev x -pady 10 |
| 2183 | label $top.flab -text "Output file:" |
| 2184 | entry $top.fname -width 60 |
| 2185 | $top.fname insert 0 [file normalize "patch$patchnum.patch"] |
| 2186 | incr patchnum |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2187 | grid $top.flab $top.fname -sticky w |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2188 | frame $top.buts |
| 2189 | button $top.buts.gen -text "Generate" -command mkpatchgo |
| 2190 | button $top.buts.can -text "Cancel" -command mkpatchcan |
| 2191 | grid $top.buts.gen $top.buts.can |
| 2192 | grid columnconfigure $top.buts 0 -weight 1 -uniform a |
| 2193 | grid columnconfigure $top.buts 1 -weight 1 -uniform a |
| 2194 | grid $top.buts - -pady 10 -sticky ew |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2195 | focus $top.fname |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2196 | } |
| 2197 | |
| 2198 | proc mkpatchrev {} { |
| 2199 | global patchtop |
| 2200 | |
| 2201 | set oldid [$patchtop.fromsha1 get] |
| 2202 | set oldhead [$patchtop.fromhead get] |
| 2203 | set newid [$patchtop.tosha1 get] |
| 2204 | set newhead [$patchtop.tohead get] |
| 2205 | foreach e [list fromsha1 fromhead tosha1 tohead] \ |
| 2206 | v [list $newid $newhead $oldid $oldhead] { |
| 2207 | $patchtop.$e conf -state normal |
| 2208 | $patchtop.$e delete 0 end |
| 2209 | $patchtop.$e insert 0 $v |
| 2210 | $patchtop.$e conf -state readonly |
| 2211 | } |
| 2212 | } |
| 2213 | |
| 2214 | proc mkpatchgo {} { |
| 2215 | global patchtop |
| 2216 | |
| 2217 | set oldid [$patchtop.fromsha1 get] |
| 2218 | set newid [$patchtop.tosha1 get] |
| 2219 | set fname [$patchtop.fname get] |
| 2220 | if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} { |
| 2221 | error_popup "Error creating patch: $err" |
| 2222 | } |
| 2223 | catch {destroy $patchtop} |
| 2224 | unset patchtop |
| 2225 | } |
| 2226 | |
| 2227 | proc mkpatchcan {} { |
| 2228 | global patchtop |
| 2229 | |
| 2230 | catch {destroy $patchtop} |
| 2231 | unset patchtop |
| 2232 | } |
| 2233 | |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2234 | proc mktag {} { |
| 2235 | global rowmenuid mktagtop commitinfo |
| 2236 | |
| 2237 | set top .maketag |
| 2238 | set mktagtop $top |
| 2239 | catch {destroy $top} |
| 2240 | toplevel $top |
| 2241 | label $top.title -text "Create tag" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2242 | grid $top.title - -pady 10 |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2243 | label $top.id -text "ID:" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2244 | entry $top.sha1 -width 40 -relief flat |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2245 | $top.sha1 insert 0 $rowmenuid |
| 2246 | $top.sha1 conf -state readonly |
| 2247 | grid $top.id $top.sha1 -sticky w |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2248 | entry $top.head -width 60 -relief flat |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2249 | $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
| 2250 | $top.head conf -state readonly |
| 2251 | grid x $top.head -sticky w |
| 2252 | label $top.tlab -text "Tag name:" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2253 | entry $top.tag -width 60 |
Paul Mackerras | bdbfbe3 | 2005-06-27 22:56:40 +1000 | [diff] [blame] | 2254 | grid $top.tlab $top.tag -sticky w |
| 2255 | frame $top.buts |
| 2256 | button $top.buts.gen -text "Create" -command mktaggo |
| 2257 | button $top.buts.can -text "Cancel" -command mktagcan |
| 2258 | grid $top.buts.gen $top.buts.can |
| 2259 | grid columnconfigure $top.buts 0 -weight 1 -uniform a |
| 2260 | grid columnconfigure $top.buts 1 -weight 1 -uniform a |
| 2261 | grid $top.buts - -pady 10 -sticky ew |
| 2262 | focus $top.tag |
| 2263 | } |
| 2264 | |
| 2265 | proc domktag {} { |
| 2266 | global mktagtop env tagids idtags |
| 2267 | global idpos idline linehtag canv selectedline |
| 2268 | |
| 2269 | set id [$mktagtop.sha1 get] |
| 2270 | set tag [$mktagtop.tag get] |
| 2271 | if {$tag == {}} { |
| 2272 | error_popup "No tag name specified" |
| 2273 | return |
| 2274 | } |
| 2275 | if {[info exists tagids($tag)]} { |
| 2276 | error_popup "Tag \"$tag\" already exists" |
| 2277 | return |
| 2278 | } |
| 2279 | if {[catch { |
| 2280 | set dir ".git" |
| 2281 | if {[info exists env(GIT_DIR)]} { |
| 2282 | set dir $env(GIT_DIR) |
| 2283 | } |
| 2284 | set fname [file join $dir "refs/tags" $tag] |
| 2285 | set f [open $fname w] |
| 2286 | puts $f $id |
| 2287 | close $f |
| 2288 | } err]} { |
| 2289 | error_popup "Error creating tag: $err" |
| 2290 | return |
| 2291 | } |
| 2292 | |
| 2293 | set tagids($tag) $id |
| 2294 | lappend idtags($id) $tag |
| 2295 | $canv delete tag.$id |
| 2296 | set xt [eval drawtags $id $idpos($id)] |
| 2297 | $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] |
| 2298 | if {[info exists selectedline] && $selectedline == $idline($id)} { |
| 2299 | selectline $selectedline |
| 2300 | } |
| 2301 | } |
| 2302 | |
| 2303 | proc mktagcan {} { |
| 2304 | global mktagtop |
| 2305 | |
| 2306 | catch {destroy $mktagtop} |
| 2307 | unset mktagtop |
| 2308 | } |
| 2309 | |
| 2310 | proc mktaggo {} { |
| 2311 | domktag |
| 2312 | mktagcan |
| 2313 | } |
| 2314 | |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2315 | proc writecommit {} { |
| 2316 | global rowmenuid wrcomtop commitinfo wrcomcmd |
| 2317 | |
| 2318 | set top .writecommit |
| 2319 | set wrcomtop $top |
| 2320 | catch {destroy $top} |
| 2321 | toplevel $top |
| 2322 | label $top.title -text "Write commit to file" |
| 2323 | grid $top.title - -pady 10 |
| 2324 | label $top.id -text "ID:" |
| 2325 | entry $top.sha1 -width 40 -relief flat |
| 2326 | $top.sha1 insert 0 $rowmenuid |
| 2327 | $top.sha1 conf -state readonly |
| 2328 | grid $top.id $top.sha1 -sticky w |
| 2329 | entry $top.head -width 60 -relief flat |
| 2330 | $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
| 2331 | $top.head conf -state readonly |
| 2332 | grid x $top.head -sticky w |
| 2333 | label $top.clab -text "Command:" |
| 2334 | entry $top.cmd -width 60 -textvariable wrcomcmd |
| 2335 | grid $top.clab $top.cmd -sticky w -pady 10 |
| 2336 | label $top.flab -text "Output file:" |
| 2337 | entry $top.fname -width 60 |
| 2338 | $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] |
| 2339 | grid $top.flab $top.fname -sticky w |
| 2340 | frame $top.buts |
| 2341 | button $top.buts.gen -text "Write" -command wrcomgo |
| 2342 | button $top.buts.can -text "Cancel" -command wrcomcan |
| 2343 | grid $top.buts.gen $top.buts.can |
| 2344 | grid columnconfigure $top.buts 0 -weight 1 -uniform a |
| 2345 | grid columnconfigure $top.buts 1 -weight 1 -uniform a |
| 2346 | grid $top.buts - -pady 10 -sticky ew |
| 2347 | focus $top.fname |
| 2348 | } |
| 2349 | |
| 2350 | proc wrcomgo {} { |
| 2351 | global wrcomtop |
| 2352 | |
| 2353 | set id [$wrcomtop.sha1 get] |
| 2354 | set cmd "echo $id | [$wrcomtop.cmd get]" |
| 2355 | set fname [$wrcomtop.fname get] |
| 2356 | if {[catch {exec sh -c $cmd >$fname &} err]} { |
| 2357 | error_popup "Error writing commit: $err" |
| 2358 | } |
| 2359 | catch {destroy $wrcomtop} |
| 2360 | unset wrcomtop |
| 2361 | } |
| 2362 | |
| 2363 | proc wrcomcan {} { |
| 2364 | global wrcomtop |
| 2365 | |
| 2366 | catch {destroy $wrcomtop} |
| 2367 | unset wrcomtop |
| 2368 | } |
| 2369 | |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2370 | proc doquit {} { |
| 2371 | global stopped |
| 2372 | set stopped 100 |
| 2373 | destroy . |
| 2374 | } |
| 2375 | |
| 2376 | # defaults... |
| 2377 | set datemode 0 |
| 2378 | set boldnames 0 |
| 2379 | set diffopts "-U 5 -p" |
Paul Mackerras | 4a2139f | 2005-06-29 09:47:48 +1000 | [diff] [blame] | 2380 | set wrcomcmd "git-diff-tree --stdin -p --pretty" |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2381 | |
| 2382 | set mainfont {Helvetica 9} |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2383 | set textfont {Courier 9} |
Paul Mackerras | b74fd57 | 2005-07-16 07:46:13 -0400 | [diff] [blame] | 2384 | set findmergefiles 0 |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2385 | |
| 2386 | set colors {green red blue magenta darkgrey brown orange} |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2387 | |
| 2388 | catch {source ~/.gitk} |
| 2389 | |
Paul Mackerras | 1738606 | 2005-05-18 22:51:00 +0000 | [diff] [blame] | 2390 | set namefont $mainfont |
| 2391 | if {$boldnames} { |
| 2392 | lappend namefont bold |
| 2393 | } |
| 2394 | |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2395 | set revtreeargs {} |
| 2396 | foreach arg $argv { |
| 2397 | switch -regexp -- $arg { |
| 2398 | "^$" { } |
| 2399 | "^-b" { set boldnames 1 } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2400 | "^-d" { set datemode 1 } |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2401 | default { |
| 2402 | lappend revtreeargs $arg |
| 2403 | } |
| 2404 | } |
| 2405 | } |
| 2406 | |
| 2407 | set stopped 0 |
| 2408 | set redisplaying 0 |
Paul Mackerras | 0fba86b | 2005-05-16 23:54:58 +0000 | [diff] [blame] | 2409 | set stuffsaved 0 |
Paul Mackerras | 74daedb | 2005-06-27 19:27:32 +1000 | [diff] [blame] | 2410 | set patchnum 0 |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2411 | setcoords |
| 2412 | makewindow |
Paul Mackerras | 887fe3c | 2005-05-21 07:35:37 +0000 | [diff] [blame] | 2413 | readrefs |
Paul Mackerras | 1d10f36 | 2005-05-15 12:55:47 +0000 | [diff] [blame] | 2414 | getcommits $revtreeargs |