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