00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: diff.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 3/23/2015
00022 # Brief: Contains namespace which handles displaying file version differences
00023 ######################################################################
00024
00025 # msgcat::note Go to File menu and select "Show File Differences". Strings are shown at bottom of editor.
00026
00027 namespace eval diff {
00028
00029 array set data {}
00030
00031 # Check to see if the ttk::spinbox command exists
00032 if {[catch { ttk::spinbox .__tmp }]} {
00033 set bg [utils::get_default_background]
00034 set fg [utils::get_default_foreground]
00035 set data(sb) "spinbox"
00036 set data(sb_opts) "-relief flat -buttondownrelief flat -buttonuprelief flat -background $bg -foreground $fg"
00037 } else {
00038 set data(sb) "ttk::spinbox"
00039 set data(sb_opts) "-justify center"
00040 destroy .__tmp
00041 }
00042
00043 proc create_diff_bar {txt win} {
00044
00045 variable data
00046
00047 # Initialize values
00048 set data($txt,win) $win
00049 set data($txt,v1) ""
00050 set data($txt,v2) ""
00051 set data($txt,last_v1) ""
00052 set data($txt,last_v2) ""
00053
00054 ttk::frame $win
00055 ttk::menubutton $win.cvs -menu $win.cvsMenu -direction above
00056 ttk::button $win.show -text [msgcat::mc "Update"] -command "diff::show $txt"
00057 message $txt.log
00058
00059 # Create the version frame
00060 ttk::frame $win.vf
00061 ttk::label $win.vf.l1 -text [msgcat::mc " Start: "]
00062 $data(sb) $win.vf.v1 {*}$data(sb_opts) -textvariable diff::data($txt,v1) -width 10 -state readonly -command "diff::handle_v1 $txt"
00063 ttk::label $win.vf.l2 -text [msgcat::mc " End: "]
00064 $data(sb) $win.vf.v2 {*}$data(sb_opts) -textvariable diff::data($txt,v2) -width 10 -state readonly -command "diff::handle_v2 $txt"
00065
00066 bind $win.vf.v1 <FocusIn> [list diff::show_hide_version_log $txt v1 on]
00067 bind $win.vf.v1 <FocusOut> [list diff::show_hide_version_log $txt v1 off]
00068 bind $win.vf.v2 <FocusIn> [list diff::show_hide_version_log $txt v2 on]
00069 bind $win.vf.v2 <FocusOut> [list diff::show_hide_version_log $txt v2 off]
00070
00071 grid rowconfigure $win.vf 0 -weight 1
00072 grid columnconfigure $win.vf 2 -weight 1
00073 grid $win.vf.l1 -row 0 -column 0 -sticky ew -padx 2
00074 grid $win.vf.v1 -row 0 -column 1 -sticky ew -padx 2
00075 grid $win.vf.l2 -row 0 -column 2 -sticky ew -padx 2
00076 grid $win.vf.v2 -row 0 -column 3 -sticky ew -padx 2
00077
00078 # Create the file frame
00079 ttk::frame $win.ff
00080 wmarkentry::wmarkentry $win.ff.e -watermark [msgcat::mc "Enter starting file"] \
00081 -validate key -validatecommand [list diff::handle_file_entry $win %P]
00082
00083 bind [$win.ff.e entrytag] <Return> [list diff::show $txt]
00084
00085 grid rowconfigure $win.ff 0 -weight 1
00086 grid columnconfigure $win.ff 0 -weight 1
00087 grid $win.ff.e -row 0 -column 0 -sticky ew -padx 2
00088
00089 # Create the command frame
00090 ttk::frame $win.cf
00091 wmarkentry::wmarkentry $win.cf.e -watermark [msgcat::mc "Enter difference command"]
00092
00093 bind [$win.cf.e entrytag] <Return> [list diff::show $txt]
00094
00095 grid rowconfigure $win.cf 0 -weight 1
00096 grid columnconfigure $win.cf 0 -weight 1
00097 grid $win.cf.e -row 0 -column 0 -sticky ew -padx 2
00098
00099 grid rowconfigure $win 0 -weight 1
00100 grid columnconfigure $win 2 -weight 1
00101 grid $win
00102 grid $win.cvs -row 0 -column 0 -sticky ew -padx 2 -pady 2
00103 grid $win.vf -row 0 -column 1 -sticky ew -pady 2
00104 grid $win.ff -row 0 -column 2 -sticky ew -pady 2
00105 grid $win.cf -row 0 -column 3 -sticky ew -pady 2
00106 grid $win.show -row 0 -column 4 -sticky ew -padx 2 -pady 2
00107
00108 # Hide the version frame, file frame and update button until they are valid
00109 grid remove $win.vf
00110 grid remove $win.ff
00111 grid remove $win.cf
00112 grid remove $win.show
00113
00114 # When text widget is destroyed delete our data
00115 bind $win <Configure> "diff::configure $txt"
00116 bind $win <Destroy> "diff::destroy $txt"
00117
00118 # Create the CVS menu
00119 menu $win.cvsMenu -tearoff 0
00120
00121 # Populate the CVS menu
00122 set first 1
00123 foreach type [list cvs file command] {
00124 if {!$first} {
00125 $win.cvsMenu add separator
00126 }
00127 foreach name [get_cvs_names $type] {
00128 $win.cvsMenu add radiobutton -label $name -variable diff::data($txt,cvs) -value $name -command "diff::update_diff_frame $txt"
00129 }
00130 set first 0
00131 }
00132
00133 return $win
00134
00135 }
00136
00137 ######################################################################
00138 # Handles any changes to the file entry window.
00139 proc handle_file_entry {win value} {
00140
00141 if {[file exists $value] && [file isfile $value]} {
00142 grid $win.show
00143 } else {
00144 grid remove $win.show
00145 }
00146
00147 return 1
00148
00149 }
00150
00151 ######################################################################
00152 # Handles changes to the windowing theme.
00153 proc handle_theme_change {sb_opts} {
00154
00155 variable data
00156
00157 # Get the default background and foreground colors
00158 set bg [utils::get_default_background]
00159 set fg [utils::get_default_foreground]
00160
00161 # Update the spinboxes (if we are not using ttk::spinbox)
00162 if {$data(sb) eq "spinbox"} {
00163 foreach win [array names data *,win] {
00164 $win.vf.v1 configure -background $bg -foreground $fg
00165 }
00166 }
00167
00168 }
00169
00170 ######################################################################
00171 # Handles a configure window call to the difference widget.
00172 proc configure {txt} {
00173
00174 variable data
00175
00176 # Remove the log window
00177 place forget $txt.log
00178 set data($txt,logmode) 0
00179
00180 }
00181
00182 ######################################################################
00183 # Deletes all data associated with the given text widget.
00184 proc destroy {txt} {
00185
00186 variable data
00187
00188 array unset data $txt,*
00189
00190 }
00191
00192 ######################################################################
00193 # Performs the difference command and displays it in the text widget.
00194 proc show {txt {force_update 0}} {
00195
00196 variable data
00197
00198 # Get the current working directory
00199 set cwd [pwd]
00200
00201 # Get the filename
00202 gui::get_info $txt txt fname
00203
00204 # Set the current working directory to the directory of the file
00205 cd [file dirname $fname]
00206
00207 # Set fname to the tail of fname
00208 set fname [file tail $fname]
00209
00210 # If the CVS has not been set, attempt to figure it out
00211 if {![info exists data($txt,cvs)] || ($data($txt,cvs) eq "")} {
00212 set_default_cvs $txt
00213 }
00214
00215 # Get the CVS namespace name
00216 set cvs_ns [string tolower $data($txt,cvs)]
00217
00218 # If the V2 file changed, replace the file with the new content
00219 if {($data($txt,v2) ne $data($txt,last_v2)) || $force_update} {
00220
00221 set v2_fname $fname
00222
00223 # If the currently selected version is not current, get the file command
00224 if {$data($txt,v2) ne "Current"} {
00225 set v2_fname [${cvs_ns}::get_file_cmd $data($txt,v2) $fname]
00226 }
00227
00228 # Execute the file open and update the text widget
00229 if {![catch { open $v2_fname r } rc]} {
00230 $txt configure -state normal
00231 $txt delete 1.0 end
00232 $txt insert end [read $rc]
00233 $txt configure -state disabled
00234 }
00235
00236 # Save the last V2
00237 set data($txt,last_v2) $data($txt,v2)
00238
00239 }
00240
00241 # Displays the difference data
00242 switch [${cvs_ns}::type] {
00243 cvs { parse_unified_diff $txt [${cvs_ns}::get_diff_cmd $data($txt,v1) $data($txt,v2) $fname] }
00244 file { parse_unified_diff $txt [${cvs_ns}::get_diff_cmd [$data($txt,win).ff.e get] $fname] }
00245 command { parse_unified_diff $txt [$data($txt,win).cf.e get] }
00246 }
00247
00248 # Save the value of V1 to last V1
00249 set data($txt,last_v1) $data($txt,v1)
00250
00251 # Hide the update button
00252 grid remove $data($txt,win).show
00253
00254 # Reset the current working directory
00255 cd $cwd
00256
00257 }
00258
00259 ######################################################################
00260 # Returns true if the specified text widget is eligible for a file
00261 # update via the gui::update_file command.
00262 proc updateable {txt} {
00263
00264 variable data
00265
00266 return [expr {$data($txt,v2) eq "Current"}]
00267
00268 }
00269
00270 ######################################################################
00271 # Sets the V1 widget to the version found for the current difference view line.
00272 proc find_current_version {txt fname lnum} {
00273
00274 variable data
00275
00276 # Get the CVS namespace name
00277 set cvs_ns [string tolower $data($txt,cvs)]
00278
00279 if {[${cvs_ns}::type] eq "cvs"} {
00280
00281 if {[set v2 [${cvs_ns}::find_version $fname $data($txt,v2) [$txt diff line [lindex [split [$txt index sel.first] .] 0] add]]] ne ""} {
00282
00283 # Set version 2 to the found value
00284 set data($txt,v2) $v2
00285
00286 # Set version 1 to the previous value
00287 set data($txt,v1) [lindex $data($txt,versions) [expr [lsearch $data($txt,versions) $v2] + 1]]
00288
00289 # Show the file
00290 show $txt
00291
00292 }
00293
00294 }
00295
00296 }
00297
00298 ######################################################################
00299 # Returns a list containing information to store to the session file
00300 # for the given text widget.
00301 proc get_session_data {txt} {
00302
00303 variable data
00304
00305 return [list $data($txt,cvs) $data($txt,last_v1) $data($txt,last_v2)]
00306
00307 }
00308
00309 ######################################################################
00310 # Loads the given data list from the session file.
00311 proc set_session_data {txt data_list} {
00312
00313 variable data
00314
00315 # Extract the contents of the data_list
00316 lassign $data_list data($txt,cvs) v1 v2
00317
00318 # If last_v1 is non-empty, the user performed an update in the last session;
00319 # otherwise, there is nothing left to do.
00320 if {$v1 ne ""} {
00321
00322 # Display the original changes
00323 update_diff_frame $txt
00324
00325 # Set v1 and v2
00326 set data($txt,v1) $v1
00327 set data($txt,v2) $v2
00328
00329 }
00330
00331 }
00332
00333 ######################################################################
00334 # PRIVATE PROCEDURES
00335 ######################################################################
00336
00337 ######################################################################
00338 # Gets a sorted list of all available CVS names.
00339 proc get_cvs_names {type} {
00340
00341 set names [list]
00342
00343 foreach name [namespace children] {
00344 if {([${name}::type] eq $type) && ([${name}::name] ne "CVS")} {
00345 lappend names [${name}::name]
00346 }
00347 }
00348
00349 return [lsort $names]
00350
00351 }
00352
00353 ######################################################################
00354 # Returns the versioning system that handles the given filename.
00355 proc get_default_cvs {fname} {
00356
00357 foreach cvs [get_cvs_names cvs] {
00358 if {[[string tolower $cvs]::handles $fname]} {
00359 return [string tolower $cvs]
00360 }
00361 }
00362
00363 return "diff"
00364
00365 }
00366
00367 ######################################################################
00368 # Attempts to determine the default CVS that is used to manage the
00369 # file associated with the text widget and updates the UI elements to match.
00370 proc set_default_cvs {txt} {
00371
00372 variable data
00373
00374 # Get the filename
00375 set fname [file tail [gui::get_info $txt txt fname]]
00376
00377 set data($txt,cvs) [get_default_cvs $fname]
00378 set data($txt,v2) "Current"
00379
00380 # Update the UI to match the selected CVS
00381 update_diff_frame $txt
00382
00383 }
00384
00385 ######################################################################
00386 # Called whenever the CVS value is changed.
00387 proc update_diff_frame {txt} {
00388
00389 variable data
00390
00391 set win $data($txt,win)
00392
00393 switch [[string tolower $data($txt,cvs)]::type] {
00394
00395 cvs {
00396
00397 # Remove the file and command frames from view
00398 grid remove $win.ff
00399 grid remove $win.cf
00400
00401 # Get all of the versions available for the file
00402 get_versions $txt
00403
00404 if {[llength $data($txt,versions)] > 1} {
00405
00406 # Show the version frame and update button
00407 grid $win.vf
00408 grid $win.show
00409
00410 # Configure the spinboxes buttons
00411 $win.vf.v1 configure -values [lreverse [lrange $data($txt,versions) 1 end]]
00412 $win.vf.v2 configure -values [lreverse [lrange $data($txt,versions) 0 end-1]]
00413
00414 } else {
00415
00416 grid remove $win.vf
00417 grid remove $win.show
00418
00419 }
00420
00421 }
00422
00423 file {
00424
00425 # Remove the version and command frames
00426 grid columnconfigure $win 4 -weight 0
00427 grid remove $win.vf
00428 grid remove $win.cf
00429 grid remove $win.show
00430
00431 # Display the file frame and update button
00432 grid columnconfigure $win 3 -weight 1
00433 grid $win.ff
00434
00435 # Clear the filename
00436 $win.ff.e delete 0 end
00437
00438 # Set keyboard focus to the entry widget
00439 focus $win.ff.e
00440
00441 }
00442
00443 command {
00444
00445 # Remove the version and file frames
00446 grid columnconfigure $win 3 -weight 0
00447 grid remove $win.vf
00448 grid remove $win.ff
00449
00450 # Display the command frame and update button
00451 grid columnconfigure $win 4 -weight 1
00452 grid $win.cf
00453 grid $win.show
00454
00455 # Set keyboard focus to the entry widget
00456 focus $win.cf.e.e
00457
00458 }
00459
00460 }
00461
00462 # Set the menubutton name
00463 $win.cvs configure -text $data($txt,cvs)
00464
00465 }
00466
00467 ######################################################################
00468 # Get the available versions based on the currently selected CVS.
00469 proc get_versions {txt} {
00470
00471 variable data
00472
00473 # Get the versions
00474 set data($txt,versions) [list "Current" {*}[[string tolower $data($txt,cvs)]::versions [gui::get_info $txt txt fname]]]
00475
00476 # Set the version 2 value to the current value
00477 set data($txt,v2) "Current"
00478
00479 # Set the version 1 value to the second value
00480 set data($txt,v1) [lindex $data($txt,versions) 1]
00481
00482 }
00483
00484 ######################################################################
00485 # If the version of the ending version is less than or equal to the new
00486 # starting version, adjust the ending version to be one version newer
00487 # than the starting version.
00488 proc handle_v1 {txt} {
00489
00490 variable data
00491
00492 # Find the current V1 version in the versions list
00493 set index [lsearch $data($txt,versions) $data($txt,v1)]
00494
00495 # Adjust version 2, if necessary
00496 if {$data($txt,v1) >= $data($txt,v2)} {
00497 set data($txt,v2) [lindex $data($txt,versions) [expr $index - 1]]
00498 }
00499
00500 # Make sure the update button is visible
00501 grid $data($txt,win).show
00502
00503 # Update the version log information
00504 show_hide_version_log $txt v1 on
00505
00506 }
00507
00508 ######################################################################
00509 # Handles a change to the V2 widget.
00510 proc handle_v2 {txt} {
00511
00512 variable data
00513
00514 # Find the current V2 version in the versions list
00515 set index [lsearch $data($txt,versions) $data($txt,v2)]
00516
00517 # Adjust version 1, if necessary
00518 if {$data($txt,v1) >= $data($txt,v2)} {
00519 set data($txt,v1) [lindex $data($txt,versions) [expr $index + 1]]
00520 }
00521
00522 # Make sure the update button is visible
00523 grid $data($txt,win).show
00524
00525 # Update the version log information
00526 show_hide_version_log $txt v2 on
00527
00528 }
00529
00530 ######################################################################
00531 # Shows/hides the file version information in a tooltip just above the
00532 # associated version widget.
00533 proc show_hide_version_log {txt widget mode} {
00534
00535 variable data
00536
00537 if {[preferences::get View/ShowDifferenceVersionInfo] &&
00538 (![info exists data($txt,logmode)] || \
00539 (!$data($txt,logmode) && ($mode eq "toggle")) || \
00540 ($mode eq "on") || \
00541 ($data($txt,logmode) && ($mode eq "update")))} {
00542
00543 # Get the filename
00544 gui::get_info $txt txt fname
00545
00546 # Get the current working directory
00547 set cwd [pwd]
00548
00549 # Set the current working directory to the dirname of fname
00550 cd [file dirname $fname]
00551
00552 # Get the version information
00553 if {[set log [[string tolower $data($txt,cvs)]::get_version_log [file tail $fname] $data($txt,$widget)]] ne ""} {
00554
00555 # Create the message widget
00556 $txt.log configure -text $log -width [expr [winfo width $txt] - 10]
00557
00558 # Place the message widget
00559 place $txt.log -in $txt -x 10 -y [expr [winfo height $txt] - ([winfo reqheight $txt.log] + 10)]
00560
00561 set data($txt,logmode) 1
00562
00563 # Return the working directory to the previous directory
00564 cd $cwd
00565
00566 return
00567
00568 }
00569
00570 # Return the working directory to the previous directory
00571 cd $cwd
00572
00573 }
00574
00575 # Destroy the message widget
00576 place forget $txt.log
00577
00578 set data($txt,logmode) 0
00579
00580 }
00581
00582 ######################################################################
00583 # Executes the given diff command that produces diff output in unified
00584 # format. Updates the specified text widget with the result. The
00585 # command must be called only after the file is inserted into the editor.
00586 # Additionally, the file that is in the editor must be the same version
00587 # that is associated with the '+++' file in the diff output.
00588 proc parse_unified_diff {txt cmd} {
00589
00590 # Execute the difference command
00591 catch { exec -ignorestderr {*}$cmd } rc
00592
00593 # Open the UI for editing
00594 $txt configure -state normal
00595
00596 # Reset the diff output
00597 $txt diff reset
00598
00599 # Initialize variables
00600 set adds 0
00601 set subs 0
00602 set strSub ""
00603 set total_subs 0
00604
00605 # Parse the output
00606 foreach line [split $rc \n] {
00607 if {[regexp {^@@\s+\-\d+,\d+\s+\+(\d+),\d+\s+@@$} $line -> tline]} {
00608 set adds 0
00609 set subs 0
00610 set strSub ""
00611 incr tline $total_subs
00612 } else {
00613 if {[regexp {^\+([^+]|$)} $line]} {
00614 if {$subs > 0} {
00615 $txt diff sub [expr $tline - $subs] $subs $strSub
00616 set subs 0
00617 set strSub ""
00618 }
00619 incr adds
00620 } elseif {[regexp {^\-([^-].*$|$)} $line -> str]} {
00621 if {$adds > 0} {
00622 $txt diff add [expr $tline - $adds] $adds
00623 set adds 0
00624 }
00625 append strSub "$str\n"
00626 incr subs
00627 incr total_subs
00628 } else {
00629 if {$adds > 0} {
00630 $txt diff add [expr $tline - $adds] $adds
00631 set adds 0
00632 } elseif {$subs > 0} {
00633 $txt diff sub [expr $tline - $subs] $subs $strSub
00634 set subs 0
00635 set strSub ""
00636 }
00637 }
00638 incr tline
00639 }
00640 }
00641
00642 # If we have any adds or subs left over to process, process them now
00643 if {$adds > 0} {
00644 $txt diff add [expr $tline - $adds] $adds
00645 } elseif {$subs > 0} {
00646 $txt diff sub [expr $tline - $subs] $subs $strSub
00647 }
00648
00649 # Disable the text window from editing
00650 $txt configure -state disabled
00651
00652 # Update the scrollers
00653 gui::get_info $txt txt tab
00654 gui::update_tab_markers $tab
00655
00656 }
00657
00658 ######################################################################
00659 # Returns the difference mark information as required by the scroller
00660 # widget.
00661 proc get_marks {txt} {
00662
00663 # Get the total number of lines in the text widget
00664 set lines [$txt count -lines 1.0 end]
00665
00666 # Add the difference marks
00667 set marks [list]
00668 foreach type [list sub add] {
00669 set color [theme::get_value syntax difference_$type]
00670 foreach {start end} [$txt diff ranges $type] {
00671 set start_line [lindex [split $start .] 0]
00672 set end_line [lindex [split $end .] 0]
00673 lappend marks [expr $start_line.0 / $lines] [expr $end_line.0 / $lines] $color
00674 }
00675 }
00676
00677 return $marks
00678
00679 }
00680
00681 ######################################################################
00682 # CVS TOOL NAMESPACES
00683 ######################################################################
00684
00685 ######################################################################
00686 # Handles Perforce commands
00687 namespace eval perforce {
00688
00689 proc name {} {
00690 return "Perforce"
00691 }
00692
00693 proc type {} {
00694 return "cvs"
00695 }
00696
00697 proc handles {fname} {
00698 return [expr {![catch { exec p4 filelog $fname }]}]
00699 }
00700
00701 proc versions {fname} {
00702 set versions [list]
00703 if {![catch { exec p4 filelog $fname } rc]} {
00704 foreach line [split $rc \n] {
00705 if {[regexp {^\.\.\.\s+#(\d+)} $line -> version]} {
00706 lappend versions $version
00707 }
00708 }
00709 }
00710 return $versions
00711 }
00712
00713 proc get_file_cmd {version fname} {
00714 return "|p4 print $fname#$version"
00715 }
00716
00717 proc get_diff_cmd {v1 v2 fname} {
00718 if {$v2 eq "Current"} {
00719 set ::env(P4DIFF) ""
00720 return "p4 diff -du ${fname}#$v1"
00721 } else {
00722 return "p4 diff2 -u ${fname}#$v1 ${fname}#$v2"
00723 }
00724 }
00725
00726 proc get_current_version {fname} {
00727 if {![catch { exec p4 have $fname } rc]} {
00728 foreach line [split $rc \n] {
00729 if {[regexp {^\.\.\.\s+#(\d+)} $line -> version]} {
00730 return $version
00731 }
00732 }
00733 }
00734 return ""
00735 }
00736
00737 proc find_version {fname v2 lnum} {
00738 if {$v2 eq "Current"} {
00739 if {![catch { exec p4 annotate $fname } rc]} {
00740 if {[regexp {^(\d+):} [lindex [split $rc \n] $lnum] -> version]} {
00741 return $version
00742 }
00743 }
00744 } else {
00745 if {![catch { exec p4 annotate ${fname}#$v2 } rc]} {
00746 if {[regexp {^(\d+):} [lindex [split $rc \n] $lnum] -> version]} {
00747 return $version
00748 }
00749 }
00750 }
00751 return ""
00752 }
00753
00754 proc get_version_log {fname version} {
00755 if {![catch { exec p4 filelog -l -m 1 $fname#$version } rc]} {
00756 return $rc
00757 }
00758 return ""
00759 }
00760
00761 }
00762
00763 ######################################################################
00764 # Handles Mercurial commands
00765 namespace eval mercurial {
00766
00767 proc name {} {
00768 return "Mercurial"
00769 }
00770
00771 proc type {} {
00772 return "cvs"
00773 }
00774
00775 proc handles {fname} {
00776 return [expr {![catch { exec hg status $fname }]}]
00777 }
00778
00779 proc versions {fname} {
00780 set versions [list]
00781 if {![catch { exec hg log $fname } rc]} {
00782 foreach line [split $rc \n] {
00783 if {[regexp {changeset:\s+(\d+):} $line -> version]} {
00784 lappend versions $version
00785 }
00786 }
00787 }
00788 return $versions
00789 }
00790
00791 proc get_file_cmd {version fname} {
00792 return "|hg cat -r $version $fname"
00793 }
00794
00795 proc get_diff_cmd {v1 v2 fname} {
00796 if {$v2 eq "Current"} {
00797 return "hg diff -r $v1 $fname"
00798 } else {
00799 return "hg diff -r $v1 -r $v2 $fname"
00800 }
00801 }
00802
00803 proc get_current_version {fname} {
00804 if {![catch { exec hg parent $fname } rc]} {
00805 foreach line [split $rc \n] {
00806 if {[regexp {changeset:\s+(\d+):} $line -> version]} {
00807 return $version
00808 }
00809 }
00810 }
00811 return ""
00812 }
00813
00814 proc find_version {fname v2 lnum} {
00815 if {$v2 eq "Current"} {
00816 if {![catch { exec hg annotate $fname } rc]} {
00817 if {[regexp "^\\s*(\\d+):" [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00818 return $version
00819 }
00820 }
00821 } else {
00822 if {![catch { exec hg annotate -r $v2 $fname } rc]} {
00823 if {[regexp "^\\s*(\\d+):" [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00824 return $version
00825 }
00826 }
00827 }
00828 return ""
00829 }
00830
00831 proc get_version_log {fname version} {
00832 if {![catch { exec hg log -r $version $fname } rc]} {
00833 return $rc
00834 }
00835 return ""
00836 }
00837
00838 }
00839
00840 ######################################################################
00841 # Handles GIT commands
00842 namespace eval git {
00843
00844 proc name {} {
00845 return "Git"
00846 }
00847
00848 proc type {} {
00849 return "cvs"
00850 }
00851
00852 proc handles {fname} {
00853 return [expr {![catch { exec git log -n 1 $fname }]}]
00854 }
00855
00856 proc versions {fname} {
00857 set versions [list]
00858 set ::env(PAGER) ""
00859 if {![catch { exec git log --abbrev-commit $fname } rc]} {
00860 foreach line [split $rc \n] {
00861 if {[regexp {^commit ([0-9a-fA-F]+)} $line -> version]} {
00862 lappend versions $version
00863 }
00864 }
00865 }
00866 return $versions
00867 }
00868
00869 proc get_file_cmd {version fname} {
00870 return "|git show $version:$fname"
00871 }
00872
00873 proc get_diff_cmd {v1 v2 fname} {
00874 if {$v2 eq "Current"} {
00875 return "git diff $v1 $fname"
00876 } else {
00877 return "git diff $v1 $v2 $fname"
00878 }
00879 }
00880
00881 proc get_current_version {fname} {
00882 if {![catch { exec git log --abbrev-commit $fname } rc]} {
00883 foreach line [split $rc \n] {
00884 if {[regexp {^commit ([0-9a-fA-F]+)} $line -> version]} {
00885 return $version
00886 }
00887 }
00888 }
00889 return ""
00890 }
00891
00892 proc find_version {fname v2 lnum} {
00893 if {$v2 eq "Current"} {
00894 if {![catch { exec git blame $fname } rc]} {
00895 if {[regexp {^([0-9a-fA-F]+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00896 return $version
00897 }
00898 }
00899 } else {
00900 if {![catch { exec git blame $v2 $fname } rc]} {
00901 if {[regexp {^([0-9a-fA-F]+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00902 return $version
00903 }
00904 }
00905 }
00906 return ""
00907 }
00908
00909 proc get_version_log {fname version} {
00910 if {![catch { exec git log -n 1 $version $fname } rc]} {
00911 return $rc
00912 }
00913 return ""
00914 }
00915
00916 }
00917
00918 ######################################################################
00919 # Handles Bazaar commands
00920 namespace eval bazaar {
00921
00922 proc name {} {
00923 return "Bazaar"
00924 }
00925
00926 proc type {} {
00927 return "cvs"
00928 }
00929
00930 proc handles {fname} {
00931 return [expr {![catch { exec bzr status $fname }]}]
00932 }
00933
00934 proc versions {fname} {
00935 set versions [list]
00936 if {![catch { exec bzr log $fname } rc]} {
00937 foreach line [split $rc \n] {
00938 if {[regexp {revno:\s+(\d+)} $line -> version]} {
00939 lappend versions $version
00940 }
00941 }
00942 }
00943 return $versions
00944 }
00945
00946 proc get_file_cmd {version fname} {
00947 return "|bzr cat -r $version $fname"
00948 }
00949
00950 proc get_diff_cmd {v1 v2 fname} {
00951 if {$v2 eq "Current"} {
00952 return "bzr diff -r$v1 $fname"
00953 } else {
00954 return "bzr diff -r$v1..$v2 $fname"
00955 }
00956 }
00957
00958 proc get_current_version {fname} {
00959 if {![catch { exec bzr log $fname } rc]} {
00960 foreach line [split $rc \n] {
00961 if {[regexp {revno:\s+(\d+)} $line -> version]} {
00962 return $version
00963 }
00964 }
00965 }
00966 return ""
00967 }
00968
00969 proc find_version {fname v2 lnum} {
00970 if {$v2 eq "Current"} {
00971 if {![catch { exec bzr annotate $fname } rc]} {
00972 if {[regexp {^(\d+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00973 return $version
00974 }
00975 }
00976 } else {
00977 if {![catch { exec bzr annotate -r $v2 $fname } rc]} {
00978 if {[regexp {^(\d+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
00979 return $version
00980 }
00981 }
00982 }
00983 return ""
00984 }
00985
00986 proc get_version_log {fname version} {
00987 if {![catch { exec bzr log -r $version $fname } rc]} {
00988 return $rc
00989 }
00990 return ""
00991 }
00992
00993 }
00994
00995 ######################################################################
00996 # Handles Subversion commands
00997 namespace eval subversion {
00998
00999 proc name {} {
01000 return "Subversion"
01001 }
01002
01003 proc type {} {
01004 return "cvs"
01005 }
01006
01007 proc handles {fname} {
01008 return [expr {![catch { exec svn log $fname }]}]
01009 }
01010
01011 proc versions {fname} {
01012 set versions [list]
01013 if {![catch { exec svn log $fname } rc]} {
01014 foreach line [split $rc \n] {
01015 if {[regexp {^r(\d+)\s*\|} $line -> version]} {
01016 lappend versions $version
01017 }
01018 }
01019 }
01020 return $versions
01021 }
01022
01023 proc get_file_cmd {version fname} {
01024 return "|svn cat -r $version $fname"
01025 }
01026
01027 proc get_diff_cmd {v1 v2 fname} {
01028 if {$v2 eq "Current"} {
01029 return "svn diff -r $v1 $fname"
01030 } else {
01031 return "svn diff -r $v1:$v2 $fname"
01032 }
01033 }
01034
01035 proc get_current_version {fname} {
01036 if {![catch { exec svn FOOBAR $fname } rc]} {
01037 foreach line [split $rc \n] {
01038 if {[regexp {^r(\d+)\s*\|} $line -> version]} {
01039 lappend versions $version
01040 }
01041 }
01042 }
01043 return ""
01044 }
01045
01046 proc find_version {fname v2 lnum} {
01047 if {$v2 eq "Current"} {
01048 if {![catch { exec svn annotate $fname } rc]} {
01049 if {[regexp {^\s*(\d+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
01050 return $version
01051 }
01052 }
01053 } else {
01054 if {![catch { exec svn annotate -r $v2 $fname } rc]} {
01055 if {[regexp {^\s*(\d+)} [lindex [split $rc \n] [expr $lnum - 1]] -> version]} {
01056 return $version
01057 }
01058 }
01059 }
01060 return ""
01061 }
01062
01063 proc get_version_log {fname version} {
01064 if {![catch { exec svn log -r $version $fname } rc]} {
01065 return $rc
01066 }
01067 return ""
01068 }
01069
01070 }
01071
01072 ######################################################################
01073 # Handles CVS commands
01074 namespace eval cvs {
01075
01076 proc name {} {
01077 return "CVS"
01078 }
01079
01080 proc type {} {
01081 return "cvs"
01082 }
01083
01084 proc handles {fname} {
01085 return [expr {![catch { exec cvs log $fname }]}]
01086 }
01087
01088 proc versions {fname} {
01089 set versions [list]
01090 if {![catch { exec cvs log $fname } rc]} {
01091 foreach line [split $rc \n] {
01092 if {[regexp {^revision\s+(.*)$} $line -> version]} {
01093 lappend versions $version
01094 }
01095 }
01096 }
01097 return $versions
01098 }
01099
01100 proc get_file_cmd {version fname} {
01101 return "|cvs update -p -r $version $fname"
01102 }
01103
01104 proc get_diff_cmd {v1 v2 fname} {
01105 if {$v2 eq "Current"} {
01106 return "cvs diff -u -r $v1 $fname"
01107 } else {
01108 return "cvs diff -u -r $v1 -r $v2 $fname"
01109 }
01110 }
01111
01112 proc get_current_version {fname} {
01113 if {![catch { exec cvs FOOBAR $fname } rc]} {
01114 foreach line [split $rc \n] {
01115 if {[regexp {^revision\s+(.*)$} $line -> version]} {
01116 return $version
01117 }
01118 }
01119 }
01120 return ""
01121 }
01122
01123 proc find_version {fname v2 lnum} {
01124 if {$v2 eq "Current"} {
01125 if {![catch { exec cvs annotate $fname } rc]} {
01126 if {[regexp {^(\S+)} [lindex [split $rc \n] [expr $lnum - 2]] -> version]} {
01127 return $version
01128 }
01129 }
01130 } else {
01131 if {![catch { exec cvs annotate -r $v2 $fname } rc]} {
01132 if {[regexp {^(\S+)} [lindex [split $rc \n] [expr $lnum - 2]] -> version]} {
01133 return $version
01134 }
01135 }
01136 }
01137 }
01138
01139 proc get_version_log {fname version} {
01140 if {![catch { exec cvs log -r$version $fname } rc]} {
01141 return $rc
01142 }
01143 return ""
01144 }
01145
01146 }
01147
01148 ######################################################################
01149 # Handles diff commands
01150 namespace eval diff {
01151
01152 proc name {} {
01153 return "diff"
01154 }
01155
01156 proc type {} {
01157 return "file"
01158 }
01159
01160 proc handles {fname} {
01161 return 0
01162 }
01163
01164 proc get_diff_cmd {fname1 fname2} {
01165 return "diff -u $fname1 $fname2"
01166 }
01167
01168 proc get_current_version {fname} {
01169 return ""
01170 }
01171
01172 }
01173
01174 ######################################################################
01175 # Handles custom commands
01176 namespace eval custom {
01177
01178 proc name {} {
01179 return "custom"
01180 }
01181
01182 proc type {} {
01183 return "command"
01184 }
01185
01186 proc handles {fname} {
01187 return 0
01188 }
01189
01190 }
01191
01192 ######################################################################
01193 # DIFFERENCE MAP WIDGET
01194 ######################################################################
01195
01196 ######################################################################
01197 # Creates the difference map which is basically a colored scrollbar.
01198 proc map {win txt args} {
01199
01200 variable data
01201
01202 array set opts {
01203 -background "black"
01204 -foreground "white"
01205 -command ""
01206 }
01207 array set opts $args
01208
01209 set data($txt,-background) $opts(-background)
01210 set data($txt,-foreground) $opts(-foreground)
01211 set data($txt,-command) $opts(-command)
01212
01213 # Create the canvas
01214 set data($txt,canvas) [canvas $win -width 15 -relief flat -bd 1 -highlightthickness 0 -bg $data($txt,-background)]
01215
01216 # Create canvas bindings
01217 bind $data($txt,canvas) <Configure> [list diff::map_configure $txt]
01218 bind $data($txt,canvas) <Button-1> [list diff::map_position_slider %W %y $txt]
01219 bind $data($txt,canvas) <B1-Motion> [list diff::map_position_slider %W %y $txt]
01220 bind $data($txt,canvas) <MouseWheel> [list event generate $txt.t <MouseWheel> -delta %D]
01221 bind $data($txt,canvas) <4> [list event generate $txt.t <4>]
01222 bind $data($txt,canvas) <5> [list event generate $txt.t <5>]
01223
01224 rename ::$win $win
01225 interp alias {} ::$win {} diff::map_command $txt
01226
01227 return $win
01228
01229 }
01230
01231 ######################################################################
01232 # Executes map commands.
01233 proc map_command {txt args} {
01234
01235 variable data
01236
01237 set args [lassign $args cmd]
01238
01239 switch $cmd {
01240
01241 get {
01242 return [list $data($txt,first) $data($txt,last)]
01243 }
01244
01245 set {
01246 lassign $args first last
01247 set height [winfo height $data($txt,canvas)]
01248 set y1 [expr int( $height * $first )]
01249
01250 # Adjust the size and position of the slider
01251 $data($txt,canvas) coords $data($txt,slider) 2 [expr $y1 + 2] 15 [expr $y1 + $data($txt,sheight)]
01252 }
01253
01254 configure {
01255 array set opts $args
01256 if {[info exists opts(-background)]} {
01257 set data($txt,-background) $opts(-background)
01258 }
01259 if {[info exists opts(-foreground)]} {
01260 set data($txt,-foreground) $opts(-foreground)
01261 }
01262 $data($txt,canvas) configure -bg $data($txt,-background)
01263 if {[info exists data($txt,slider)]} {
01264 $data($txt,canvas) itemconfigure $data($txt,slider) -outline $data($txt,-foreground)
01265 }
01266 }
01267
01268 default {
01269 return -code error "difference map called with invalid command ($cmd)"
01270 }
01271
01272 }
01273
01274 }
01275
01276 ######################################################################
01277 # Handles a left-click or click-drag in the canvas area, positioning
01278 # the cursor at the given position.
01279 proc map_position_slider {W y txt} {
01280
01281 variable data
01282
01283 if {$data($txt,-command) ne ""} {
01284
01285 # Calculate the moveto fraction
01286 set moveto [expr ($y.0 - ($data($txt,sheight) / 2)) / [winfo height $W]]
01287
01288 # Call the command
01289 uplevel #0 "$data($txt,-command) moveto $moveto"
01290
01291 }
01292
01293 }
01294
01295 ######################################################################
01296 # Called whenever the map widget is configured.
01297 proc map_configure {txt} {
01298
01299 variable data
01300
01301 # Remove all canvas items
01302 $data($txt,canvas) delete all
01303
01304 # Add the difference bars
01305 foreach type [list sub add] {
01306 foreach {start end} [$txt diff ranges $type] {
01307 set start_line [lindex [split $start .] 0]
01308 set end_line [lindex [split $end .] 0]
01309 map_add $txt $type $start_line [expr $end_line - $start_line]
01310 }
01311 }
01312
01313 # Calculate the slider height
01314 lassign [$txt yview] first last
01315 set height [winfo height $data($txt,canvas)]
01316 set sheight [expr ((int( $height * $last ) - int( $height * $first )) + 1) - 4]
01317 set data($txt,sheight) [expr ($sheight < 11) ? 11 : $sheight]
01318
01319 # Add cursor
01320 set data($txt,slider) [$data($txt,canvas) create rectangle 2 0 15 10 -outline $data($txt,-foreground) -width 2]
01321 map_command $txt set $first $last
01322
01323 }
01324
01325 ######################################################################
01326 # Adds a sub or add bar to the associated widget.
01327 proc map_add {txt type start lines} {
01328
01329 variable data
01330
01331 # Get the number of lines in the text widget
01332 set txt_lines [lindex [split [$txt index end-1c] .] 0]
01333
01334 # Get the height of the box to add
01335 set y1 [expr int( ($start.0 / $txt_lines) * [winfo height $data($txt,canvas)] )]
01336 set y2 [expr int( (($start + $lines.0) / $txt_lines) * [winfo height $data($txt,canvas)] )]
01337
01338 # Get the color to display
01339 set color [expr {($type eq "sub") ? [$txt cget -diffsubbg] : [$txt cget -diffaddbg]}]
01340
01341 # Create the rectangle and place it in the widget
01342 $data($txt,canvas) create rectangle 0 $y1 15 $y2 -fill $color -width 0
01343
01344 }
01345
01346 }
01347
01348
