tkrev_9.6.1/0000775000175000017500000000000015034253755013265 5ustar dorothyrdorothyrtkrev_9.6.1/LICENSE.txt0000664000175000017500000004310015034253755015106 0ustar dorothyrdorothyr GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, see . Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Moe Ghoul, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. tkrev_9.6.1/FAQ.txt0000664000175000017500000002201615034253755014436 0ustar dorothyrdorothyrQ1. I get an error that says "error in startup script-invalid command name "picklist_load" while executing "picklist_load" (file"usr/local/bin/tkrev"line 1) Q2. The "Hide" and "Show" fields don't seem to do anything. Q3. How do I log in to a remote server? Q4. Can I use a diff tool other than tkdiff with tkrev? Q5. How do I import a new module? Q6. I can't get the Module Browser to work with my CVSROOT/modules file! Q7. I haven't put the tkrev extensions in my CVSROOT/modules file yet. Can I still use tkrev to check out a project? Q8. What good are modules anyway? Q9. I'm seeing strange behavior - things just don't act right. Q10. Why is the Branch Browser so slow in Subversion? Q11. How to run tkrev on Mac OSX? Q12. Which Xdefaults affect tkrev? ----------------------------------------------------------------- Q1. I get an error that says "error in startup script-invalid command name "picklist_load" while executing "picklist_load" (file"usr/local/bin/tkrev"line 1) A. Did you run doinstall.tcl? If yes, make sure you don't have a TCLROOT environment variable that's pointing to somewhere other than where it put tkrev' .tcl files. If that's not the trouble, do "command -v tkrev" to find which tkrev you're executing. Look at that file and see what TclRoot is set to. Are the .tcl files in $TclRoot/tkrev? Is there a tclIndex there? ----------------------------------------------------------------- Q2. The "Hide" and "Show" fields don't seem to do anything. A. "Hide" works exactly the way a .cvsignore file works. That is, it causes non-CVS files with the pattern to be ignored. It's meant for hiding .o files and such. Any file under CVS control will be listed anyway. "Show" is the inverse - it hides non-CVS files except for those with the pattern. ----------------------------------------------------------------- Q3. How do I log in to a remote server? A. There's no way to transmit a password through tkrev, but luckily you don't have to. If it's a pserver, do "cvs login" once from the command line, then start tkrev. CVS client saves your password (encrypted) in your .cvspass file. For remote access via ssh, you normally upload your public key to the remote machine so it won't ask for a password. (If you have a shell account, it goes in ~/.ssh/authorized_keys.) Then you set your environment like this: % setenv CVSROOT username@cvs.tkrev.sourceforge.net:/cvsroot/project % setenv CVS_RSH ssh If you can't use authorized keys for some reason, you can use ssh-agent: % ssh-agent $SHELL % setenv CVSROOT username@cvs.tkrev.sourceforge.net:/cvsroot/project % setenv CVS_RSH ssh % ssh-add (type passphrase) % tkrev ----------------------------------------------------------------- Q4. Can I use a diff tool other than tkdiff with tkrev? A. Yes, by changing cvscfg(tkdiff). You usually have to write a wrapper for your diff tool to get it to check out the versions, and and deal with its particular command-line options, which are probably different from tkdiff's. In the contrib directory, there is a gvim-wrapper called "cvsdiff" which can be used as-is or as a model for wrapping your favorite diff tool. ----------------------------------------------------------------- Q5. How do I import a new module? Get your new directory the way you want it. Cd into the directory. Press the big "Module Browser" button in the top part of the tkrev UI. In the Module Browser, press the rightmost button on the bottom, the one that shows a folder and an up arrow. In the dialog that pops up, fill in a descriptive title for the module. This will be what you see in the right side of the Module Browser. OK the dialog. Several things happen now. The directory is imported, the CVSROOT/module file is updated, your original directory is saved as directory.orig, and the newly created module is checked out. When the dust clears, you should find the original Working Directory Browser showing the files in the newly created, checked out module. The most common cause of failure here is not having the proper permissions to write to the repository. ----------------------------------------------------------------- Q6. I can't get the Module Browser to work with my CVSROOT/modules file! A. Make sure the fields in your file are separated by TABS! Does your editor automatically de-tab when you save a file? (Hint: if your editor has syntax highlighting, use the Makefile mode.) Not quite every possible module arrangement that can be specified in the modules file can be reflected in the Module Browser. That's a little better in version 7.x than it was previously, but the tradeoff was that there's less freedom to create fictional directory trees. ----------------------------------------------------------------- Q7. I haven't put the tkrev extensions in my CVSROOT/modules file yet. Can I still use tkrev to check out a project? A. Yes. Start tkrev. Open the Module Browser. It will be empty because there's no modules file, but type the name of the project in the "Module" entry. Press the Checkout button (the ball with the arrow). ----------------------------------------------------------------- Q8. What good are modules anyway? A. It's hard to see the utility of modules unless you have projects that have nested directories. Defining a directory as a module makes it behave as though it were at the top level of your repository. For example, the repository may contain documentation in a structure like this: manuals | | - programA - reference manual | | | |------appnotes | | - programB - reference manual | |------appnotes If I didn't use modules and I wanted to check out only the programA documents, I'd have to say "cvs co manuals/programA". But since I have a line in the CVSROOT/modules file that says programA manuals/programA I can say "cvs co programA". That may not help much in this simple example, but as the project tree gets deeper, it becomes handy. You can also make a module out of different directories that are not so obviously grouped, or make a module that includes some files in a directory and not others. ----------------------------------------------------------------- Q9. I'm seeing strange behavior - things just don't act right. A. Do you have a .cvsrc file or other .cvs* files lurking about? If you change cvs's behaviour in certain ways, it can trick tkrev. Be especially careful of modifying "cvs log". ----------------------------------------------------------------- Q10. Why is the Branch Browser so slow in Subversion? A. Actually it's a lot faster as of tkrev version 9.0. It's because SVN doesn't have tags or branches, it only has copies. The brute-force method I came up with to reconstruct a diagram requires a lot of repository accesses for branches and tags. Open the trace window and take a look at what tkrev is doing to build that diagram. It will give you something to watch while it's chugging, at least. If you convert a CVS repository to SVN, my recommendation would be to discard non-branch tags. If there are very many, most likely all but the most recent ones have value only as archaeological curiosities anyway. There's a cvscfg setting that determines how many tags are too many to process. I figured that would be different depending on how remote the repository is. There's also an option on the branch browser not to process non-branch tags at all. If you can't get rid of them, that's probably what you'll need to do. ----------------------------------------------------------------- Q11. How to run tkrev on Mac OSX? A. My favorite way of running tkrev on the Mac is simply to install the platform-independent tkrev in /usr/local/bin or someplace like that, and invoke it from the command line. With the full Mac version of Wish installed, there will be a /usr/bin/wish that invokes the Wish.app. (Install Wish and do "command -v wish" to see how that works.) If you want to have a double-clickable app bundle, you can use something like Platypus (https://sveinbjorn.org/platypus) to create a wrapper. Or, you can run it in X11 on the Mac if you've installed XQuartz. ----------------------------------------------------------------- Q12. Which Xdefaults affect tkrev? A. To set your own colors, you can use these entries in your Xdefaults tkrev*background: gray80 tkrev*foreground: black tkrev*Menu.background: gray65 tkrev*Menu.foreground: white tkrev*Button.background: gray75 tkrev*Button.foreground: black tkrev*Canvas.background: gray90 tkrev*Canvas.foreground: black tkrev*Text.background: gray90 tkrev*Text.foreground: black tkrev*Text.selectBackground: slateblue tkrev*Text.selectForeground: white tkrev*Menu.font: {Serif 12} tkrev*Button.font: {Serif 11} tkrev*Label.font: {Cantarell 10} tkrev*List.font: {Cantarell 10} tkrev*Text.font: {DejaVu Sans Mono 10} tkrev_9.6.1/tkrev/0000775000175000017500000000000015034253755014420 5ustar dorothyrdorothyrtkrev_9.6.1/tkrev/errors.tcl0000664000175000017500000000316013765056474016450 0ustar dorothyrdorothyr# # Tcl Library # # # Procedures for unimplemented procedures and error messages used by # TkRev. # proc cvsok {mess {parent {.}} } { # Sometimes cancel is meaningless, we just want an acknowlegement if {! [winfo exists $parent]} {set parent .} set title {Acknowledge!} tk_messageBox \ -icon info \ -title $title \ -message $mess \ -parent $parent \ -type ok } proc cvsconfirm {mess {parent {.}} } { global cvscfg if {$cvscfg(confirm_prompt) != "true"} { return "ok" } if {! [winfo exists $parent]} {set parent .} set title {Confirm!} set answer [tk_messageBox \ -icon question \ -title $title \ -message $mess \ -parent $parent \ -type okcancel] gen_log:log D "$answer" return $answer } # This one doesn't check cvscfg(confirm_prompt) preference proc cvsalwaysconfirm {mess {parent {.}} } { if {! [winfo exists $parent]} {set parent .} set title {Confirm!} set answer [tk_messageBox \ -icon question \ -title $title \ -message $mess \ -parent $parent \ -type okcancel] gen_log:log D "$answer" return $answer } proc cvsfail {mess {parent {.}} } { if {! [winfo exists $parent]} {set parent .} set title {TkRev Warning!} tk_messageBox \ -icon warning \ -title $title \ -message $mess \ -parent $parent \ -type ok } proc cvserror {mess {parent {.}} } { if {! [winfo exists $parent]} {set parent .} set title {TkRev Error!} tk_messageBox \ -icon error \ -title $title \ -message $mess \ -parent $parent \ -type ok exit_cleanup 0 } tkrev_9.6.1/tkrev/modules.tcl0000664000175000017500000000736714715566005016611 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # Procedures to parse the CVS modules file and store whatever is # read into various associative arrays, sorted, and unsorted lists. # # # Global variables: # # modval # The string that specifies or defines the module. # modtitle # The descriptive title of the module. If not specified, modval is used. # cvscfg # General configuration variables (array) # filenames # For each module, the list of files that it contains. proc gather_mod_index {} { # # Creates a new global list called modlist for the report printouts # global cvscfg global modtitle global dcontents global dparent global modlist global modlist_sorted #gen_log:log T "ENTER ()" set modlist {} set dlist {} if {! [info exists modtitle]} { gen_log:log T "LEAVE (no modtitle array)" return } foreach d [array names dcontents] { #gen_log:log D "dcontents($d) is $dcontents($d)" foreach i $dcontents($d) { lappend dlist $i set path [file join $d $i] set dparent($path) $d #gen_log:log D "dparent($path) is $d" } } foreach mcode [array names modtitle] { # Skip aliases if {[string match "-a *" $modtitle($mcode)]} { continue } # Dont add subdirs to the list set match 0 foreach i $dlist { if {$i == $mcode} { set match 1 } } if {! $match} { lappend modlist "$mcode\t$modtitle($mcode)" } } set modlist_sorted [lsort $modlist] if {$cvscfg(logging) && [regexp -nocase {d} $cvscfg(log_classes)]} { foreach idx $modlist_sorted { #gen_log:log D "$idx" set dname [lindex $idx 0] if {[info exists dparent($dname)]} { #gen_log:log D " PARENT: $dparent($dname)" } if {[info exists dcontents($dname)]} { #gen_log:log D " CHILDREN: $dcontents($dname)" } set desc [find_subdirs $dname 0] if {$desc != ""} { #gen_log:log D " SUBDIRS: $desc" } } } #gen_log:log T "LEAVE" } proc find_filenames {mcode} { # # This does the work of setting up the filenames array for a module, # containing the list of file names within it. # global filenames global cwd global cvs global cvscfg global checkout_version global feedback gen_log:log T "ENTER ($mcode)" if {[info exists filenames($mcode)]} { set filenames($mcode) "" } # Trick of using rdiff to list files without checking them out # derived from "cvsls" by Eugene Kramer # cvs 1.9: # Need to use -f with pserver, or it skips files that havent # changed. With local repository, it reports them as new. # But without pserver, it skips them with -f but not without! # cvs 1.10.8: # Both pserver and local act like 1.9 local, that is, -f makes # it skip new files. set commandline \ "$cvs -d $cvscfg(cvsroot) rdiff -s -D 01/01/1971 $mcode" gen_log:log C $commandline catch {exec {*}$commandline} view_this set view_lines [split $view_this "\n"] foreach line $view_lines { gen_log:log D "$line" if {[string match "File *" $line]} { set lst [split $line] set cut [expr {[llength $lst] - 6}] set dname [join [lrange $lst 1 $cut]] #gen_log:log D "$dname" lappend filenames($mcode) $dname } } gen_log:log T "LEAVE" } proc find_subdirs {mname level} { global dcontents global subdirs #gen_log:log T "ENTER ($mname $level)" if {$level == 0} { set subdirs {} } if {[info exists dcontents($mname)]} { #gen_log:log D "$mname contents: {$dcontents($mname)}" foreach d $dcontents($mname) { set path [file join $mname $d] if {[info exists dcontents($path)]} { lappend subdirs $path } find_subdirs $path 1 } } #gen_log:log T "LEAVE ($subdirs)" return $subdirs } tkrev_9.6.1/tkrev/cvs_import.tcl0000664000175000017500000001670015015446517017314 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # Import new files and directories into a CVS repository proc cvs_import_setup {} { global cwd global incvs global insvn global ingit global inrcs global cvsglb gen_log:log T "ENTER" # Make sure we're not in a directory that's already under revision control lassign [vcs_detect [pwd]] incvs insvn inrcs ingit if {$incvs} { cvsok "This directory is already in CVS.\nCan\'t import here!" .import gen_log:log T "LEAVE" return } if {$insvn} { cvsok "There are Subversion directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {$ingit} { cvsok "There are Git directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {$inrcs} { cvsok "There are RCS directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {[winfo exists .import]} { wm deiconify .import raise .import grab set .import gen_log:log T "LEAVE" return } # Set some defaults set cvsglb(newcode) [file tail $cwd] set cvsglb(newdir) $cvsglb(newcode) set cvsglb(newdesc) "Imported" # Give it a default. This is what you get without the -b option. set cvsglb(newvers) 1.1.1 toplevel .import grab set .import frame .import.top message .import.top.explain -justify left -width 500 -relief groove \ -text "This will import the current directory and its sub-directories\ into CVS, creating a new module. If you haven't created a CVS repository,\ you must do that first with \"cvs init.\"" label .import.top.lnewcode -text "New Module Name" -anchor w label .import.top.lnewdir -text "Path relative to \$CVSROOT" -anchor w label .import.top.lnewdesc -text "Descriptive Title" -anchor w label .import.top.lnewvers -text "Initial Version Number" -anchor w entry .import.top.tnewcode -textvariable cvsglb(newcode) -width 40 entry .import.top.tnewdir -textvariable cvsglb(newdir) -width 40 entry .import.top.tnewdesc -textvariable cvsglb(newdesc) -width 40 entry .import.top.tnewvers -textvariable cvsglb(newvers) -width 40 grid .import.top.explain -column 0 -row 0 -columnspan 3 -sticky ew grid .import.top.lnewcode -column 0 -row 1 -sticky w grid .import.top.tnewcode -column 1 -row 1 -sticky ew grid .import.top.lnewdir -column 0 -row 2 -sticky w grid .import.top.tnewdir -column 1 -row 2 -sticky ew grid .import.top.lnewdesc -column 0 -row 3 -sticky w grid .import.top.tnewdesc -column 1 -row 3 -sticky ew grid .import.top.lnewvers -column 0 -row 4 -sticky w grid .import.top.tnewvers -column 1 -row 4 -sticky ew frame .import.down -relief groove -borderwidth 2 button .import.down.ok -text "OK" \ -command { if {! [cvs_import_errorcheck]} { grab release .import wm withdraw .import cvs_import_do } } button .import.down.quit -text "Cancel" \ -command { grab release .import wm withdraw .import } pack .import.down -side bottom -expand yes -fill x pack .import.top -side top -expand yes -fill x pack .import.down.ok -side left -expand yes pack .import.down.quit -side left -expand yes wm title .import "Create a New Module" wm minsize .import 1 1 gen_log:log T "LEAVE" } proc cvs_import_errorcheck {} { global cvscfg global cvsglb global modlist_sorted global modval global cvs set error_exists 0 # Make sure the repository exists set command "$cvs -d $cvscfg(cvsroot) rlog" set ret [catch {exec {*}$command} output] if {$ret} { cvsok "Repository $cvscfg(cvsroot) isn't reachable or doesn't exist" .import set error_exists 1 } # Other error checks if { $cvsglb(newcode) == "" } { cvsok "You must type in a new module name." .import set error_exists 1 } if { $cvsglb(newdir) == "" } { cvsok "You must type in a new module path directory." .import set error_exists 1 } # In case the module browser isn't running if {! [info exists modlist_sorted]} { modbrowse_run } # Make sure it isn't a duplicate key foreach {key value} [array get modval] { if { $cvsglb(newcode) == $key } { cvsok "$cvsglb(newcode) is not a new Module" .import set error_exists 1 } } if {$error_exists} { return 1 } return 0 } proc cvs_import_do {} { global cvs global cvsglb global cvscfg global cwd global modlist_sorted global modval global modtitle global ExModList ExModDirList gen_log:log T "ENTER" set imdir [pwd] # See if all apropriate Directories in newdirname exist. CVS import will # create them, but we'll want to make a #D entry. set cvsglb(newdir) [string trimleft $cvsglb(newdir) "/"] set pathname [file dirname $cvsglb(newdir)] set need_Dir 0 if {$pathname != "."} { foreach idx $modlist_sorted { lappend knowndirs [lindex $idx 0] } gen_log:log D "looking for $pathname in known directories ($knowndirs)" if {$pathname ni $knowndirs} { set need_Dir 1 } } # Make a baseline tag set versions [split $cvsglb(newvers) ".,/ -"] set baseline "baseline-[join $versions {_}]" set commandline "$cvs -d \"$cvscfg(cvsroot)\" import -m \"Imported using TkRev\"" # Let it default to 1.1.1 or you will have big problems later from cvs. #if {$cvsglb(newvers) != ""} { #append commandline " -b 1.1.1" #} append commandline " \"$cvsglb(newdir)\" IMPORT $baseline" set v [viewer::new "Import Module"] $v\::log "\nCVS Import\n" $v\::do "$commandline" $v\::wait update # Update the modules file. set commandline "$cvs -d $cvscfg(cvsroot) -w checkout CVSROOT/modules" $v\::log "\nCheckout New Module\n" $v\::do "$commandline" $v\::wait cd CVSROOT gen_log:log F "CD [pwd]" set modfile [open modules a] if {$need_Dir} { puts $modfile "" gen_log:log D "#D $pathname" puts $modfile "#D $pathname" } gen_log:log D "#M\t$cvsglb(newcode)\t$cvsglb(newdesc)" puts $modfile "#M\t$cvsglb(newcode)\t$cvsglb(newdesc)" gen_log:log D "$cvsglb(newcode)\t$cvsglb(newdir)" puts $modfile "$cvsglb(newcode)\t$cvsglb(newdir)" close $modfile set commandline "$cvs -d $cvscfg(cvsroot) ci -m \"added $cvsglb(newcode)\" modules" $v\::log "\nCVS Checkin CVSROOT\n" $v\::do "$commandline" $v\::wait cd ../ gen_log:log F "CD [pwd]" set commandline "$cvs -d $cvscfg(cvsroot) -Q release -d CVSROOT" $v\::do "$commandline" $v\::wait modbrowse_run # Now check out the new module cd .. gen_log:log F "CD [pwd]" # We have to move the original stuff entirely out of the way. # Otherwise checkout won't do the whole tree. gen_log:log F "MOVE $imdir $imdir.orig" if {[file isdirectory $imdir.orig]} { file delete -force -- $imdir.orig } file rename $imdir $imdir.orig set commandline \ "$cvs -d $cvscfg(cvsroot) checkout -R \"$cvsglb(newcode)\"" #gen_log:log C "$commandline" $v\::log "\nCVS Checkout\n" $v\::do "$commandline" $v\::wait # cd to the checked out module. $cwd is the correct directory to cd to # only if the name of the new module is the same as the directory name # where the source code is in. Define ckmoddir to be used instead. set ckmoddir $cwd if { $cvsglb(newcode) != [file tail $cwd] } { set ckmoddir [file join [file dirname $cwd] $cvsglb(newcode)] } if { [catch "cd $ckmoddir" err]} { cvsok "$err" .import } else { gen_log:log F "CD [pwd]" } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/tclIndex0000664000175000017500000006126615024334743016124 0ustar dorothyrdorothyr# Tcl autoload index file, version 2.0 # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(::annotate::new) [list source [file join $dir annotate.tcl]] set auto_index(::branch_diagram::new) [list source [file join $dir branch_diagram.tcl]] set auto_index(cvs_notincvs) [list source [file join $dir cvs.tcl]] set auto_index(cvs_sandbox_runcmd) [list source [file join $dir cvs.tcl]] set auto_index(cvs_sandbox_filetags) [list source [file join $dir cvs.tcl]] set auto_index(cvs_workdir_status) [list source [file join $dir cvs.tcl]] set auto_index(cvs_remove_file) [list source [file join $dir cvs.tcl]] set auto_index(cvs_remove_dir) [list source [file join $dir cvs.tcl]] set auto_index(cvs_edit) [list source [file join $dir cvs.tcl]] set auto_index(cvs_unedit) [list source [file join $dir cvs.tcl]] set auto_index(cvs_history) [list source [file join $dir cvs.tcl]] set auto_index(cvs_add) [list source [file join $dir cvs.tcl]] set auto_index(cvs_add_dir) [list source [file join $dir cvs.tcl]] set auto_index(add_subdirs) [list source [file join $dir cvs.tcl]] set auto_index(rem_subdirs) [list source [file join $dir cvs.tcl]] set auto_index(cvs_fileview_update) [list source [file join $dir cvs.tcl]] set auto_index(cvs_fileview_checkout) [list source [file join $dir cvs.tcl]] set auto_index(cvs_log) [list source [file join $dir cvs.tcl]] set auto_index(cvs_log_rev) [list source [file join $dir cvs.tcl]] set auto_index(cvs_annotate) [list source [file join $dir cvs.tcl]] set auto_index(cvs_annotate_r) [list source [file join $dir cvs.tcl]] set auto_index(cvs_commit) [list source [file join $dir cvs.tcl]] set auto_index(cvs_tag) [list source [file join $dir cvs.tcl]] set auto_index(cvs_update) [list source [file join $dir cvs.tcl]] set auto_index(cvs_opt_update) [list source [file join $dir cvs.tcl]] set auto_index(cvs_merge) [list source [file join $dir cvs.tcl]] set auto_index(cvs_merge_tag_seq) [list source [file join $dir cvs.tcl]] set auto_index(cvs_status) [list source [file join $dir cvs.tcl]] set auto_index(cvs_check) [list source [file join $dir cvs.tcl]] set auto_index(cvs_checkout) [list source [file join $dir cvs.tcl]] set auto_index(cvs_filelog) [list source [file join $dir cvs.tcl]] set auto_index(cvs_export) [list source [file join $dir cvs.tcl]] set auto_index(cvs_patch) [list source [file join $dir cvs.tcl]] set auto_index(cvs_diff) [list source [file join $dir cvs.tcl]] set auto_index(cvs_version) [list source [file join $dir cvs.tcl]] set auto_index(cvs_reconcile_conflict) [list source [file join $dir cvs.tcl]] set auto_index(cvs_gettaglist) [list source [file join $dir cvs.tcl]] set auto_index(cvs_release) [list source [file join $dir cvs.tcl]] set auto_index(cvs_rtag) [list source [file join $dir cvs.tcl]] set auto_index(cvs_commit_dialog) [list source [file join $dir cvs.tcl]] set auto_index(cvs_ascii) [list source [file join $dir cvs.tcl]] set auto_index(cvs_binary) [list source [file join $dir cvs.tcl]] set auto_index(cvs_revert) [list source [file join $dir cvs.tcl]] set auto_index(read_cvs_dir) [list source [file join $dir cvs.tcl]] set auto_index(parse_cvsmodules) [list source [file join $dir cvs.tcl]] set auto_index(cvs_modbrowse_tree) [list source [file join $dir cvs.tcl]] set auto_index(cvs_lock) [list source [file join $dir cvs.tcl]] set auto_index(cvs_directory_merge) [list source [file join $dir cvs.tcl]] set auto_index(cvs_branches) [list source [file join $dir cvs.tcl]] set auto_index(::cvs_branchlog::new) [list source [file join $dir cvs.tcl]] set auto_index(cvs_import_setup) [list source [file join $dir cvs_import.tcl]] set auto_index(cvs_import_errorcheck) [list source [file join $dir cvs_import.tcl]] set auto_index(cvs_import_do) [list source [file join $dir cvs_import.tcl]] set auto_index(cvs_subimport_setup) [list source [file join $dir cvs_subimport.tcl]] set auto_index(cvs_subimport_do) [list source [file join $dir cvs_subimport.tcl]] set auto_index(getExistModDialog) [list source [file join $dir cvs_subimport.tcl]] set auto_index(moduleDialog) [list source [file join $dir cvs_subimport.tcl]] set auto_index(dialog_FormCreate) [list source [file join $dir dialog.tcl]] set auto_index(dialog_FormComplete) [list source [file join $dir dialog.tcl]] set auto_index(dialog_cvs_checkout) [list source [file join $dir dialog.tcl]] set auto_index(dialog_cvs_export) [list source [file join $dir dialog.tcl]] set auto_index(dialog_svn_checkout) [list source [file join $dir dialog.tcl]] set auto_index(dialog_git_clone) [list source [file join $dir dialog.tcl]] set auto_index(dialog_svn_tag) [list source [file join $dir dialog.tcl]] set auto_index(dialog_cvs_patch) [list source [file join $dir dialog.tcl]] set auto_index(dialog_svn_patch) [list source [file join $dir dialog.tcl]] set auto_index(rtag_dialog) [list source [file join $dir dialog.tcl]] set auto_index(add_dialog) [list source [file join $dir dialog.tcl]] set auto_index(tag_dialog) [list source [file join $dir dialog.tcl]] set auto_index(branch_dialog) [list source [file join $dir dialog.tcl]] set auto_index(subtract_dialog) [list source [file join $dir dialog.tcl]] set auto_index(edit_dialog) [list source [file join $dir dialog.tcl]] set auto_index(unedit_dialog) [list source [file join $dir dialog.tcl]] set auto_index(cvs_update_options) [list source [file join $dir dialog.tcl]] set auto_index(update_set_defaults) [list source [file join $dir dialog.tcl]] set auto_index(addir_dialog) [list source [file join $dir dialog.tcl]] set auto_index(subtractdir_dialog) [list source [file join $dir dialog.tcl]] set auto_index(file_input_and_do) [list source [file join $dir dialog.tcl]] set auto_index(release_dialog) [list source [file join $dir dialog.tcl]] set auto_index(svn_update_options) [list source [file join $dir dialog.tcl]] set auto_index(assemble_mergetags) [list source [file join $dir dialog.tcl]] set auto_index(dialog_merge_notice) [list source [file join $dir dialog.tcl]] set auto_index(commit_history) [list source [file join $dir dialog.tcl]] set auto_index(history_browser) [list source [file join $dir dialog.tcl]] set auto_index(git_update_options) [list source [file join $dir dialog.tcl]] set auto_index(toggle_state) [list source [file join $dir dialog.tcl]] set auto_index(comparediff) [list source [file join $dir diff.tcl]] set auto_index(comparediff_files) [list source [file join $dir diff.tcl]] set auto_index(comparediff_r) [list source [file join $dir diff.tcl]] set auto_index(comparediff_sandbox) [list source [file join $dir diff.tcl]] set auto_index(DirCanvas:create) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:newitem) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:deltree) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:unselectall) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:displaycolumns) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:sort_by_col) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:adjust_columnwidths) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:popup) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:bindings) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:makepopup) [list source [file join $dir dircanvas.tcl]] set auto_index(DirCanvas:choose_icon) [list source [file join $dir dircanvas.tcl]] set auto_index(cvsok) [list source [file join $dir errors.tcl]] set auto_index(cvsconfirm) [list source [file join $dir errors.tcl]] set auto_index(cvsalwaysconfirm) [list source [file join $dir errors.tcl]] set auto_index(cvsfail) [list source [file join $dir errors.tcl]] set auto_index(cvserror) [list source [file join $dir errors.tcl]] set auto_index(cvs_usercmd) [list source [file join $dir exec.tcl]] set auto_index(cvs_execcmd) [list source [file join $dir exec.tcl]] set auto_index(cvs_catchcmd) [list source [file join $dir exec.tcl]] set auto_index(::exec::new) [list source [file join $dir exec.tcl]] set auto_index(::viewer::new) [list source [file join $dir exec.tcl]] set auto_index(status_colortags) [list source [file join $dir exec.tcl]] set auto_index(patch_colortags) [list source [file join $dir exec.tcl]] set auto_index(rcslog_colortags) [list source [file join $dir exec.tcl]] set auto_index(truncate_git_graph) [list source [file join $dir exec.tcl]] set auto_index(::view_output::new) [list source [file join $dir exec.tcl]] set auto_index(viewer_window) [list source [file join $dir exec.tcl]] set auto_index(browse_files) [list source [file join $dir filebrowse.tcl]] set auto_index(filepath) [list source [file join $dir filebrowse.tcl]] set auto_index(module_filelog) [list source [file join $dir filebrowse.tcl]] set auto_index(module_fileview) [list source [file join $dir filebrowse.tcl]] set auto_index(module_tagview) [list source [file join $dir filebrowse.tcl]] set auto_index(gen_log:init) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:log) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:quit) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:clear) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:save) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:changeclass) [list source [file join $dir gen_log.tcl]] set auto_index(gen_log:color) [list source [file join $dir gen_log.tcl]] set auto_index(read_git_dir) [list source [file join $dir git.tcl]] set auto_index(git_workdir_status) [list source [file join $dir git.tcl]] set auto_index(find_git_remote) [list source [file join $dir git.tcl]] set auto_index(parse_gitlist) [list source [file join $dir git.tcl]] set auto_index(git_push) [list source [file join $dir git.tcl]] set auto_index(git_fetch) [list source [file join $dir git.tcl]] set auto_index(git_list_tags) [list source [file join $dir git.tcl]] set auto_index(git_log) [list source [file join $dir git.tcl]] set auto_index(git_rm) [list source [file join $dir git.tcl]] set auto_index(git_remove_dir) [list source [file join $dir git.tcl]] set auto_index(git_add) [list source [file join $dir git.tcl]] set auto_index(git_rename_ask) [list source [file join $dir git.tcl]] set auto_index(git_rename) [list source [file join $dir git.tcl]] set auto_index(git_reset) [list source [file join $dir git.tcl]] set auto_index(git_status) [list source [file join $dir git.tcl]] set auto_index(git_log_rev) [list source [file join $dir git.tcl]] set auto_index(git_show) [list source [file join $dir git.tcl]] set auto_index(git_patch) [list source [file join $dir git.tcl]] set auto_index(git_check) [list source [file join $dir git.tcl]] set auto_index(git_commit_dialog) [list source [file join $dir git.tcl]] set auto_index(git_commit) [list source [file join $dir git.tcl]] set auto_index(git_tag) [list source [file join $dir git.tcl]] set auto_index(git_branch) [list source [file join $dir git.tcl]] set auto_index(git_opt_update) [list source [file join $dir git.tcl]] set auto_index(git_checkout) [list source [file join $dir git.tcl]] set auto_index(git_clone) [list source [file join $dir git.tcl]] set auto_index(git_reconcile_conflict) [list source [file join $dir git.tcl]] set auto_index(git_annotate) [list source [file join $dir git.tcl]] set auto_index(git_annotate_r) [list source [file join $dir git.tcl]] set auto_index(git_annotate_range) [list source [file join $dir git.tcl]] set auto_index(git_fileview) [list source [file join $dir git.tcl]] set auto_index(git_branches) [list source [file join $dir git.tcl]] set auto_index(git_fast_diagram) [list source [file join $dir git.tcl]] set auto_index(::git_branchlog::new) [list source [file join $dir git.tcl]] set auto_index(list_within_list) [list source [file join $dir git.tcl]] set auto_index(list_comm) [list source [file join $dir git.tcl]] set auto_index(prune_branchlist) [list source [file join $dir git.tcl]] set auto_index(aboutbox) [list source [file join $dir help.tcl]] set auto_index(help_cvs_version) [list source [file join $dir help.tcl]] set auto_index(wish_version) [list source [file join $dir help.tcl]] set auto_index(post_text) [list source [file join $dir help.tcl]] set auto_index(put_text) [list source [file join $dir help.tcl]] set auto_index(clear_text) [list source [file join $dir help.tcl]] set auto_index(hyperlink) [list source [file join $dir help.tcl]] set auto_index(do_help) [list source [file join $dir help.tcl]] set auto_index(define_sections) [list source [file join $dir help.tcl]] set auto_index(table_of_contents) [list source [file join $dir help.tcl]] set auto_index(man_description) [list source [file join $dir help.tcl]] set auto_index(man_cli_options) [list source [file join $dir help.tcl]] set auto_index(man_current_directory) [list source [file join $dir help.tcl]] set auto_index(man_branch_diagram_browser) [list source [file join $dir help.tcl]] set auto_index(man_directory_branch_viewer) [list source [file join $dir help.tcl]] set auto_index(man_module_browser) [list source [file join $dir help.tcl]] set auto_index(man_importing_new_modules) [list source [file join $dir help.tcl]] set auto_index(man_importing_to_existing_module) [list source [file join $dir help.tcl]] set auto_index(man_vendor_merge) [list source [file join $dir help.tcl]] set auto_index(man_configuration_files) [list source [file join $dir help.tcl]] set auto_index(man_environment_variables) [list source [file join $dir help.tcl]] set auto_index(man_user_defined_menu) [list source [file join $dir help.tcl]] set auto_index(man_cvs_modules_file) [list source [file join $dir help.tcl]] set auto_index(::joincanvas::new) [list source [file join $dir joincanvas.tcl]] set auto_index(cvs_joincanvas) [list source [file join $dir joincanvas.tcl]] set auto_index(join_getlog) [list source [file join $dir joincanvas.tcl]] set auto_index(load_all_images) [list source [file join $dir load_images.tcl]] set auto_index(menubar_menus) [list source [file join $dir menubar.tcl]] set auto_index(workdir_menus) [list source [file join $dir menubar.tcl]] set auto_index(git_branch_menu) [list source [file join $dir menubar.tcl]] set auto_index(help_menu) [list source [file join $dir menubar.tcl]] set auto_index(modbrowse_menus) [list source [file join $dir menubar.tcl]] set auto_index(about_menus) [list source [file join $dir menubar.tcl]] set auto_index(git_tools_menu) [list source [file join $dir menubar.tcl]] set auto_index(modbrowse_setup) [list source [file join $dir modbrowse.tcl]] set auto_index(modbrowse_guess_vcs) [list source [file join $dir modbrowse.tcl]] set auto_index(modbrowse_run) [list source [file join $dir modbrowse.tcl]] set auto_index(module_exit) [list source [file join $dir modbrowse.tcl]] set auto_index(ModTree:create) [list source [file join $dir modbrowse.tcl]] set auto_index(ModTree:destroy) [list source [file join $dir modbrowse.tcl]] set auto_index(gather_mod_index) [list source [file join $dir modules.tcl]] set auto_index(find_filenames) [list source [file join $dir modules.tcl]] set auto_index(find_subdirs) [list source [file join $dir modules.tcl]] set auto_index(prefdialog) [list source [file join $dir preferences.tcl]] set auto_index(prefs_general) [list source [file join $dir preferences.tcl]] set auto_index(prefs_diagram) [list source [file join $dir preferences.tcl]] set auto_index(prefs_cvs) [list source [file join $dir preferences.tcl]] set auto_index(prefs_subversion) [list source [file join $dir preferences.tcl]] set auto_index(prefs_git) [list source [file join $dir preferences.tcl]] set auto_index(prefs_close) [list source [file join $dir preferences.tcl]] set auto_index(rcs_notinrcs) [list source [file join $dir rcs.tcl]] set auto_index(rcs_branches) [list source [file join $dir rcs.tcl]] set auto_index(rcs_checkout) [list source [file join $dir rcs.tcl]] set auto_index(rcs_lock) [list source [file join $dir rcs.tcl]] set auto_index(rcs_checkin) [list source [file join $dir rcs.tcl]] set auto_index(rcs_commit_dialog) [list source [file join $dir rcs.tcl]] set auto_index(rcs_tag) [list source [file join $dir rcs.tcl]] set auto_index(rcs_workdir_status) [list source [file join $dir rcs.tcl]] set auto_index(rcs_check) [list source [file join $dir rcs.tcl]] set auto_index(rcs_log) [list source [file join $dir rcs.tcl]] set auto_index(rcs_log_rev) [list source [file join $dir rcs.tcl]] set auto_index(rcs_fileview_checkout) [list source [file join $dir rcs.tcl]] set auto_index(rcs_revert) [list source [file join $dir rcs.tcl]] set auto_index(find_rcsfiles) [list source [file join $dir rcs.tcl]] set auto_index(colors:open_cde_resourcefile) [list source [file join $dir style_params.tcl]] set auto_index(colors:read_cde_palette) [list source [file join $dir style_params.tcl]] set auto_index(colors:get_cde_params) [list source [file join $dir style_params.tcl]] set auto_index(colors:get_gtk_theme) [list source [file join $dir style_params.tcl]] set auto_index(colors:get_x11_resources) [list source [file join $dir style_params.tcl]] set auto_index(colors:add_options) [list source [file join $dir style_params.tcl]] set auto_index(colors:shades) [list source [file join $dir style_params.tcl]] set auto_index(colors:sanitize_fontspec) [list source [file join $dir style_params.tcl]] set auto_index(colors:rgb2hex) [list source [file join $dir style_params.tcl]] set auto_index(colors:contrast) [list source [file join $dir style_params.tcl]] set auto_index(colors:match_desktop) [list source [file join $dir style_params.tcl]] set auto_index(read_svn_dir) [list source [file join $dir svn.tcl]] set auto_index(svn_lock) [list source [file join $dir svn.tcl]] set auto_index(svn_workdir_status) [list source [file join $dir svn.tcl]] set auto_index(svn_add) [list source [file join $dir svn.tcl]] set auto_index(svn_remove_file) [list source [file join $dir svn.tcl]] set auto_index(svn_status) [list source [file join $dir svn.tcl]] set auto_index(svn_check) [list source [file join $dir svn.tcl]] set auto_index(svn_update) [list source [file join $dir svn.tcl]] set auto_index(svn_opt_update) [list source [file join $dir svn.tcl]] set auto_index(svn_commit_dialog) [list source [file join $dir svn.tcl]] set auto_index(svn_commit) [list source [file join $dir svn.tcl]] set auto_index(svn_rename_ask) [list source [file join $dir svn.tcl]] set auto_index(svn_rename) [list source [file join $dir svn.tcl]] set auto_index(svn_annotate) [list source [file join $dir svn.tcl]] set auto_index(svn_annotate_r) [list source [file join $dir svn.tcl]] set auto_index(svn_ddiff) [list source [file join $dir svn.tcl]] set auto_index(svn_patch) [list source [file join $dir svn.tcl]] set auto_index(svn_delete) [list source [file join $dir svn.tcl]] set auto_index(svn_jit_listdir) [list source [file join $dir svn.tcl]] set auto_index(svn_jit_dircmd) [list source [file join $dir svn.tcl]] set auto_index(parse_svnmodules) [list source [file join $dir svn.tcl]] set auto_index(svn_closedir) [list source [file join $dir svn.tcl]] set auto_index(svn_log) [list source [file join $dir svn.tcl]] set auto_index(svn_log_rev) [list source [file join $dir svn.tcl]] set auto_index(svn_difflog_rev) [list source [file join $dir svn.tcl]] set auto_index(svn_show_rev) [list source [file join $dir svn.tcl]] set auto_index(svn_info) [list source [file join $dir svn.tcl]] set auto_index(svn_reconcile_conflict) [list source [file join $dir svn.tcl]] set auto_index(svn_resolve) [list source [file join $dir svn.tcl]] set auto_index(svn_revert) [list source [file join $dir svn.tcl]] set auto_index(svn_tag) [list source [file join $dir svn.tcl]] set auto_index(svn_rcopy) [list source [file join $dir svn.tcl]] set auto_index(svn_pathforcopy) [list source [file join $dir svn.tcl]] set auto_index(svn_merge) [list source [file join $dir svn.tcl]] set auto_index(svn_merge_tag_seq) [list source [file join $dir svn.tcl]] set auto_index(svn_checkout) [list source [file join $dir svn.tcl]] set auto_index(svn_filecat) [list source [file join $dir svn.tcl]] set auto_index(svn_filelog) [list source [file join $dir svn.tcl]] set auto_index(svn_fileview) [list source [file join $dir svn.tcl]] set auto_index(svn_directory_merge) [list source [file join $dir svn.tcl]] set auto_index(svn_branches) [list source [file join $dir svn.tcl]] set auto_index(safe_url) [list source [file join $dir svn.tcl]] set auto_index(::svn_branchlog::new) [list source [file join $dir svn.tcl]] set auto_index(svn_import_run) [list source [file join $dir svn_import.tcl]] set auto_index(svn_do_import) [list source [file join $dir svn_import.tcl]] set auto_index(set_tooltips) [list source [file join $dir tooltips.tcl]] set auto_index(internal_tooltips_PopUp) [list source [file join $dir tooltips.tcl]] set auto_index(internal_tooltips_PopDown) [list source [file join $dir tooltips.tcl]] set auto_index(scrollbindings) [list source [file join $dir ui_misc.tcl]] set auto_index(copy_paste_popup) [list source [file join $dir ui_misc.tcl]] set auto_index(ro_textbindings) [list source [file join $dir ui_misc.tcl]] set auto_index(save_viewcontents) [list source [file join $dir ui_misc.tcl]] set auto_index(get_textlines) [list source [file join $dir ui_misc.tcl]] set auto_index(search_textwidget_init) [list source [file join $dir ui_misc.tcl]] set auto_index(search_textwidget) [list source [file join $dir ui_misc.tcl]] set auto_index(search_listbox_init) [list source [file join $dir ui_misc.tcl]] set auto_index(search_listbox) [list source [file join $dir ui_misc.tcl]] set auto_index(dragbind) [list source [file join $dir ui_misc.tcl]] set auto_index(wheelbind) [list source [file join $dir ui_misc.tcl]] set auto_index(busy_start) [list source [file join $dir ui_misc.tcl]] set auto_index(busy_done) [list source [file join $dir ui_misc.tcl]] set auto_index(dialog_position) [list source [file join $dir ui_misc.tcl]] set auto_index(picklist_load) [list source [file join $dir ui_misc.tcl]] set auto_index(picklist_used) [list source [file join $dir ui_misc.tcl]] set auto_index(picklist_save) [list source [file join $dir ui_misc.tcl]] set auto_index(validate_dirpath) [list source [file join $dir ui_misc.tcl]] set auto_index(change_dir) [list source [file join $dir ui_misc.tcl]] set auto_index(tildecheck) [list source [file join $dir ui_misc.tcl]] set auto_index(tildChk) [list source [file join $dir ui_misc.tcl]] set auto_index(merge_run) [list source [file join $dir vendor_merge.tcl]] set auto_index(get_j) [list source [file join $dir vendor_merge.tcl]] set auto_index(put_rev_tags) [list source [file join $dir vendor_merge.tcl]] set auto_index(do_merge) [list source [file join $dir vendor_merge.tcl]] set auto_index(unpack_tag_word) [list source [file join $dir vendor_merge.tcl]] set auto_index(get_rv_tags) [list source [file join $dir vendor_merge.tcl]] set auto_index(merge_taglist) [list source [file join $dir vendor_merge.tcl]] set auto_index(vendorDialog) [list source [file join $dir vendor_merge.tcl]] set auto_index(workdir_setup) [list source [file join $dir workdir.tcl]] set auto_index(workdir_list_files) [list source [file join $dir workdir.tcl]] set auto_index(workdir_edit_command) [list source [file join $dir workdir.tcl]] set auto_index(workdir_newdir) [list source [file join $dir workdir.tcl]] set auto_index(workdir_edit_file) [list source [file join $dir workdir.tcl]] set auto_index(workdir_view_file) [list source [file join $dir workdir.tcl]] set auto_index(add_bookmark) [list source [file join $dir workdir.tcl]] set auto_index(delete_bookmark_dialog) [list source [file join $dir workdir.tcl]] set auto_index(delete_bookmark) [list source [file join $dir workdir.tcl]] set auto_index(auto_setup_dir) [list source [file join $dir workdir.tcl]] set auto_index(setup_dir) [list source [file join $dir workdir.tcl]] set auto_index(directory_list) [list source [file join $dir workdir.tcl]] set auto_index(workdir_cleanup) [list source [file join $dir workdir.tcl]] set auto_index(workdir_delete_file) [list source [file join $dir workdir.tcl]] set auto_index(are_you_sure) [list source [file join $dir workdir.tcl]] set auto_index(workdir_print_file) [list source [file join $dir workdir.tcl]] set auto_index(incvs_detect) [list source [file join $dir workdir.tcl]] set auto_index(insvn_detect) [list source [file join $dir workdir.tcl]] set auto_index(ingit_detect) [list source [file join $dir workdir.tcl]] set auto_index(inrcs_detect) [list source [file join $dir workdir.tcl]] set auto_index(vcs_detect) [list source [file join $dir workdir.tcl]] set auto_index(isCmDirectory) [list source [file join $dir workdir.tcl]] set auto_index(getFiles) [list source [file join $dir workdir.tcl]] set auto_index(log_toggle) [list source [file join $dir workdir.tcl]] set auto_index(exit_cleanup) [list source [file join $dir workdir.tcl]] set auto_index(save_options) [list source [file join $dir workdir.tcl]] tkrev_9.6.1/tkrev/git.tcl0000664000175000017500000023245115033645673015721 0ustar dorothyrdorothyr# Find where we are in path proc read_git_dir {dirname} { global cvsglb global current_tagname # See what branch we're on set cmd(git_branch) [exec::new "git branch --no-color"] set branch_lines [split [$cmd(git_branch)\::output] "\n"] foreach line $branch_lines { if {[string match {\* *} $line]} { # Could be something like (HEAD detached at 960c171) set current_tagname [join [lrange $line 1 end]] gen_log:log D "current_tagname=$current_tagname" } } # What's the top level, and where are we relative to it? set cmd(find_top) [exec::new "git rev-parse --show-toplevel"] set cvsglb(repos_top) [lindex [$cmd(find_top)\::output] 0] set wd [pwd] set l [string length $cvsglb(repos_top)] set cvsglb(relpath) [string range $wd [expr {$l+1}] end] gen_log:log D "Relative path: $cvsglb(relpath)" } proc git_workdir_status {showfiles} { global cvscfg global cvsglb global Filelist global current_tagname global module_dir gen_log:log T "ENTER ($showfiles)" read_git_dir [pwd] set module_dir $cvsglb(relpath) # git status ignores unchanged files, so we use ls-tree to list the # files in the current directory that git is tracking. set cmd(git_list) [exec::new "git ls-tree $current_tagname"] set list_lines [split [$cmd(git_list)\::output] "\n"] foreach l $list_lines { if {$l eq ""} {continue} set fname [join [lrange $l 3 end]] set type [lindex $l 1] if {$fname ni $showfiles} {continue} if {$type eq "tree"} { set Filelist($fname:status) "" } else { # preliminary, may be corrected set Filelist($fname:status) "Up-to-date" } } if {[info exists cmd(git_list)]} { $cmd(git_list)\::destroy catch {unset cmd(git_list)} } # Read git's status of the files. Always recursive below current level, and # also the filename contains the path from the top. If they're up-to-date, # git status is mute about them. set cmd(git_status) [exec::new "git status -u --porcelain ."] set status_lines [split [$cmd(git_status)\::output] "\n"] if {[info exists cmd(git_status)]} { $cmd(git_status)\::destroy catch {unset cmd(git_status)} } foreach statline $status_lines { if {[string length $statline] < 1} { continue } # MM "Dir1/F 3.txt" # M Dir2/F2.txt # R Dir1/F1.txt -> Dir1/F1mv.txt set status [string range $statline 0 1] # Strip quotes set f [string trim [join [lrange $statline 1 end]] "\""] # Trim dirname from path. Renamed ones need to be handled now if {[string match {R*} $status]} { if {[regexp {(^\S+) -> (\S+)$} $f all f1 f2]} { set dirname [file dirname $f1] if {$dirname eq "."} {set dirname ""} if {$dirname eq $module_dir} { set t1 [file tail $f1] set t2 [file tail $f2] set Filelist($t1:status) "Renamed, moved to $t2" set Filelist($t2:status) "Renamed, moved from $t1" if {$status eq "RM"} { set Filelist($t1:status) "Renamed, moved to $t2, Modified" } } } } else { regsub "^$module_dir/" $f "" f } if {[regexp {/} $f]} { gen_log:log D "$statline -> SKIP" continue } switch -glob -- $status { {M } { set Filelist($f:status) "Modified, staged" gen_log:log D "$statline -> $Filelist($f:status)" } { M} - {MM} { set Filelist($f:status) "Modified, unstaged" gen_log:log D "$statline -> $Filelist($f:status)" } {A } { set Filelist($f:status) "Added" gen_log:log D "$statline -> $Filelist($f:status)" } {AD} { set Filelist($f:status) "Added, missing" gen_log:log D "$statline -> $Filelist($f:status)" } {D } { set Filelist($f:status) "Removed" gen_log:log D "$statline -> $Filelist($f:status)" } { D} { set Filelist($f:status) "Missing" gen_log:log D "$statline -> $Filelist($f:status)" } {C*} { set Filelist($f:status) "Copied" gen_log:log D "$statline -> $Filelist($f:status)" } {AA} - {AU} - {DD} - {DU} - {UA} - {UD} - {UU} { set Filelist($f:status) "Conflict" gen_log:log D "$statline -> $Filelist($f:status)" } {??} { if {[string match {.*} $f] && ! $cvscfg(allfiles)} {continue} if {$f ni $showfiles} {continue} set Filelist($f:status) "Not managed by Git" gen_log:log D "$statline -> $Filelist($f:status)" } } } # So they're not undefined catch {set Filelist($f:date) \ [clock format [file mtime ./$i] -format $cvscfg(dateformat)]} if {$cvscfg(gitdetail)} { # This log-each-file op is time consuming, so it's enabled or disabled in ~/.tkrev # by the gitdetail variable foreach i [array names Filelist *:status] { regsub {:status$} $i {} f gen_log:log D "$f $Filelist($f:status)" if {$Filelist($f:status) eq "Not managed by Git"} { continue } if {$Filelist($f:status) eq ""} { continue } # --porcelain=1 out: XY , where X is the modification state of the index # and Y is the state of the work tree. ' ' = unmodified. # --porcelain=2 out has an extra integer field before the status and 6 extra # fields before the filename. # XY, now the second field, has "." for unmodified. set good_line "" # Format: short hash, commit time, committer, author set command "git log -n 1 --format=%h|%ct|%cn|%an -- \"$f\"" set cmd(git_log) [exec::new "$command"] set log_out [$cmd(git_log)\::output] foreach log_line [split $log_out "\n"] { if {[string length $log_line] > 0} { set good_line $log_line } } $cmd(git_log)\::destroy set items [split $good_line "|"] set hash [string trim [lindex $items 0] "\""] set wdate [string trim [lindex $items 1] "\""] set committer [string trim [lindex $items 2] "\""] set author [string trim [lindex $items 3] "\""] set Filelist($f:stickytag) $hash catch {set Filelist($f:date) [clock format $wdate -format $cvscfg(dateformat)]} set Filelist($f:editors) "$committer" if {$author ne $committer} { append Filelist($f:editors) " for $author" } if {[file isdirectory $f]} { if {[string length $log_out] > 0} { set Filelist($f:status) "" } else { set Filelist($f:status) "" } } } } gen_log:log T "LEAVE" } proc find_git_remote {dirname} { global cvscfg global cvsglb gen_log:log T "ENTER ($dirname)" if {! [info exists cvscfg(url)] } { set cvscfg(url) "" set cvscfg(origin) "" set cvsglb(fetch_url) "" } if {! [info exists cvscfg(origin)] } { set cvscfg(origin) "" } set cmd(git_config) [exec::new "git remote -v"] set lines [split [$cmd(git_config)\::output] "\n"] set i 0 foreach line $lines { if {$i == 0} { # Take the first line, whatever it is, to fill basic info set cvscfg(origin) [lindex $line 0] set cvscfg(url) [lindex $line 1] # In case fetch and push keywords aren't found set cvsglb(fetch_origin) $cvscfg(origin) set cvsglb(fetch_url) $cvscfg(url) set cvsglb(push_origin) $cvscfg(origin) set cvsglb(push_url) $cvscfg(url) } # Then, in case fetch and push urls are different if {[string match {*(fetch)} $line]} { set cvsglb(fetch_origin) [lindex $line 0] set cvsglb(fetch_url) [lindex $line 1] } elseif {[string match {*(push)} $line]} { set cvsglb(push_origin) [lindex $line 0] set cvsglb(push_url) [lindex $line 1] } incr i } set cvsglb(root) $cvscfg(url) set cvsglb(vcs) git gen_log:log T "LEAVE" } # For module browser. proc parse_gitlist {gitroot} { global cvsglb global modval global modtitle gen_log:log T "ENTER ($gitroot)" # Clear the arrays catch {unset modval} catch {unset modtitle} set tv .modbrowse.treeframe.pw set command "git ls-remote \"$cvsglb(root)\"" gen_log:log C "$command" set rem_cmd [exec::new $command] set remote_output [$rem_cmd\::output] foreach line [split $remote_output "\n"] { if {$line eq ""} {continue} set dname [lindex $line 1] gen_log:log D "dname=$dname" # This is the hash set modval($dname) [lindex $line 0] gen_log:log D "modval($dname)=$modval($dname)" gen_log:log D "$tv insert {} end -id $dname -values [list $dname $modval($dname)]" $tv insert {} end -id "$dname" -values [list "$dname" $modval($dname)] } update idletasks # Then you can do something like this to list the files # git ls-tree -r refs/heads/master --name-only gen_log:log T "LEAVE" } proc git_push {} { global cvsglb gen_log:log T "ENTER" set command "git push --dry-run . HEAD" gen_log:log C "$command" set ret [catch {exec {*}$command} dryrun_output] gen_log:log S "$dryrun_output" # push will return "Everything up-to-date" if it is if {! [string match "Everyt*" $dryrun_output]} { set mess "This will push your committed changes to\ $cvsglb(push_origin) $cvsglb(push_url).\n" append mess "\n$dryrun_output" append mess "\n\n Are you sure?" set title {Confirm!} set answer [tk_messageBox \ -icon question \ -title $title \ -message $mess \ -parent .workdir \ -type okcancel] if {$answer == {ok}} { set commandline "git push . HEAD" set v [viewer::new "Push"] $v\::do "$commandline" $v\::wait $v\::clean_exec } } else { cvsok "$dryrun_output" .workdir } gen_log:log T "LEAVE" } proc git_fetch {} { global cvsglb gen_log:log T "ENTER" set command "git fetch --dry-run" gen_log:log C "$command" set ret [catch {exec {*}$command} dryrun_output] gen_log:log S "$dryrun_output" # Fetch is just quiet if it's up to date if {[llength $dryrun_output] > 1} { set mess "This will fetch changes from\ $cvsglb(fetch_origin) $cvsglb(fetch_url).\n" append mess "\n$dryrun_output" append mess "\n\n Are you sure?" set title {Confirm!} set answer [tk_messageBox \ -icon question \ -title $title \ -message $mess \ -parent .workdir \ -type okcancel] if {$answer == {ok}} { set commandline "git fetch" set v [viewer::new "Fetch"] $v\::do "$commandline" $v\::wait $v\::clean_exec } } else { cvsok "Everything up to date" .workdir } gen_log:log T "LEAVE" } proc git_list_tags {} { gen_log:log T "ENTER" set commandline "git tag --list" set v [viewer::new "Tags"] $v\::do "$commandline" $v\::wait $v\::clean_exec gen_log:log T "LEAVE" } # Called from "Log" in Reports menu proc git_log {detail args} { gen_log:log T "ENTER ($detail $args)" busy_start .workdir.main set flags "" set filter "" set filelist [join $args] if {$filelist eq ""} { set filelist {.} } set title "Git Log $filelist ($detail)" set commandline "git log" switch -- $detail { latest { append flags " --max-count=1" set filter patch_colortags } summary { append flags " --pretty=oneline" #set filter patch_colortags } verbose { # medium has the date, but full doesn't append flags " --pretty=medium --all" set filter patch_colortags } } set v [viewer::new "$title"] foreach file $filelist { if {[llength $filelist] > 1} { $v\::log "-- $file -------------------------------\n" invert } set command "git log --no-color $flags -- \"$file\"" $v\::do "$command" 1 $filter $v\::wait # If we're doing the graph, make the window wider } busy_done .workdir.main gen_log:log T "LEAVE" } # does git rm from workdir browser proc git_rm {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] # Unix-remove the files set success 1 foreach file $filelist { file delete -force -- $file gen_log:log F "DELETE $file" if {[file exists $file]} { set success 0 } } if {$success == 0} { cvsfail "Remove $file failed" .workdir return } # git-rm them set command "git rm" foreach f $filelist { append command " \"$f\"" } set exec_cmd [exec::new "$command"] auto_setup_dir $exec_cmd gen_log:log T "LEAVE" } # does git rm -r from workdir browser popup menu proc git_remove_dir {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] set command "git rm -r" foreach f $filelist { append command " \"$f\"" } set exec_cmd [exec::new "$command"] auto_setup_dir $exec_cmd gen_log:log T "LEAVE" } # does git add from workdir browser proc git_add {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { set mess "This will add all new files" } else { set mess "This will add these files:\n\n" foreach file $filelist { append mess " $file\n" } } set command "git add" if {$filelist == ""} { append command [glob -nocomplain $cvscfg(aster) .??*] } else { foreach f $filelist { append command " \"$f\"" } } set addcmd [exec::new "$command"] auto_setup_dir $addcmd gen_log:log T "LEAVE" } # Called from workdir browser popup proc git_rename_ask {args} { gen_log:log T "ENTER ($args)" set file [lindex $args 0] if {$file eq ""} { cvsfail "Rename:\nPlease select a file !" .workdir return } # Send it to the dialog to ask for the filename file_input_and_do "Git Rename" "git_rename \"$file\"" gen_log:log T "LEAVE" } # The callback for git_rename_ask and file_input_and_do proc git_rename {args} { global cvscfg gen_log:log T "ENTER ($args)" set oldname [lindex $args 0] set newname [lindex $args 1] set v [viewer::new "SVN rename"] set command "git mv $oldname $newname" $v\::do "$command" # don't do this, or you'll get an error from git #catch {file delete $oldname} if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # Revert. Called from workdir browser proc git_reset {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] set commandline "git reset" foreach f $filelist { append commandline " \"$f\"" } gen_log:log D "Reverting $filelist" set v [viewer::new "Git Reset"] $v\::do "$commandline" $v\::wait $v\::clean_exec if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # called by "Status" in the Reports menu. Uses status_filter. proc git_status {detail args} { global cvscfg gen_log:log T "ENTER ($detail $args)" busy_start .workdir.main set filelist [join $args] set flags "" set title "Git Status ($detail)" # Hide unknown files if desired if {$cvscfg(status_filter)} { append flags " -uno" } switch -- $detail { terse { append flags " --porcelain" } summary { append flags " --long" } verbose { append flags " --verbose" } } set commandline "git status $flags" # There doesn't seem to be a way to suppress color. This option is invalid. #append flags " --no-color" foreach f $filelist { append commandline " \"$f\"" } set stat_cmd [viewer::new $title] $stat_cmd\::do "$commandline" 0 busy_done .workdir.main gen_log:log T "LEAVE" } # called from the branch browser proc git_log_rev {rev filename} { global cvscfg gen_log:log T "ENTER ($rev $filename)" set title "Git log" set commandline "git log" if {$rev ne ""} { append commandline " $rev" append title " $rev" } else { append commandline " $cvscfg(gitlog_opts)" append title " $cvscfg(gitlog_opts)" } append commandline " \"$filename\"" append title " $filename" set v_log [viewer::new "$title"] #$v_log\::width 120 $v_log\::do $commandline 1 patch_colortags gen_log:log T "LEAVE" } # Shows which files changed in a commit # called from the branch browser proc git_show {rev} { gen_log:log T "ENTER ($rev)" set show_command "git show --stat --no-color $rev" set title "Git show $rev" set v_show [viewer::new "$title"] $v_show\::do $show_command 1 $v_show\::wait gen_log:log T "LEAVE" } # Shows changes between commits # called from the workdir browser proc git_patch { filename {rev1 {}} {rev2 {}} } { gen_log:log T "ENTER (\"$rev1\" \"$rev2\")" set command "git diff --no-color" set args "" if {$rev1 != {} && $rev2 != {} } { set args "$rev1 $rev2" } elseif {$rev1 != {} } { set args "$rev1^ $rev1" } elseif {$rev2 != {} } { set args "$rev2^ $rev2" } if {$filename != ""} { append args " \"$filename\"" } set title "SVN diff $args" set title "Git diff $args" set v_show [viewer::new "$title"] #$v_show\::width 120 $v_show\::do "$command $args" 1 patch_colortags $v_show\::wait gen_log:log T "LEAVE" } # called from the "Check Directory" button in the workdir and Reports menu proc git_check {} { global cvscfg gen_log:log T "ENTER ()" busy_start .workdir.main set title "Git Directory Check" # I know we use a short report for other VCSs, but for Git you really # need the full report to know what's staged and what's not set flags "--porcelain" # Show unknown files if desired if {$cvscfg(status_filter)} { append flags " -uno" } set command "git status $flags ." set check_cmd [viewer::new $title] $check_cmd\::do "$command" 0 busy_done .workdir.main gen_log:log T "LEAVE" } # dialog for git commit - called from workdir browser proc git_commit_dialog {} { global cvsglb global cvscfg global colorglb # If marked files, commit these. If no marked files, then # commit any files selected via listbox selection mechanism. # The cvsglb(commit_list) list remembers the list of files # to be committed. set cvsglb(commit_list) [workdir_list_files] # If we want to use an external editor, just do it if {$cvscfg(use_cvseditor)} { git_commit "" "" $cvsglb(commit_list) return } if {[winfo exists .commit]} { destroy .commit } toplevel .commit #grab set .commit frame .commit.top -borderwidth 8 frame .commit.down -relief groove -borderwidth 2 pack .commit.top -side top -fill x pack .commit.down -side bottom -fill x frame .commit.comment pack .commit.comment -side top -fill both -expand 1 label .commit.comment.lcomment -text "Your log message" -anchor w button .commit.comment.history -text "Log History" \ -command history_browser text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ -bg $colorglb(textbg) -exportselection 1 \ -wrap word -borderwidth 2 -setgrid yes # Explain what it means to "commit" files message .commit.message -justify left -aspect 800 \ -text "This will commit changes from your local, working directory into the local repository, recursively." pack .commit.message -in .commit.top -padx 2 -pady 5 button .commit.ok -text "OK" \ -command { #grab release .commit wm withdraw .commit set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] git_commit $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.apply -text "Apply" \ -command { set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] git_commit $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.clear -text "ClearAll" \ -command { set version "" .commit.comment.tcomment delete 1.0 end } button .commit.quit \ -command { #grab release .commit wm withdraw .commit } .commit.ok configure -text "OK" .commit.quit configure -text "Close" grid columnconf .commit.comment 1 -weight 1 grid rowconf .commit.comment 1 -weight 1 grid .commit.comment.lcomment -column 0 -row 0 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew grid .commit.comment.history -column 0 -row 1 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Fill in the most recent commit message .commit.comment.tcomment insert end $cvsglb(commit_comment) wm title .commit "Commit Changes" wm minsize .commit 1 1 gen_log:log T "LEAVE" } # git commit - called from commit dialog proc git_commit {comment args} { global cvscfg gen_log:log T "ENTER ($comment $args)" set filelist [join $args] set commit_output "" if {$filelist == ""} { set mess "This will commit your changes to ** ALL ** files in" append mess " and under this directory." } else { foreach file $filelist { append commit_output "\n$file" } set mess "This will commit your changes to:$commit_output" } append mess "\n\nAre you sure?" set commit_output "" if {[cvsconfirm $mess .workdir] != "ok"} { return 1 } if {$cvscfg(use_cvseditor)} { # Starts text editor of your choice to enter the log message. update idletasks set command "$cvscfg(terminal) git commit" foreach f $filelist { append command " \"$f\"" } gen_log:log C "$command" set ret [catch {exec {*}$command} view_this] if {$ret} { cvsfail $view_this .workdir gen_log:log T "LEAVE ERROR ($view_this)" return } } else { if {$comment == ""} { cvsfail "You must enter a comment!" .commit return 1 } set v [viewer::new "Git Commit"] regsub -all "\"" $comment "\\\"" comment set commandline "git commit -m \"$comment\"" foreach f $filelist { append commandline " \"$f\"" } $v\::do "$commandline" 1 $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # git tag - called from tag dialog proc git_tag {tagname annotate comment args} { global cvscfg gen_log:log T "ENTER ($tagname $annotate $comment $args)" if {$tagname == ""} { cvsfail "You must enter a tag name!" .workdir return 1 } set filelist [join $args] set command "git tag " if {$annotate == "yes"} { append command "-a -m \"$comment\"" } append command " $tagname" foreach f $filelist { append command " \"$f\"" } set v [viewer::new "Git Tag"] $v\::do "$command" 1 $v\::wait if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # git branch - called from branch dialog proc git_branch {branchname updflag args} { global cvscfg gen_log:log T "ENTER ($branchname $args)" if {$branchname == ""} { cvsfail "You must enter a branch name!" .workdir return 1 } set filelist [join $args] set command "git branch $branchname" foreach f $filelist { append command " \"$f\"" } set v [viewer::new "Git Branch"] $v\::do "$command" 1" $v\::wait if {$updflag == "yes"} { set command "git checkout $branchname" foreach f $filelist { append command " \"$f\"" } $v\::log "$command" $v\::do "$command" 0 $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # git checkout with options - called from Update with Options in workdir browser proc git_opt_update {} { global cvsglb switch -exact -- $cvsglb(tagmode_selection) { "Keep" { set command "git checkout" } "Trunk" { set command "git checkout master" } "Branch" { set command "git checkout $cvsglb(branchname)" } "Tag" { set command "git checkout $cvsglb(tagname)" } "Commit" { set command "git checkout $cvsglb(revnumber)" } } set upd_cmd [viewer::new "Git Checkout"] $upd_cmd\::do "$command" 0 status_colortags auto_setup_dir $upd_cmd } # git checkout - called from Update in workdir browser proc git_checkout {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { append mess "\nThis will download from" append mess " the repository to your local" append mess " filespace ** ALL ** files which" append mess " have changed in it." } else { append mess "\nThis will download from" append mess " the repository to your local" append mess " filespace these files which" append mess " have changed:\n" } foreach file $filelist { append mess "\n\t$file" } append mess "\n\nAre you sure?" set command "git checkout" if {[cvsconfirm $mess .workdir] == "ok"} { foreach file $filelist { append command " \"$file\"" } } else { return; } set co_cmd [viewer::new "Git Update"] $co_cmd\::do "$command" 1 auto_setup_dir $co_cmd gen_log:log T "LEAVE" } # Make a clone using the Module Browser proc git_clone {root tag target} { global incvs insvn inrcs ingit gen_log:log T "ENTER ($root $tag $target)" set dir [pwd] if {[file pathtype $target] eq "absolute"} { set tgt $target } else { set tgt "$dir/$target" } set mess "This will clone\n\ $root $tag\n\ to directory\n\ $tgt\n\ Are you sure?" if {[cvsconfirm $mess .modbrowse] == "ok"} { set command "git clone" if {$tag ne "HEAD"} { append command " -b \"$tag\"" } append command " \"$root\" \"$target\"" set v [viewer::new "Git Clone"] $v\::do "$command" } gen_log:log T "LEAVE" return } proc git_reconcile_conflict {args} { global cvscfg global tcl_version gen_log:log T "ENTER ($args)" if {[llength $args] != 1} { cvsfail "Please select one file." .workdir return } set filelist [join $args] # See if it's really a conflict file foreach file $filelist { gen_log:log F "OPEN $file" set f [open $file] if {$tcl_version >= 9.0} {chan configure $f -profile tcl8} set match 0 while { [eof $f] == 0 } { gets $f line if { [string match "<<<<<<< *" $line] } { set match 1 break } } gen_log:log F "CLOSE $file" close $f if { $match != 1 } { cvsfail "$file does not appear to have a conflict." .workdir continue foreach f $filelist { append commandline " \"$f\"" } } set tkdiff_command "$cvscfg(tkdiff) -conflict -o \"$file\" \"$file\"" gen_log:log C "$tkdiff_command" set ret [catch {exec {*}$tkdiff_command &} view_this] } gen_log:log T "LEAVE" } # annotate/blame. Called from workdir. proc git_annotate {revision args} { gen_log:log T "ENTER ($revision $args)" set filelist [join $args] if {$revision != ""} { set revflag "$revision" } else { set revflag "" } if {$filelist == ""} { cvsfail "Annotate:\nPlease select one or more files !" .workdir gen_log:log T "LEAVE (Unselected files)" return } foreach file $filelist { annotate::new $revflag "$file" "git" } gen_log:log T "LEAVE" } # Called from branch browser annotate button proc git_annotate_r {revision filepath} { gen_log:log T "ENTER ($revision $filepath)" if {$revision != ""} { # We were given a revision set revflag "$revision" } else { set revflag "" } annotate::new $revflag "$filepath" "git_r" gen_log:log T "LEAVE" } # Called from file viewer annotate button proc git_annotate_range {v_w revision filename} { gen_log:log T "ENTER ($v_w $revision $filename)" if {$revision != ""} { # We were given a revision set revflag "$revision" } else { set revflag "" } set range [get_textlines $v_w] set firstline [lindex $range 0] set lastline [lindex $range 1] if {$firstline eq "" || $lastline eq ""} { cvsfail "Plesae select a range of lines" $v_w return } annotate::new $revision "$filename" "git_range" $firstline $lastline gen_log:log T "LEAVE" } # View a specific revision of a file. # Called from branch browser proc git_fileview {revision path filename} { gen_log:log T "ENTER ($revision $path $filename)" if {$path ne ""} { set filepath "$path/$filename" } else { set filepath "$filename" } set command "git show \"$revision:$filepath\"" set v [viewer::new "$filepath Revision $revision"] $v\::do "$command" # Get the viewer window set v_w [namespace inscope $v {set w}] frame $v_w.blamefm button $v_w.blamefm.blame -text "Annotate selection" \ -command "git_annotate_range $v_w $revision \"$filename\"" pack $v_w.blamefm -in $v_w.bottom -side left pack $v_w.blamefm.blame } # Sends files to the branch browser one at a time proc git_branches {files} { global cvsglb gen_log:log T "ENTER ($files)" set cvsglb(lightning) 0 read_git_dir [pwd] gen_log:log D "Relative Path: $cvsglb(relpath)" if {$files == {}} { ::git_branchlog::new $cvsglb(relpath) . } else { foreach file $files { ::git_branchlog::new $cvsglb(relpath) $file } } gen_log:log T "LEAVE" } # Sends files to the branch browser one at a time proc git_fast_diagram {files} { global cvscfg global cvsglb gen_log:log T "ENTER ($files)" set cvsglb(lightning) 1 read_git_dir [pwd] gen_log:log D "Relative Path: $cvsglb(relpath)" if {$files == {}} { ::git_branchlog::new $cvsglb(relpath) . } else { foreach file $files { ::git_branchlog::new $cvsglb(relpath) $file } } gen_log:log T "LEAVE" } namespace eval ::git_branchlog { variable instance 0 proc new {relpath filename {directory_merge {0}} } { variable instance set my_idx $instance incr instance namespace eval $my_idx { global logcfg global cvsglb set my_idx [uplevel {concat $my_idx}] set filename [uplevel {concat $filename}] set relpath [uplevel {concat $relpath}] set directory_merge [uplevel {concat $directory_merge}] variable cmd_log variable lc variable ln variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable revparent variable tags variable revbranches variable branchrevs variable logstate gen_log:log T "ENTER [namespace current]" set newlc [branch_diagram::new $filename "GIT,loc" [namespace current]] set ln [lindex $newlc 0] set lc [lindex $newlc 1] if {![info exists cvsglb(lightning)]} { set cvsglb(lightning) 0 } if {$cvsglb(lightning)} { $lc.refresh configure -state disabled } proc abortLog { } { variable cmd_log variable lc if {[info exists cmd_log]} { catch {$cmd_log\::abort} } busy_done $lc pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal } proc reloadLog { } { global cvscfg global cvsglb global logcfg global current_tagname variable filename variable cmd_log variable lc variable ln variable allrevs variable branch_matches variable branchtip variable branchroot variable branchrevs variable branchparent variable family variable raw_revs variable revwho variable revdate variable revtime variable revcomment variable revkind variable revparent variable revpath variable revstate variable revtags variable revbtags variable revmergefrom variable rootrev variable rootrevs variable oldest_rev variable revbranches variable logstate variable relpath variable filename gen_log:log T "ENTER" catch { $lc.canvas delete all } catch { unset branch_matches } catch { unset branchtip } catch { unset branchroot } catch { unset branchrevs } catch { unset branchparent } catch { unset raw_revs } catch { unset revwho } catch { unset revdate } catch { unset revstate } catch { unset revtime } catch { unset revcomment } catch { unset revtags } catch { unset revbtags } catch { unset revbranches } catch { unset revkind } catch { unset revmergefrom } catch { unset revpath } catch { unset revparent } catch { unset rootrev } catch { unset rootrevs } catch { unset trunk } catch { unset trunks } catch { unset family } catch { unset fam_trunk } pack forget $lc.close pack $lc.stop -in $lc.down.closefm -side right $lc.stop configure -state normal busy_start $lc # Start collecting information and initializing the # browser $ln\::ConfigureButtons $filename # in case we got here straight from the command line if {! [info exists current_tagname]} { set command "git rev-parse --abbrev-ref HEAD" set cmd_curbranch [exec::new $command {} 0 {} 1] set branch_output [$cmd_curbranch\::output] $cmd_curbranch\::destroy set current_tagname [string trim $branch_output "\n"] } gen_log:log D "current_tagname $current_tagname" set current_revnum [set $ln\::current_revnum] gen_log:log D "current_revnum $current_revnum" # Start collecting the branches catch {unset branches} catch {unset logged_branches} catch {unset local_branches} catch {unset remote_branches} # Prepare to draw something on the canvas so user knows we're working set cnv_y 20 set yspc 15 set cnv_h [winfo height $lc.canvas] set cnv_w [winfo width $lc.canvas] set cnv_x [expr {$cnv_w / 2- 8}] # subtract scrollbars etc incr cnv_h -20 incr cnv_w -20 $lc.canvas create text $cnv_x $cnv_y -text "Collecting the LOG" -tags {temporary} incr cnv_y $yspc $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_y] $lc.canvas yview moveto 1 update idletasks if {! $logcfg(show_branches)} { set cvsglb(lightning) 1 } # Gets all the commit information at once, including the branch, tag, # merge, and parent information. Doesn't necessarily pick up all of the # locally reachable branches set command "git log --all" if {$cvsglb(lightning)} { # For the fast no-branches mode, it's best with no options but in date order append command " --date-order" } else { append command " $cvscfg(gitlog_opts)" if {$cvscfg(gitmaxhist) != ""} { append command " -$cvscfg(gitmaxhist)" } if {$cvscfg(gitlog_since) != ""} { set sinceflag "--since=\"$cvscfg(gitlog_since)\"" regsub -all {\s+} $sinceflag {\\ } sinceflag append command " $sinceflag" } } if {$logcfg(show_tags)} { append command " --tags" } append command " --abbrev-commit --parents --format=fuller --date=iso --decorate=short --no-color -- \"$filename\"" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy set log_lines [split $log_output "\n"] set logged_branches [parse_gitlog $log_lines] catch {unset log_output} catch {unset log_lines} if {! [info exists allrevs]} { set msg "No revisions found for $filename" if {$cvscfg(gitlog_since) != ""} { set sinceflag "--since=\"$cvscfg(gitlog_since)\"" regsub -all {\s+} $sinceflag {\\ } sinceflag append msg " $sinceflag" } cvsfail $msg $lc return; } gen_log:log D "[llength $allrevs] REVISIONS picked up by git log --all" # If we've found parentless revisions, rootrev is set to the first parentless # one we found gen_log:log D "Parentless revs $rootrevs" gen_log:log D "Last rootrev $rootrev" set oldest_rev [lindex $allrevs end] gen_log:log D "Oldest rev $oldest_rev $revdate($oldest_rev)" set raw_all [lreverse $allrevs] # Branches that were in the log decorations if {$logged_branches != {}} { set logged_branches [prune_branchlist $logged_branches] } if {! $cvsglb(lightning)} { # This gets all the locally reachable branches. We only use all of them if asked, # but their order is important. Also if "master" is in there, we want it. set cmd(git_branch) [exec::new "git branch --no-color"] set branch_lines [split [$cmd(git_branch)\::output] "\n"] # If we're in a detached head state, one of these can be like (HEAD detached at 9d24194) # but we can just filter it out foreach line $branch_lines { if {[string length $line] < 1} continue if {[regexp {detached} $line]} continue regsub {\*\s+} $line {} line lappend local_branches [lindex $line 0] } catch {unset branch_lines} # We always want the current branch, though if {($current_tagname != "") && ($current_tagname ni $logged_branches)} { lappend logged_branches $current_tagname } if {("master" in $local_branches) && ("master" ni $logged_branches)} { lappend logged_branches {master} } # Don't get the remote branches unless asked to if { ! $cvsglb(lightning) && [regexp {R} $cvscfg(gitbranchgroups)] } { set cmd(git_rbranch) [exec::new "git branch -r"] set branch_lines [split [$cmd(git_rbranch)\::output] "\n"] foreach line $branch_lines { if {[string length $line] < 1} continue if {[string match {*/HEAD} $line]} continue lappend remote_branches [lindex $line 0] } catch {unset branch_lines} } if {![info exists logged_branches]} { set logged_branches {} } if {![info exists local_branches]} { set local_branches {} } if {![info exists remote_branches]} { set remote_branches {} } gen_log:log D "File-log branches ([llength $logged_branches]): $logged_branches" gen_log:log D "Local branches ([llength $local_branches]): $local_branches" gen_log:log D "Remote branches ([llength $remote_branches]): $remote_branches" # Collect and de-duplicate the branch list # First, add the logged branches. We always need those, you can't opt out set branches $logged_branches # The local branch list usually preserves the order the best. So # we try to preserve that order when we blend them, even if we don't add ones # that aren't already in the logged branches set ovlp_list "" set fb_only "" set lb_only "" if {[llength $local_branches] > 0} { foreach lb $local_branches { if {$lb in $logged_branches} { lappend ovlp_list $lb } else { lappend lb_only $lb } } foreach fb $logged_branches { if {$fb ni $local_branches} { lappend fb_only $fb } } } # Then add the local branches that weren't in the logged branches, if desired if { [regexp {L|R} $cvscfg(gitbranchgroups)] } { set branches [concat $ovlp_list $fb_only $lb_only ] } else { set branches [concat $ovlp_list $fb_only ] } # Then add the remote branches, if desired if { [regexp {R} $cvscfg(gitbranchgroups)] } { foreach remb $remote_branches { if {$remb ni $branches} { lappend branches $remb } } } set branches [lrange $branches 0 $cvscfg(gitmaxbranch)] set branches [prune_branchlist $branches] # Move master to the front set idx [lsearch -regexp $branches {master|.*/master}] set mstr [lindex $branches $idx] set branches [lreplace $branches $idx $idx] set branches [concat $mstr $branches] catch {unset logged_branches} catch {unset local_branches} gen_log:log D "Overlap: $ovlp_list" gen_log:log D "File only: $fb_only" gen_log:log D "Local only: $lb_only" gen_log:log D "Combined branches ([llength $branches]): $branches" # De-duplicate the tags, while we're thinking of it. foreach a [array names revtags] { if {[llength $revtags($a)] > 1} { set revtags($a) [prune_branchlist $revtags($a)] } } # Filter the branches # We got the master above set filtered_branches $mstr if {$current_tagname ne $mstr} { lappend filtered_branches $current_tagname } if {$cvscfg(gitbranchregex) ne ""} { gen_log:log D "regexp \{$cvscfg(gitbranchregex)\}" foreach b $branches { #gen_log:log D "regexp $cvscfg(gitbranchregex) $b" if {[catch { regexp "$cvscfg(gitbranchregex)" $b} reg_out]} { gen_log:log E "$reg_out" cvsfail "$reg_out" break } else { if {$reg_out} { lappend filtered_branches $b } } } if {[llength $filtered_branches] < 1} { gen_log:log E "filter \{$cvscfg(gitbranchregex)\} didn't match any branches!" #cvsfail "filter \{$cvscfg(gitbranchregex)\} didn't match any branches!" } else { gen_log:log D "Filtered branches: $filtered_branches" set branches $filtered_branches } } set current_branches "" } else { set branches $current_tagname set current_branches $current_tagname set trunk $current_tagname set trunks $current_tagname set branchrevs($trunk) $allrevs set branchtip($trunk) [lindex $allrevs 0] set branchroot($trunk) [lindex $allrevs end] set branchrevs($branchroot($trunk)) $branchrevs($trunk) } # We need to query each branch to know if it's empty, so we collect the # revision list while we're at it. We collect the branches into # families having the same root, and detect identical ones. set empty_branches "" set root_branches "" set branchtips "" list ident_matches list family if {! $cvsglb(lightning)} { # This is necessary to reset the view after clearing the canvas $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_h] set cnv_y [expr {$cnv_y + $yspc}] set cnv_x [expr {$cnv_w / 2- 8}] $lc.canvas create text $cnv_x $cnv_y -text "Getting BRANCHES" -tags {temporary} incr cnv_y $yspc $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_y] $lc.canvas yview moveto 1 update idletasks foreach br $branches { # Draw something on the canvas so the user knows we're working $lc.canvas create text $cnv_x $cnv_y -text $br -tags {temporary} -fill $cvscfg(colourB) incr cnv_y $yspc $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_y] $lc.canvas yview moveto 1 update idletasks set command "git rev-list" if {$cvscfg(gitmaxhist) != ""} { append command " -$cvscfg(gitmaxhist)" } # If since time is set, use that. Otherwise, use the time of the # oldest rev we found in log --all if {$cvscfg(gitlog_since) != ""} { set sinceflag "--since=\"$cvscfg(gitlog_since)\"" regsub -all {\s+} $sinceflag {\\ } sinceflag set since_time $sinceflag } else { set seconds [clock scan $revdate($oldest_rev) -gmt yes] set since_time [clock add $seconds -1 hour] } set command "$command --reverse --abbrev-commit $cvscfg(gitlog_opts) --since=\"$since_time\" $br -- \"$filename\"" set cmd_revlist [exec::new $command {} 0 {} 1] set revlist_output [$cmd_revlist\::output] $cmd_revlist\::destroy set revlist_lines [split $revlist_output "\n"] if {[llength $revlist_lines] < 1} { gen_log:log D "branch $br is EMPTY. Removing from consideration" # If it's empty, remove this branch from the list set idx [lsearch $branches $br] set branches [lreplace $branches $idx $idx] lappend empty_branches $br continue } if {[llength $revlist_lines]} { foreach ro $revlist_lines { if {[string length $ro] > 0} { lappend raw_revs($br) $ro set revpath($ro) $relpath set revkind($ro) "revision" } } catch {unset revlist_output} catch {unset revlist_lines} set branchtip($br) [lindex $raw_revs($br) end] lappend branchtips $branchtip($br) lappend ident_matches($branchtip($br)) $br if {[llength $ident_matches($branchtip($br))] > 1} { gen_log:log D "$br identical to another branch. Setting aside" continue } lassign [list_within_list $raw_all $raw_revs($br)] start n_overlap # If there is orphaned stuff in here, some branches are disjunct with # with our root. Don't process these further now. if {$n_overlap == 0} { gen_log:log D "branch $br is DISJUNCT with our root" #set idx [lsearch $branches $br] #set branches [lreplace $branches $idx $idx] } set overlap_len($br) $n_overlap set overlap_start($br) $start set branchroot($br) [lindex $raw_revs($br) 0] gen_log:log D "$br root is $branchroot($br)" if {$branchroot($br) ni $rootrevs} { lappend rootrevs $branchroot($br) } if {$current_revnum in $raw_revs($br)} { gen_log:log D "$br contains current_revnum $current_revnum" lappend current_branches $br } foreach r $rootrevs { if {$r in $raw_revs($br)} { gen_log:log D "$br contains ROOT $r" if {[lindex $raw_revs($br) 0] eq $r} { lappend family($r) $br } } } } } # Finished collecting the branches from the repository # It's easier to compare the branches if we put identical ones aside. # Here we are saving lists of two or more identical branches. foreach i [array names ident_matches] { if {[llength $ident_matches($i)] < 2} { catch {unset ident_matches($i)} } } } # Get the branches in each family back in order foreach f [array names family] { set ofam [list] foreach ob $branches { if {$ob in $family($f)} { lappend ofam $ob } } set family($f) $ofam gen_log:log D "FAMILY ($f): $family($f)" } gen_log:log D "Empty branches: $empty_branches" gen_log:log D "You are Here: $current_branches" gen_log:log D "Branches: $branches" if {[llength $branches] < 1} { cvsfail "Nothing found by git log $cvscfg(gitlog_opts)" busy_done $lc return } # Decide what to use for the trunk. Consider only non-empty, # non-disjunct branches. foreach f [array names family] { set fam_branches $family($f) set fam_trunk($f) "" set trunk_found 0 gen_log:log D "Deciding on a trunk for the ($f) $family($f) family" if {[llength $fam_branches] == 1} { # If there's only one choice, don't waste time looking set fam_trunk($f) [lindex $fam_branches 0] set trunk_found 1 gen_log:log D " Only one branch to begin with! That was easy! trunk=$fam_trunk($f)" } if {! $trunk_found} { # If only one branch begins at the beginning, that's a good one set os_z "" foreach b $fam_branches { if {$overlap_start($b) == 0} { lappend os_z $b } } if {[llength $os_z] == 1} { gen_log:log D " Only one branch begins at the root. trunk=$b" set trunk_found 1 } } if {! $trunk_found} { # Do we have revisions on master? set m [lsearch -exact $fam_branches {master}] if {$m > -1} { gen_log:log D "master is in our branches" set fam_trunk($f) "master" set trunk_found 1 } } if {! $trunk_found} { # how about origin/master set m [lsearch -glob $fam_branches {*/master}] if {$m > -1} { set match [lindex $fam_branches $m] gen_log:log D "$match is in branches" set fam_trunk($f) $match set trunk_found 1 } } if {! $trunk_found} { if {[llength $fam_branches] > 0} { set fam_trunk($f) [lindex $fam_branches 0] set trunk_found 1 gen_log:log D " Using first branch as trunk" } set trunk_found 1 } if {! $trunk_found} { gen_log:log D "No named TRUNK found!" set fam_trunk($f) "" } gen_log:log D "TRUNK for FAMILY $f: $fam_trunk($f)" # Make sure the trunk is the first in the branchlist set idx [lsearch $fam_branches $fam_trunk($f)] set fam_branches [lreplace $fam_branches $idx $idx] set fam_branches [linsert $fam_branches 0 $fam_trunk($f)] set family($f) $fam_branches # Get rev lists for the branches catch {unset branch_matches} # Draw something on the canvas so the user knows we're working set empty_branches "" gen_log:log D "========================" gen_log:log D "FINDING THE MAJOR BRANCHES for family($f)" foreach branch $family($f) { $lc.canvas create text $cnv_x $cnv_y -text "$branch" -tags {temporary} -fill green incr cnv_y $yspc $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_y] $lc.canvas yview moveto 1 update gen_log:log D "========= $branch ==========" if {$branch eq $fam_trunk($f)} { # sometimes we don't have raw_revs($fam_trunk($f)) if the file is added on branch, # but we should have guessed at a rootrev by now if {! [info exists raw_revs($fam_trunk($f))]} { set raw_revs($fam_trunk($f)) $rootrev } set branchrevs($f) [lreverse $raw_revs($fam_trunk($f))] set branchrevs($fam_trunk($f)) $branchrevs($f) set branchtip($fam_trunk($f)) [lindex $branchrevs($fam_trunk($f)) 0] set branchroot($fam_trunk($f)) [lindex $branchrevs($fam_trunk($f)) end] if {! [info exists rootrev]} { set rootrev $branchroot($fam_trunk($f)) gen_log:log D "USING ROOT $rootrev" } # Move the trunk's tags from the tip to the base # But if there's only one rev, those are the same, so don't do it if {[info exists revbtags($branchroot($branch)] && $branch in $revbtags($branchroot($branch))} { gen_log:log D "$branch is already in $branchroot($branch)" } else { gen_log:log D "Adding $branch to revbtags for $branchroot($branch)" lappend revbtags($branchroot($branch)) $branch } if {$branchtip($branch) ne $branchroot($branch)} { if {[info exists revbtags($branchtip($branch))]} { gen_log:log D " and removing it from tip" set idx [lsearch $revbtags($branchtip($branch)) $branch] set revbtags($branchtip($branch)) [lreplace $revbtags($branchtip($branch)) $idx $idx] } } gen_log:log D "BASE of trunk $branch is $branchroot($branch)" continue } # The root for a branch is the first one we get back that's only in the branch # and not in master if {[info exists raw_revs($branch)]} { set raw_revs($branch) [lreverse $raw_revs($branch)] # Here, we are establishing the first-level branches off the trunk compare_branches $branch $fam_trunk($f) set parent_ok 0 set base $branchroot($branch) if {[info exists branchparent($branch)]} { gen_log:log D "Using branchparent($branch) $branchparent($branch)" set revparent($base) $branchparent($branch) set parent_ok 1 } if {! $parent_ok} { # Was it merged from our root? # Just testing this, don't set parent_ok if {[info exists revmergefrom($base)]} { set revparent($base) $revmergefrom($base) gen_log:log D "$base was MERGED FROM $revparent($base)" } } # NOPE NOPE NOPE prevent recursion if {[info exists revparent($base)] && ($revparent($base) in $branchrevs($branch))} { gen_log:log D "PARENT $revparent($base) is in the revision list of $branch!" set parent_ok 0 } if {! $parent_ok} { gen_log:log D "Ignoring branch $branch" catch {unset revparent($base)} # Withdraw this branch from the proceedings set idx [lsearch $family($f) $branch] set branches [lreplace $family($f) $idx $idx] continue } gen_log:log D " $branch: BASE $base PARENT $revparent($base)" # Sometimes we get back a parent that our log --all didn't pick # up. This may happen if the directory had checkins that didn't # affect the file or the file is newly added if {! [info exists revdate($revparent($base))] } { # Draw it differently because it may not be reachable set revpath($revparent($base)) $relpath set revstate($revparent($base)) "ghost" } # We got the parent settled one way or another # Add it to revbranches(parent) if {! [info exists revbranches($revparent($base))] || $branchroot($branch) ni $revbranches($revparent($base))} { lappend revbranches($revparent($base)) $branchroot($branch) } if {$branchtip($branch) ne $branchroot($branch)} { if {[info exists revbtags($branchtip($branch))]} { gen_log:log D " and removing it from tip" set idx [lsearch $revbtags($branchtip($branch)) $branch] set revbtags($branchtip($branch)) [lreplace $revbtags($branchtip($branch)) $idx $idx] } } } } gen_log:log D "========================" # If two branches have the same root, one is likely # a sub-branch of the other. Let's see if we can disambiguate foreach t [array names branchroot] { if {$t eq $branch} continue if {! [info exists branchroot($branch)]} continue # Maybe we took it out in the first comparison if {$branch ni $family($f)} continue if {$branchroot($branch) eq $branchroot($t)} { #gen_log:log D "$branch and $t have the same root $branchroot($branch)" # Save the duplicates in a list to deal with next lappend branch_matches($branch) $t } } if {[info exists branch_matches]} { gen_log:log D "SORTING OUT SUB-BRANCHES for FAMILY $f" } else { gen_log:log D "NO SUB-BRANCHES FOUND for FAMILY $f" } # Now that we've got sets of matches, process each set foreach m [array names branch_matches] { set family_base($m) $branchroot($m) set peers [concat $m $branch_matches($m)] gen_log:log D "FAMILY $peers" set limit [llength $peers] for {set i 0} {$i < $limit} {incr i} { set j [expr {$i+1}] if {$j == $limit} {set j 0} set peer1 [lindex $peers $i] set peer2 [lindex $peers $j] # If the next one has been taken out for identity or something, skip it if {$peer2 ni $family($f)} continue compare_branches $peer1 $peer2 } } } # Finished finding major branches gen_log:log D "========================" # Put back the identical branches foreach i [array names ident_matches] { gen_log:log D "$i IDENTICAL $ident_matches($i)" set first [lindex $ident_matches($i) 0] foreach next [lrange $ident_matches($i) 1 end] { if {! [info exists branchrevs($first)]} { gen_log:log E "branchrevs($first) doesn't exist!" } set branchrevs($next) $branchrevs($first) set branchroot($next) $branchroot($first) set branchtip($next) $branchtip($first) if {$next ni $revbtags($branchroot($first))} { lappend revbtags($branchroot($first)) $next } } } gen_log:log D "Deciding which family to draw" gen_log:log D "CURRENT BRANCH: $current_tagname" foreach ft [array names fam_trunk] { lappend trunks $fam_trunk($ft) } gen_log:log D "TRUNK(s) $trunks" set trunk_ok 0 set idx [lsearch -regexp $trunks {master|.*/master}] if {$idx > -1} { set mstr [lindex $trunks $idx] gen_log:log D "Found $mstr in ($trunks)" set trunk $mstr set trunk_ok 1 } if {! $trunk_ok} { foreach t $trunks { if {$t in $current_branches} { gen_log:log D "Found $t in Current branches" set trunk $t set trunk_ok 1 } } } if {! $trunk_ok} { foreach t $trunks { if {$t eq $current_tagname} { gen_log:log D " Using current_tagname $current_tagname" set trunk $t set trunk_ok 1 } } } if {! $trunk_ok} { gen_log:log D " Using first trunk in list" set trunk [lindex $trunks 0] set trunk_ok 1 } if {! $trunk_ok} { cvsfail "Can't find a trunk for this file" $lc } foreach f [array names fam_trunk] { if {$fam_trunk($f) eq "$trunk"} { set rootrev $f } } if {$rootrev eq ""} { set rootrev $oldest_rev } set revkind($rootrev) "root" gen_log:log D "USING TRUNK $trunk (rootrev $rootrev)" # Little flourish here if we can do it. If the master arises from a merged # branch, and we might draw the branch, try to show the merge if {[info exists revparent($rootrev)] && $revparent($rootrev) ne ""} { set revmergefrom($rootrev) $revparent($rootrev) } # Make sure we know where we're rooted. Sometimes the initial parent detection went # one too far, which would put us on a different branch that's not visible from here. gen_log:log D "branchrevs($trunk) $branchrevs($trunk)" # Position the the You are Here icon and top up final variables gen_log:log D "Looking for current_revnum $current_revnum in branches" foreach branch $current_branches { if {$branchtip($branch) eq $current_revnum} { gen_log:log D "Currently at top of $branch" set branchrevs($branch) [linsert $branchrevs($branch) 0 {current}] } else { # But maybe we're not at the tip foreach r $branchrevs($branch) { if {$r == $current_revnum} { # We need to make a new artificial branch off of $r gen_log:log D "appending current to revbranches($r)" lappend revbranches($r) {current} set revbtags(current) {current} } } } if {[info exists branchroot($branch)]} { if {[info exists branchrevs($branch)]} { set branchrevs($branchroot($branch)) $branchrevs($branch) } else { gen_log:log D "branchrevs($branch) doesn't exist!" } } else { gen_log:log D "branchroot($branch) doesn't exist!" } } # This causes recursion foreach rb [array names revbranches] { #gen_log:log D "revbranches($rb) $revbranches($rb)" foreach r $revbranches($rb) { foreach rb2 [array names revbranches] { if {$rb eq $rb2} continue if {$r in $revbranches($rb2)} { gen_log:log D "$r is in both $rb and $rb2" gen_log:log D " revbranches($rb) $revbranches($rb)" gen_log:log D " revbranches($rb2) $revbranches($rb2)" # Take it out of the longer one? if {[llength $revbranches($rb)] > [llength $revbranches($rb2)]} { set idx [lsearch $revbranches($rb) $r] set revbranches($rb) [lreplace $revbranches($rb) $idx $idx] } else { set idx [lsearch $revbranches($rb2) $r] set revbranches($rb2) [lreplace $revbranches($rb2) $idx $idx] } } } } } # We may have added a "current" branch. We have to set all its # stuff or we'll get errors foreach {revwho(current) revdate(current) revtime(current) revlines(current) revcomment(current) branchrevs(current) revbtags(current)}\ {{} {} {} {} {} {} {}} \ { break } pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal [namespace current]::git_sort_it_all_out # Little pause before erasing the list of branches we temporarily drew after 500 set new_x [$ln\::DrawTree now] # Draw unrooted branches gen_log:log D "ROOTREV $rootrev" gen_log:log D "ROOTREVS $rootrevs" set idx [lsearch $rootrevs $rootrev] set rootrevs [lreplace $rootrevs $idx $idx] set sidetree_x [expr {$new_x + 2}] foreach rv $rootrevs { if {[info exists revbtags($rv)]} { set broot [lindex $revbtags($rv) 0] } else { continue } gen_log:log D "UNROOTED branch $rv: $broot" catch {unset revkind} set revkind($broot) "root" gen_log:log D "revbtags($rv) $revbtags($rv)" set new_x [$ln\::DrawSideTree $sidetree_x 0 $rv] set sidetree_x [expr {$new_x + 2}] } gen_log:log T "LEAVE" return } proc parse_gitlog {lines} { global logcfg global cvsglb variable allrevs variable relpath variable revwho variable revdate variable revparent variable revpath variable revtime variable revcomment variable revtags variable revbtags variable revmergefrom variable revstate variable rootrev variable rootrevs gen_log:log T "ENTER (<...>)" set revnum "" set i 0 set l [llength $lines] set last "" set logged_branches "" catch {unset allrevs} set rootrev "" set rootrevs "" while {$i < $l} { set line [lindex $lines $i] #gen_log:log D "$line" if { [ regexp {^\s*$} $last ] && [ string match {commit *} $line] } { # ^ the last line was empty and this one starts with commit # The commit line is complex. It can contain parents, tags, and branch tags. # It can look like this: # commit aad218525 3590769e6 (tag: tclpro-1-5-0, origin/tclpro-1-5-0-synthetic) if {[expr {$l - $i}] < 0} {break} # ^ we came to the last line! set line [lindex $lines $i] set commits "" set parenthetical "" regexp {^commit ([\w\s]*)} $line nil commits regexp {^commit .*(\(.*\))} $line nil parenthetical set revnum [lindex $commits 0] lappend allrevs $revnum # If it's a merge, there's more than one parent. But for this, we only want # the first one set parentlist [lindex $commits 1] set parent [lindex $parentlist 0] set revparent($revnum) $parent if {$parent == ""} { set rootrev $revnum gen_log:log D "FOUND PARENTLESS ROOT $rootrev" lappend rootrevs $rootrev } #strip off the parentheses set in_parens [string range $parenthetical 1 end-1] set items [split $in_parens " "] set p 0 while {$p < [llength $items]} { # First, see if there are tags and peel them off if {[lindex $items $p] eq "tag:"} { incr p lappend revtags($revnum) [string trimright [lindex $items $p] ","] incr p } else { # what's left are branches. This is the tip, not the root, usually set raw_btag [string trimright [lindex $items $p] ","] if {(! [regexp {HEAD} $raw_btag]) && ($raw_btag ne "->")} { if {$cvsglb(lightning)} { set revbtags($revnum) $raw_btag } else { lappend logged_branches $raw_btag } } incr p } } incr i set line [lindex $lines $i] # a line like "Merge: 7ee40c3 d6b18a7" could be next if { [string match {Merge:*} $line] } { set revmergefrom($revnum) [lindex $line end] incr i } set line [lindex $lines $i] # Author: dorothy rob if { [string match {Author:*} $line] } { set remainder [join [lrange $line 1 end]] regsub { <.*>} $remainder {} revwho($revnum) } incr i 3 set line [lindex $lines $i] # Date: 2018-08-17 20:10:15 -0700 if { [string match {CommitDate:*} $line] } { set revdate($revnum) [lindex $line 1] set revtime($revnum) [lindex $line 2] } set last [lindex $lines $i] incr i set line [lindex $lines $i] # Blank line precedes comment set revcomment($revnum) "" if { [ regexp {^\s*$} $line ] } { set last $line set j $i set c [expr {$i + 1}] set line [lindex $lines $c] while { ! [string match {commit *} $line] } { incr c set line [lindex $lines $c] if {$c > $l} {break} } # The comment lines have leading whitespace (4 spaces) foreach commentline [lrange $lines [expr {$j + 1}] [expr {$c - 2}]] { set commentline [string range $commentline 4 end] append revcomment($revnum) "$commentline\n" } set i [expr {$c - 1}] } incr i set revpath($revnum) $relpath } } gen_log:log T "LEAVE ($logged_branches)" return $logged_branches } proc compare_branches {A B} { variable branchrevs variable branchroot variable branchtip variable branchparent variable raw_revs variable revbranches variable revbtags variable branch_matches variable family gen_log:log D " COMPARING $A VS $B" # For the main comparisons, we don't have branchrevs yet if {! [info exists branchrevs($A)]} { set branchrevs($A) $raw_revs($A) } #gen_log:log D " branchrevs($A) $branchrevs($A)" if {! [info exists branchrevs($B)]} { set branchrevs($B) $raw_revs($B) } #gen_log:log D " branchrevs($B) $branchrevs($B)" lassign [list_comm $branchrevs($B) $branchrevs($A)] inAonly inBonly inBoth gen_log:log D " == ONLY IN $A: $inBonly" gen_log:log D " == ONLY IN $B: $inAonly" if {$inBonly eq "IDENTICAL"} { gen_log:log D " BRANCHES $A and $B are IDENTICAL" set branchrevs($A) $branchrevs($B) set branchroot($A) $branchroot($B) set branchtip($branch) $branchtip($B) # Add its tag to the branchroot for the other foreach z [list $A $B] { if {$z ni $revbtags($branchroot($z))} { gen_log:log D "Adding $z to revbtags for ($branchroot($z))" lappend revbtags($branchroot($z)) $z } } gen_log:log D "Removing $A as an independent entity" set idx [lsearch $branch_matches($m) $A] set branch_matches($m) [lreplace $branch_matches($m) $idx $idx] set idx [lsearch $family($f) $branch] set family($f) [lreplace $family($f) $idx $idx] return } if {$inBonly ne {}} { set branchrevs($A) $inBonly set branchroot($A) [lindex $branchrevs($A) end] set branchtip($A) [lindex $branchrevs($A) 0] set new_base $branchroot($A) set branchrevs($new_base) $inBonly set fork [lindex $inBoth 0] if {$fork eq ""} { gen_log:log D " $A and $B are now non-overlapping" return } gen_log:log D " NEW PARENT $fork and BASE $new_base of $A" set branchparent($A) $fork set old_base [lindex $inBoth end] set revkind($new_base) "branch" # Move revbtags if {! [info exists revbtags($new_base)] || ($A ni $revbtags($new_base))} { gen_log:log D "Adding $A to revbtags($new_base)" lappend revbtags($new_base) $A } if {[info exists revbtags($old_base)]} { gen_log:log D " and removing it from old base $old_base" set idx [lsearch $revbtags($old_base) $A] set revbtags($old_base) [lreplace $revbtags($old_base) $idx $idx] } # Move revbranches if {! [info exists revbranches($fork)] || ($new_base ni $revbranches($fork))} { lappend revbranches($fork) $new_base } } elseif {$inAonly ne {} && ! [regexp $B {master|.*/master}]} { set branchrevs($B) $inAonly set branchroot($B) [lindex $branchrevs($B) end] set branchtip($B) [lindex $branchrevs($B) 0] set new_base $branchroot($B) set branchrevs($new_base) $inAonly set fork [lindex $inBoth 0] if {$fork eq ""} { gen_log:log D " $A and $B are now non-overlapping" return } gen_log:log D " NEW PARENT $fork and BASE $new_base of $B" set branchparent($B) $fork set old_base [lindex $inBoth end] set revkind($new_base) "branch" # Move revbtags if {! [info exists revbtags($new_base)] || ($A ni $revbtags($new_base))} { gen_log:log D "Adding $B to revbtags($new_base)" lappend revbtags($new_base) $B } if {[info exists revbtags($old_base)]} { gen_log:log D " and removing it from old base $old_base" set idx [lsearch $revbtags($old_base) $B] set revbtags($old_base) [lreplace $revbtags($old_base) $idx $idx] } # Move revbranches if {! [info exists revbranches($fork)] || ($new_base ni $revbranches($fork))} { lappend revbranches($fork) $new_base } } else { set fork [lindex $inBoth 0] set old_base [lindex $inBoth end] if {[info exists family($old_base)]} { set idx [lsearch $family($old_base) $A] set family($old_base) [lreplace $family($old_base) $idx $idx] gen_log:log D " removing $old_base from family($old_base)" } } } proc git_sort_it_all_out {} { global cvscfg global current_tagname variable filename variable lc variable ln variable revwho variable revdate variable revtime variable revcomment variable revkind variable revpath variable revtags variable revbtags variable branchrevs variable revbranches variable revstate variable revmergefrom variable logstate variable revnum variable rootbranch variable revbranch variable rootrev variable rootrevs variable oldest_rev gen_log:log T "ENTER" # Sort the revision and branch lists and remove duplicates foreach r [lsort -dictionary [array names revkind]] { if {$revkind($r) eq "root"} { gen_log:log D "revkind($r) $revkind($r)" } } gen_log:log D "" foreach a [lsort -dictionary [array names revtags]] { gen_log:log D "revtags($a) $revtags($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revbtags]] { gen_log:log D "revbtags($a) $revbtags($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revbranches]] { gen_log:log D "revbranches($a) $revbranches($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names branchrevs]] { gen_log:log D "branchrevs($a) $branchrevs($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revmergefrom]] { # Only take one from the list that you might have here #set revmergefrom($a) [lindex $revmergefrom($a) end] gen_log:log D "revmergefrom($a) $revmergefrom($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revstate]] { gen_log:log D "revstate($a) $revstate($a)" } # We only needed these to place the you-are-here box. catch {unset rootbranch revbranch} gen_log:log T "LEAVE" } [namespace current]::reloadLog return [namespace current] } } } # Expect two lists. We look for the second one inside the # first one. # Return the length of the matching part and the first # item, if any, that's only in listB. proc list_within_list {listA listB} { set lA [llength $listA] set lB [llength $listB] # The lists may not actually be the same, but we can # look for where B might start in A set firstB [lindex $listB 0] set idx [lsearch $listA $firstB] if {$idx > -1} { set listA [lrange $listA $idx end] } # Find shorter list, end there set n_items [expr {$listA < $listB} ? {$lA} : {$lB}] for {set i 0} {$i < $n_items} {incr i} { set iA [lindex $listA $i] set iB [lindex $listB $i] if {$iA ne $iB} { break } } return [list $idx $i] } # Expect two lists that are the same after some point. # Collect the items that are different, and the first # one that's the same proc list_comm {listA listB} { gen_log:log T "listA: ([llength $listA]) $listA" gen_log:log T "listB: ([llength $listB]) $listB" set inA "" set inB "" set inBoth "" # Shortcut if lists are identical if { $listA == $listB } { set inA "" set inB "" set inBoth $listA #gen_log:log D "lists are IDENTICAL" return [list {IDENTICAL} $listA] } else { foreach B $listB { if {$B in $listA} { lappend inBoth $B } else { lappend inB $B } } foreach A $listA { if {$A ni $listB} { lappend inA $A } } } gen_log:log T "LEAVE A only: ([llength $inA]) $inA" gen_log:log T "LEAVE B only: ([llength $inB]) $inB" gen_log:log T "LEAVE in Both: ([llength $inBoth]) $inBoth" return [list $inA $inB $inBoth] } # We have both remote and local names of the same branch. # For duplicated ones, keep only the local proc prune_branchlist {branchlist} { gen_log:log T "ENTER ($branchlist)" set filtered_branchlist "" foreach r $branchlist { if {$r in $filtered_branchlist} {continue} if {[string match {*/HEAD} $r]} {continue} if {[regexp {/} $r]} { regsub {.*/} $r {} rtail if {$rtail ni $branchlist} { lappend filtered_branchlist $r } } else { if {$r ni $filtered_branchlist} { lappend filtered_branchlist $r } } } gen_log:log T "LEAVE ($filtered_branchlist)" return $filtered_branchlist } tkrev_9.6.1/tkrev/diff.tcl0000664000175000017500000000470413765056474016051 0ustar dorothyrdorothyr# NOTE: tkdiff exit status is nonzero if there are differences, so we # can't take it to mean failure proc comparediff {args} { # # This diffs a file with the repository (tkdiff ) # global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select one or more files to compare!" .workdir } else { foreach file $filelist { regsub -all {\$} $file {\$} file gen_log:log C "$cvscfg(tkdiff) \"$file\"" set ret [catch {exec {*}$cvscfg(tkdiff) "$file" &} view_this] if {$ret} { cvsfail $view_this .workdir } } } gen_log:log T "LEAVE" } # Two files proc comparediff_files {parent file1 file2} { global cvscfg gen_log:log T "ENTER ($file1 $file2)" gen_log:log C "$cvscfg(tkdiff) \"$file1\" \"$file2\"" set ret [catch {exec {*}$cvscfg(tkdiff) "$file1" "$file2" &} view_this] if {$ret} { cvsfail $view_this $parent } gen_log:log T "LEAVE" } proc comparediff_r {rev1 rev2 parent filename} { # # This diffs versions of a file, using one or two revisions (tkdiff -r1 [-r2] file) # global cvscfg global insvn gen_log:log T "ENTER (\"$rev1\" \"$rev2\" $filename)" if {$rev1 == {} && $rev2 == {}} { cvsfail "Must have at least one revision number or tag for this function!" $parent return 1 } if {$rev1 != {}} { if {$insvn} { set rev1 [string trimleft $rev1 {r}] } set rev1 "-r $rev1" } if {$rev2 != {}} { if {$insvn} { set rev2 [string trimleft $rev2 {r}] } set rev2 "-r $rev2" } set commandline "$cvscfg(tkdiff) $rev1 $rev2 \"$filename\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline &} view_this] if {$ret} { cvsfail $view_this $parent } gen_log:log T "LEAVE" } proc comparediff_sandbox {rev1 rev2 parent filename} { # # This diffs two revisions of a file that's not checked out # global cvscfg gen_log:log T "ENTER (\"$rev1\" \"$rev2\" $filename)" if {$rev1 == {} && $rev2 == {}} { cvsfail "Must have at least one revision number or tag for this function!" $parent return 1 } if {$rev1 != {}} { set rev1 [string trimleft $rev1 {r}] set rev1 "-r \"$rev1\"" } if {$rev2 != {}} { set rev2 [string trimleft $rev2 {r}] set rev2 "-r \"$rev2\"" } set commandline "$cvscfg(tkdiff) $rev1 $rev2 \"$filename\"" gen_log:log C "$commandline" cvs_sandbox_runcmd $commandline view_this gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/branch_diagram.tcl0000664000175000017500000027277115015446517020064 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # This is a major rewrite over the original version. It uses a # top down, recursive, branch-at-a-time, latest-revision-first # algorithm to layout the graph sensibly. # -- Mike Jagdis # namespace eval ::branch_diagram { variable instance 0 proc new {filename how scope} { # # Creates a new log canvas. # variable instance set my_idx $instance incr instance global current_tagname global module_dir variable sys variable loc namespace eval $my_idx { set my_idx [uplevel {concat $my_idx}] set how [uplevel {concat $how}] set filename [uplevel {concat $filename}] set scope [uplevel {concat $scope}] variable branchwin #variable cmd_log # Global constants scaled by current scaling factor for this instance variable curr upvar ::cvscfg cvscfg upvar ::cvsglb cvsglb upvar ::colorglb colorglb upvar ::logcfg logcfg upvar ::ingit in_git upvar ::insvn in_svn global tcl_platform # User options for info display for this instance variable revwho variable revdate variable revtime variable revstate variable revbranches variable branchrevs variable revcomment variable revtags variable revbtags variable revpath variable sel_tag set sel_tag(A) "" set sel_tag(B) "" variable sel_rev variable current_revnum set sel_rev(A) "" set sel_rev(B) "" variable search_lastpattern "" variable search_elements [list] variable search_index 0 variable search_lastcase 0 variable search_nocase 0 set branchwin ".branch_diagram$my_idx" gen_log:log T "ENTER [namespace current]" set sys_loc [split $how {,}] set sys [lindex $sys_loc 0] set loc [lindex $sys_loc 1] proc ClearSelection {AorB} { variable sel_tag variable sel_rev set branchwin [namespace inscope [namespace current] {set branchwin}] catch {$branchwin.canvas itemconfigure Sel$AorB -fill gray90} $branchwin.canvas dtag Sel$AorB $branchwin.up.rev${AorB}_rvers configure -state normal $branchwin.up.rev${AorB}_rvers delete 0 end $branchwin.up.rev${AorB}_rvers configure -state readonly $branchwin.up.log${AorB}_rlogfm.rcomment configure -state normal $branchwin.up.log${AorB}_rlogfm.rcomment delete 1.0 end $branchwin.up.log${AorB}_rlogfm.rcomment configure -state disabled $branchwin.up.rev${AorB}_rwho configure -text {} $branchwin.up.rev${AorB}_rdate configure -text {} set sel_tag($AorB) "" set sel_rev($AorB) "" return } proc SetSelection {AorB tag rev} { global cvscfg variable revdate variable revtime variable revwho variable revcomment variable sel_tag variable sel_rev set branchwin [namespace inscope [namespace current] {set branchwin}] ClearSelection $AorB set other [expr {$AorB == "A" ? {B} : {A}}] if {$rev == $sel_rev($other)} { ClearSelection $other } if {! [info exists revcomment($rev)]} { set revcomment($rev) "*** empty log message ***" } if {$tag != {}} { $branchwin.up.rev${AorB}_rvers configure -state normal $branchwin.up.rev${AorB}_rvers delete 0 end $branchwin.up.rev${AorB}_rvers insert end "$tag" $branchwin.up.rev${AorB}_rvers configure -state readonly } else { $branchwin.up.rev${AorB}_rvers configure -state normal $branchwin.up.rev${AorB}_rvers delete 0 end $branchwin.up.rev${AorB}_rvers insert end "$rev" $branchwin.up.rev${AorB}_rvers configure -state readonly } if {$rev != {} && [info exists revwho($rev)]} { $branchwin.up.rev${AorB}_rwho configure -text $revwho($rev) $branchwin.up.rev${AorB}_rdate configure -text\ "$revdate($rev) $revtime($rev)" $branchwin.up.log${AorB}_rlogfm.rcomment configure -state normal $branchwin.up.log${AorB}_rlogfm.rcomment insert end $revcomment($rev) $branchwin.up.log${AorB}_rlogfm.rcomment configure -state disabled } $branchwin.canvas addtag Sel$AorB withtag rect$rev $branchwin.canvas itemconfigure SelA -fill $cvscfg(colourA) $branchwin.canvas itemconfigure SelB -fill $cvscfg(colourB) set sel_tag($AorB) $tag set sel_rev($AorB) $rev return } proc RevSelect {AorB} { set branchwin [namespace inscope [namespace current] {set branchwin}] set t [$branchwin.canvas gettags current] SetSelection $AorB \ [string range [lindex $t [lsearch -glob $t {T*}]] 1 end] \ [string range [lindex $t [lsearch -glob $t {R*}]] 1 end] return } proc Unselect {AorB} { set branchwin [namespace inscope [namespace current] {set branchwin}] set t [$branchwin.canvas gettags current] if {$t != {} } {return} ClearSelection $AorB } proc EitherOrHead {} { variable sys set branchwin [namespace inscope [namespace current] {set branchwin}] set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA ne ""} { set rev $revA } elseif {$revB ne ""} { set rev $revB } else { if {$sys eq "SVN"} {set rev rHEAD} else {set rev HEAD} } return $rev } # This proc is called from the cvs, svn, or git modules proc ConfigureButtons {fname} { global cvsglb global module_dir variable sys variable loc variable current_revnum set branchwin [namespace inscope [namespace current] {set branchwin}] switch -- $sys { "SVN" { # Find out current rev and if it's a directory, if we can set kind "" set info_cmd [exec::new "svn info \"[file tail $fname]\""] set info_lines [split [$info_cmd\::output] "\n"] foreach infoline $info_lines { if {[string match "Node Kind:*" $infoline]} { gen_log:log D "$infoline" set kind [lindex $infoline end] } elseif {[string match "Last Changed Rev:*" $infoline]} { gen_log:log D "$infoline" set current_revnum [lindex $infoline end] } } if {! [info exists current_revnum]} { gen_log:log E "Warning: couldn't find current revision number!" } $branchwin.up.bmodbrowse configure -command modbrowse_run \ -image Modules_svn -state normal $branchwin.up.lfname configure -text "SVN Path" $branchwin.up.rfname configure -state normal $branchwin.up.rfname delete 0 end $branchwin.up.rfname insert end "$module_dir/$fname" $branchwin.up.rfname configure -state readonly $branchwin.view configure -state normal \ -command [namespace code { set rev [EitherOrHead] svn_fileview $rev $filename "file" }] $branchwin.log configure -state normal \ -command [namespace code { svn_log_rev [EitherOrHead] $filename }] $branchwin.annotate configure \ -command [namespace code { set rev [EitherOrHead] if {$rev eq "rHEAD"} {set revpath($rev) "$filename"} svn_annotate_r $rev "$revpath($rev)" }] $branchwin.diff configure \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA eq "" || $revB eq ""} { set rev [EitherOrHead] comparediff_r $rev "" $branchwin $filename } else { comparediff_r $revA $revB $branchwin $filename } }] $branchwin.patchdiff configure -state normal \ -command [namespace code { set rev [EitherOrHead] svn_difflog_rev $rev "$revpath($rev)" }] $branchwin.ddiff configure -state normal \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA eq "" && $revB eq ""} { cvsfail "Please select a revision!" $branchwin return } set rev [EitherOrHead] svn_show_rev $rev "$revpath($rev)" }] $branchwin.merge configure \ -command [namespace code { set currentrevpath "$revpath(r$current_revnum)@$current_revnum" set fromrev [$branchwin.up.revA_rvers get] if {$fromrev == ""} { cvsfail "Please select a revision to merge from!" $branchwin return } set fromrevpath "$revpath($fromrev)@[string trimleft $fromrev {r}]" set sincerev [$branchwin.up.revB_rvers get] set fromtag "" if {[info exists revbtags($sincerev)]} { set fromtag [lindex $revbtags($sincerev) 0] } if {$fromtag == ""} { foreach brev [array names revbtags] { set b $revbtags($brev) if {$b == ""} continue foreach r $branchrevs($b) { if {$r == $fromrev} { set fromtag $b } } } } if {$sincerev == ""} { svn_merge $branchwin $fromrevpath "" $currentrevpath $fromtag $filename } else { set sincerevpath "$revpath($sincerev)@[string trimleft $sincerev {r}]" svn_merge $branchwin $fromrevpath $sincerev $sincerevpath $fromtag $filename } }] if {$kind == "directory"} { $branchwin.view configure \ -command [namespace code { set rev [EitherOrHead] svn_fileview $rev $filename "directory" }] $branchwin.annotate configure -state disabled $branchwin.diff configure -state disabled $branchwin.patchdiff configure -state disabled $branchwin.ddiff configure -state disabled } } "CVS" { $branchwin.up.bmodbrowse configure -command modbrowse_run \ -image Modules_cvs -state normal $branchwin.up.lfname configure -text "RCS file" $branchwin.up.rfname configure -state normal $branchwin.up.rfname delete 0 end $branchwin.up.rfname insert end "$fname,v" $branchwin.up.rfname configure -state readonly if {$loc == "rep"} { # Working on repository files, not checked out $branchwin.view configure -state normal \ -command [namespace code { set rev [EitherOrHead] cvs_fileview_checkout $rev $filename }] $branchwin.log configure -state disabled $branchwin.annotate configure -state disabled $branchwin.diff configure -state disabled $branchwin.merge configure -state disabled } else { # We have a checked-out local file $branchwin.view configure \ -command [namespace code { set rev [EitherOrHead] cvs_fileview_update $rev $filename }] $branchwin.log configure -state normal \ -command [namespace code { set rev [EitherOrHead] cvs_log_rev $rev $filename }] $branchwin.annotate configure \ -command [namespace code { set rev [EitherOrHead] cvs_annotate_r $rev "$module_dir/$filename" }] $branchwin.diff configure -state normal \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA eq "" || $revB eq ""} { set rev [EitherOrHead] comparediff_r $rev "" $branchwin $filename } else { comparediff_r $revA $revB $branchwin $filename } }] $branchwin.merge configure \ -command [namespace code { set fromrev [$branchwin.up.revA_rvers get] set sincerev [$branchwin.up.revB_rvers get] if {$fromrev eq ""} { cvsfail "Please select a revision to merge from!" $branchwin return } set fromtag "" set fromrev_root [join [lrange [split $fromrev {.}] 0 end-1] {.}] if {[info exists revbtags($fromrev_root)]} { set fromtag [lindex $revbtags($fromrev_root) 0] } else { # Just a rev number will do set fromtag $fromrev_root } cvs_merge $branchwin $fromrev $sincerev $fromtag [list $filename] }] } } "GIT" { $branchwin.up.bmodbrowse configure -command modbrowse_run \ -image Modules_git -state normal $branchwin.up.lfname configure -text "GIT Path" $branchwin.up.rfname configure -state normal $branchwin.up.rfname delete 0 end $branchwin.up.rfname insert end "$cvsglb(relpath)/$fname" $branchwin.up.rfname configure -state readonly set info_cmd [exec::new "git log --abbrev-commit --pretty=oneline --max-count=1 --no-color -- \"$fname\""] set infoline [$info_cmd\::output] gen_log:log D "$infoline" # don't split infoline because comments like this break it: #f6c73a2 Reinstate debug command. Apparently "$1"x != x works differently in bash 4.2 regsub { .*$} $infoline {} current_revnum #gen_log:log D "current_revnum $current_revnum" if {! [info exists current_revnum]} { gen_log:log E "Warning: couldn't find current revision number!" } $branchwin.view configure -state normal \ -command [namespace code { set rev [EitherOrHead] git_fileview $rev $cvsglb(relpath) "$filename" }] $branchwin.log configure \ -command [namespace code { set rev [EitherOrHead] git_log_rev $rev "$filename" }] $branchwin.annotate configure -state normal \ -command [namespace code { set rev [EitherOrHead] git_annotate_r $rev "$filename" }] $branchwin.diff configure \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA eq "" || $revB eq ""} { set rev [EitherOrHead] comparediff_r $rev "" $branchwin $filename } else { comparediff_r $revA $revB $branchwin $filename } }] $branchwin.patchdiff configure -state normal \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] git_patch "$filename" $revA $revB }] $branchwin.ddiff configure -state normal \ -command [namespace code { set rev [EitherOrHead] git_show $rev }] $branchwin.merge configure -state disabled $branchwin.viewtags configure -state normal \ -command {git_list_tags} if {[file isdirectory $fname]} { $branchwin.view configure -state disabled $branchwin.annotate configure -state disabled $branchwin.diff configure -state disabled $branchwin.patchdiff configure -state disabled $branchwin.merge configure -state disabled } } "RCS" { $branchwin.up.bmodbrowse configure -command modbrowse_run \ -image Modules -state normal $branchwin.up.lfname configure -text "RCS file" $branchwin.up.rfname configure -state normal $branchwin.up.rfname delete 0 end $branchwin.up.rfname insert end "$fname" $branchwin.up.rfname configure -state readonly $branchwin.view configure \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA ne ""} { set rev $revA } elseif {$revB ne ""} { set rev $revB } else { set rev "" } rcs_fileview_checkout $rev $filename }] $branchwin.log configure -state normal \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA ne ""} { set rev $revA } elseif {$revB ne ""} { set rev $revB } else { set rev "" } rcs_log_rev $rev $filename }] $branchwin.annotate configure -state disabled $branchwin.diff configure -state normal \ -command [namespace code { set revA [$branchwin.up.revA_rvers get] set revB [$branchwin.up.revB_rvers get] if {$revA eq "" || $revB eq ""} { set rev [EitherOrHead] comparediff_r $rev "" $branchwin $filename } else { comparediff_r $revA $revB $branchwin $filename } }] $branchwin.merge configure -state disabled } } } # Pop up a transient window with a listbox of the tags for a specific # revision proc PopupTags { x y } { global colorglb set branchwin [namespace inscope [namespace current] {set branchwin}] variable revtags gen_log:log T "ENTER ($x $y)" # We tagged the "more..." text with R$revision foreach tag [$branchwin.canvas gettags current] { if {[string index $tag 0] == {R}} { set rev [string range $tag 1 end] lassign [$branchwin.canvas coords $tag] rev_x rev_y gen_log:log D "item $tag coords: $rev_x $rev_y" break } } set mname "$branchwin.canvas.[join [split $rev {.}] {_}]" set ntags [llength $revtags($rev)] incr ntags if {$ntags > 20} {set ntags 20} set line_h [font metrics $colorglb(listboxfont) -displayof $branchwin -linespace] gen_log:log D "line height: $line_h" set h [expr {$ntags * $line_h}] gen_log:log D "height for $ntags tags: $h" incr h $line_h set maxlen 0 foreach t $revtags($rev) { set len [string length $t] if {$len > $maxlen} { set maxlen $len set maxtag $t } } set maxtag "mm$maxtag" set w [font measure $colorglb(listboxfont) -displayof $branchwin "$maxtag"] if {! [winfo exists $mname]} { gen_log:log D "width from $maxtag: $w" frame $mname -relief raised -bd 2 -bg $colorglb(hlbg) listbox $mname.lbx -font $colorglb(listboxfont) \ -yscrollcommand "$mname.yscr set" \ -listvariable [namespace current]::revtags($rev) ttk::scrollbar $mname.yscr -orient vertical -command "$mname.lbx yview" frame $mname.bot button $mname.but -text "Close" -command "$branchwin.canvas delete lbx" button $mname.arr -image arr_dn -command [namespace code "sort_tag_lbx $mname"] incr w [winfo reqwidth $mname.yscr] incr h [winfo reqheight $mname.but] $branchwin.canvas create window $rev_x $rev_y -anchor w \ -height $h -width $w -window $mname -tags lbx pack $mname.bot -in $mname -side bottom -expand 0 -fill x pack $mname.arr -in $mname.bot -side left -anchor w pack $mname.but -in $mname.bot -side right -anchor e -ipady 0 pack $mname.yscr -in $mname -side right -fill y pack $mname.lbx -in $mname -side left -expand yes -fill both bind $mname.lbx [namespace code " variable revtags set i \[$mname.lbx nearest %y\] SetSelection A \[lindex \$revtags($rev) \$i\] $rev $mname.lbx selection clear 0 end $mname.lbx selection set \$i"] bind $mname.lbx [namespace code " variable revtags set i \[$mname.lbx nearest %y\] SetSelection A \[lindex \$revtags($rev) \$i\] $rev $mname.lbx selection clear 0 end $mname.lbx selection set \$i"] bind $mname.lbx [namespace code " variable revtags set i \[$mname.lbx nearest %y\] SetSelection B \[lindex \$revtags($rev) \$i\] $rev $mname.lbx selection clear 0 end $mname.lbx selection set \$i"] } else { gen_log:log D "$mname already exists" $branchwin.canvas create window $rev_x $rev_y -anchor w \ -height $h -width $w -window $mname -tags lbx } gen_log:log T "LEAVE" return } # Sort the tags popup listbox proc sort_tag_lbx {mname} { set arr [$mname.arr cget -image] set tagvar [$mname.lbx cget -listvar] set taglist [set [$mname.lbx cget -listvar]] if {$arr eq {arr_up}} { set direction "-decreasing" $mname.arr configure -image "arr_dn" } else { set direction "-increasing" $mname.arr configure -image "arr_up" } set new_taglist [lsort -dictionary $direction $taglist] $mname.lbx delete 0 end foreach t $new_taglist { $mname.lbx insert end $t } } # Calculate size of the You are Here box proc CalcCurrent { revision } { variable curr variable font_bold variable font_bold_h set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($revision)" set redbox_width \ [expr {[image width Man] \ + $curr(padx) \ + [font measure $font_bold \ -displayof $branchwin.canvas {You are}] \ + $curr(padx,2)}] set redbox_height [image height Man] set h [expr {2 * $font_bold_h}] if {$h > $redbox_height} { set redbox_height $h } incr redbox_height $curr(pady,2) #gen_log:log T "LEAVE box sixe ($redbox_width x $redbox_height)" return [list $redbox_width $redbox_height] } # Draw You are Here box proc DrawCurrent { x y width height revision } { variable curr variable revstate variable font_bold variable curr_x variable curr_y set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($x $y $width $height $revision)" set curr_x $x set curr_y $y # draw the box set tx [expr {$x + $width}] set ty [expr {$y - $height}] $branchwin.canvas create rectangle \ $x $y $tx $ty \ -width $curr(width) -fill gray90 -outline red3 if {[info exists revstate(current)]} { if {$revstate(current) == {dead}} { $branchwin.canvas create line \ $x $y $tx $ty -fill red -width $curr(width) $branchwin.canvas create line \ $tx $y $x $ty -fill red -width $curr(width) } } set pad \ [expr {($width - [image width Man] - \ [font measure $font_bold -displayof $branchwin.canvas {You are}]) \ / 3}] set ty [expr {$y - [expr {$height/2}]}] # add the contents $branchwin.canvas create image \ [expr {$x + $pad}] $ty \ -image Man -anchor w $branchwin.canvas create text \ [expr {$x + $width - $pad}] $ty \ -text "You are\nhere" -anchor e \ -fill red3 \ -font $font_bold #gen_log:log T "LEAVE ()" return } # Finds the dimensions including tags, but not the location, for the blue # root box. That (tags on the root) can only happen in CVS, I think proc CalcRoot { root_rev } { global cvscfg upvar ::logcfg logcfg variable curr variable box_height variable font_bold variable font_norm variable font_norm_h variable root_info variable revtags variable revbtags variable tlist set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($root_rev)" set height $box_height set root_width 0 set tag_width 0 set tlist($root_rev) "" if {[info exists revtags($root_rev)]} { # We want to show all the coloured tags plus others to take # the total to at least cvscfg(tagdepth) set tag_colour "" set tag_black "" foreach tag $revtags($root_rev) { if {[info exists cvscfg(tagcolour,$tag)]} { lappend tag_colour $tag } else { lappend tag_black $tag } } set tlist($root_rev) [concat $tag_colour $tag_black] if {$logcfg(show_tags)} { if {[info exists cvscfg(tagdepth)] && $cvscfg(tagdepth) != 0} { set n [expr {$cvscfg(tagdepth) - [llength $tag_colour]}] if {$n < [llength $tag_black]} { set tag_black [concat [lrange $tag_black 0 [expr {$n-1}]] {more...}] } } set my_font $font_bold foreach tag $tlist($root_rev) { set w [font measure $my_font -displayof $branchwin.canvas $tag] if {$w > $tag_width} { set tag_width $w } } incr tag_width $curr(tspcb,2) set h [expr {[llength $tlist($root_rev)] * $font_norm_h}] if {$h > $height} { set height $h } } } if {![info exists revbtags($root_rev)]} {set revbtags($root_rev) {}} foreach s [subst $root_info] { set w [font measure $font_norm -displayof $branchwin.canvas " $s "] if {$w > $root_width} { set root_width $w } } incr width $curr(padx,2) set height [expr {$curr(pady,2) + \ [llength [subst $root_info]] * $font_norm_h}] gen_log:log T "LEAVE (tag_width $tag_width root_width $root_width height $height)" return [list $tag_width $root_width $height] } proc DrawRoot { x y rbox_width rbox_height cur_rev root_rev } { variable curr variable font_norm variable font_norm_h variable font_bold variable root_info variable revbtags variable revbranches variable tlist set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($x $y $rbox_width $rbox_height $cur_rev $root_rev)" if {[info exists revbtags($root_rev)]} { #gen_log:log D "revbtags($root_rev) $revbtags($root_rev)" gen_log:log D "Drawing root for $revbtags($root_rev) $root_rev" } else { gen_log:log D "Drawing nameless root for $root_rev" set revbtags() "" } # draw the box $branchwin.canvas create rectangle \ $x $y \ [expr {$x + $rbox_width}] [expr {$y - $rbox_height}] \ -width $curr(width) \ -tags box \ -fill gray90 -outline blue set tx [expr {$x + $rbox_width/2}] set ty [expr {$y - $curr(pady)}] #gen_log:log D "[subst $root_info]" foreach s [subst $root_info] { $branchwin.canvas create text \ $tx $ty \ -text $s \ -anchor s \ -font $font_norm -fill navy \ -tags "R$root_rev" incr ty -$font_norm_h } #gen_log:log T "LEAVE ()" return } # Finds the dimensions including tags, but not the location, of each revision box proc CalcRevision { revision } { global cvscfg global cvsglb upvar ::logcfg logcfg variable in_git variable curr variable box_height variable rev_info variable revdate variable revtime variable revwho variable font_norm variable font_norm_h variable font_bold variable revtags variable revbtags variable tlist variable btlist set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($revision)" set height $box_height set width 0 set tag_width 0 set tlist($revision) "" if {[info exists revtags($revision)]} { # We want to show all the coloured tags plus others to take # the total to at least cvscfg(tagdepth) set tag_colour "" set tag_black "" foreach tag $revtags($revision) { if {[info exists cvscfg(tagcolour,$tag)]} { lappend tag_colour $tag } else { lappend tag_black $tag } } if {[info exists cvscfg(tagdepth)] && $cvscfg(tagdepth) != 0} { set n [expr {$cvscfg(tagdepth) - [llength $tag_colour]}] if {$n < [llength $tag_black]} { set tag_black [concat [lrange $tag_black 0 [expr {$n-1}]] {more...}] } } set tlist($revision) [concat $tag_colour $tag_black] if {$logcfg(show_tags)} { foreach tag $tlist($revision) { if {$tag == {more...}} { set my_font $font_bold } else { set my_font $font_norm } set w [font measure $my_font -displayof $branchwin.canvas $tag] if {$w > $tag_width} { set tag_width $w } } incr tag_width $curr(tspcb,2) set h [expr {[llength $tlist($revision)] * $font_norm_h}] if {$h > $height} { set height $h } } } if {$in_git && $logcfg(show_tags) && (! $logcfg(show_branches) || $cvsglb(lightning))} { # If show_branches is off but we're in git, it doesn't cost anything to # get branch tags, so we can show them like tags set btlist($revision) "" set btag_colour "" set btag_black "" if {[info exists revbtags($revision)]} { foreach btag $revbtags($revision) { lappend btag_colour $btag } if {[info exists cvscfg(tagdepth)] && $cvscfg(tagdepth) != 0} { set n [expr {$cvscfg(tagdepth) - [llength $btag_colour]}] if {$n < [llength $btag_black]} { set btag_black [concat [lrange $btag_black 0 [expr {$n-1}]] {more...}] } } set btlist($revision) [concat $btag_colour $btag_black] set my_font $font_bold foreach rbt $revbtags($revision) { set w [font measure $my_font -displayof $branchwin.canvas $rbt] if {$w > $tag_width} { set tag_width $w } } incr tag_width $curr(tspcb,2) set h [expr {[llength $btlist($revision)] * $font_norm_h}] if {$h > $height} { set height $h } } } if {![info exists revtime($revision)]} {set revtime($revision) {}} if {![info exists revdate($revision)]} {set revdate($revision) {}} if {![info exists revinfo($revision)]} {set revinfo($revision) {}} if {![info exists revwho($revision)]} {set revwho($revision) {}} foreach s [subst $rev_info] { set w [font measure $font_norm -displayof $branchwin.canvas $s] if {$w > $width} { set width $w } } incr width $curr(padx,2) #gen_log:log T "LEAVE (tag_width $tag_width width $width height $height)" return [list $tag_width $width $height] } proc DrawRevision { x y width height revision} { global cvscfg global cvsglb upvar ::logcfg logcfg variable in_git global colorglb variable curr variable rev_info variable revdate variable revtime variable revwho variable revstate variable revkind variable revtags variable revbtags variable font_norm variable font_norm_h variable font_bold variable btlist variable tlist variable match variable fromtags variable totags variable xyw variable boxwidth variable fromprefix variable toprefix variable mrev variable drawn_revs upvar branch branch set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ($x $y $width $height $revision)" if {! [info exists drawn_revs]} { set drawn_revs "" } if {{$branch,$revision} in $drawn_revs} { gen_log:log E "$revision is already drawn!" return } set xyw($revision) [list $x [expr {$y - ($height / 4)}] $width ] # Draw the list of tags set tx [expr {$x - $curr(tspcb)}] set ty $y set revbtag $revbtags($branch) if {$in_git && $logcfg(show_tags) && (! $logcfg(show_branches) || $cvsglb(lightning))} { # This is a git-only thing. Treat branches as tags foreach btag $btlist($revision) { gen_log:log D "$revision: btag $btag" set my_font $font_bold set btagcolour blue set btaglist "" if {$btag == {more...}} { set my_font $font_bold set btaglist [list R$revision tag active] set tagcolour $cvscfg(tagcolour,$btag) } $branchwin.canvas create text \ $tx $ty \ -text $btag \ -anchor se -fill $btagcolour \ -font $my_font \ -tags $btaglist incr ty -$font_norm_h } } foreach tag $tlist($revision) { gen_log:log D "$revision: tag $tag" if {[string match "${fromprefix}_*" $tag]} { set mrev($tag) $revision lappend fromtags $tag regsub {.*_(.*$)} $tag {\1} tagend gen_log:log D " $tag is a FROM TAG" gen_log:log D " will need a TO TAG ${toprefix}_${revbtag}_$tagend" set match($tag) ${toprefix}_${revbtag}_$tagend } if {[string match "${toprefix}_*" $tag]} { set mrev($tag) $revision lappend totags $tag } if {$logcfg(show_tags)} { set my_font $font_norm set tagcolour $colorglb(canvfg) set taglist "" if {$tag == {more...}} { set my_font $font_bold set taglist [list R$revision tag active] } elseif {[info exists cvscfg(tagcolour,$tag)]} { set tagcolour $cvscfg(tagcolour,$tag) } $branchwin.canvas create text \ $tx $ty \ -text $tag \ -anchor se -fill $tagcolour \ -font $my_font \ -tags $taglist incr ty -$font_norm_h } } # draw the box... set tx [expr {$x + $width}] set ty [expr {$y - $height}] $branchwin.canvas create rectangle \ $x $y $tx $ty \ -width $curr(width) -fill gray90 -outline black \ -tags [list box selectable R$revision rect$revision active] # ...and add the contents if {[info exists revstate($revision)]} { if {$revstate($revision) == {dead}} { # in CVS, a "dead" revision, which is often present if a file was # added on a branch $branchwin.canvas create line \ $x $y $tx $ty -fill red -width $curr(width) $branchwin.canvas create line \ $tx $y $x $ty -fill red -width $curr(width) } elseif {$revstate($revision) == {ghost}} { # In GIT, a similar thing happens if a file was added on a branch. # It's not dead, it's just not reachable from the current branch. $branchwin.canvas create line \ $x $y $tx $ty -fill gray -width $curr(width) $branchwin.canvas create line \ $tx $y $x $ty -fill gray -width $curr(width) } } set tx [expr {$x + $width/2}] set ty [expr {$y - $curr(pady)}] foreach s [subst $rev_info] { $branchwin.canvas create text \ $tx $ty \ -text $s \ -anchor s \ -font $font_norm \ -fill black \ -tags [list selectable R$revision active] incr ty -$font_norm_h } lappend drawn_revs $branch,$revision #gen_log:log T "LEAVE ()" return } proc DrawBranch { x y root_rev branch } { global cvsglb global colorglb upvar ::logcfg logcfg upvar ::ingit in_git variable curr variable box_height variable bot_height variable tip_height variable lbl_height variable cur_height variable revkind variable branchrevs variable revbranches variable revbtags variable drawn_revs set branchwin [namespace inscope [namespace current] {set branchwin}] gen_log:log T "ENTER ($x $y $root_rev $branch)" gen_log:log T "level [info level]" if {! [info exists drawn_revs]} { set drawn_revs "" } if {[info exists revbtags($branch)]} { gen_log:log D "Drawing $revbtags($branch) $branch rooted at $root_rev ($x $y)" } else { gen_log:log D "Drawing nameless branch rooted at $root_rev ($x $y)" } # What revisions to show on this branch? Options may hide some if {![info exists branchrevs($branch)]} {set branchrevs($branch) {}} foreach r $drawn_revs { if {$r in $branchrevs($branch)} { gen_log:log E "Revision $r already drawn!" return [list $x $y 200 18 $y] } } if {$branchrevs($branch) == {}} { set revlist "" } else { # Always have the head revision set revlist [lindex $branchrevs($branch) 0] foreach r [lrange $branchrevs($branch) 1 end-1] { if {![info exists revbranches($r)]} {set revbranches($r) {}} if {$logcfg(show_inter_revs) || $logcfg(show_empty_branches) \ && $revbranches($r) != {}} { lappend revlist $r } else { # Only if there are non-empty branches off this revision foreach b $revbranches($r) { if {![info exists branchrevs($b)]} {set branchrevs($b) {}} if {$branchrevs($b) != {}} { lappend revlist $r break } } } } if {[llength $branchrevs($branch)] > 1} { # Always have the first revision on a branch lappend revlist [lindex $branchrevs($branch) end] } } # Work out width and height of this limb, saving sizes of revisions set tag_width 0 set rdata "" # On encountering a branch, it may be just a You are Here, which # has a simplified special procedure. Otherwise, kick off a new # branch. if {$branch == {current}} { set rtw 0 lassign [CalcCurrent $branch] box_width cur_height set lbl_height(current) $cur_height } else { lassign [CalcRoot $branch] rtw box_width bot_height set tip_height 0 if {$in_git} { set tip_height $bot_height set bot_height 0 } set lbl_height($branch) $bot_height gen_log:log D "set lbl_height($branch) ($lbl_height($branch))" #set tip_height $lbl_height($branch) if {$rtw > $tag_width} { set tag_width $rtw } } set height [expr {$lbl_height($branch) + $curr(spcy)}] # calculate the size of each revision in the branch, and keep # track of the largest x and y dimensions, which we will use # for all when drawing set rev_height 0 foreach revision $revlist { if {$revision == {current}} { set rtw 0 lassign [CalcCurrent $revision] rbw cur_height set lbl_height(current) $cur_height } else { lassign [CalcRevision $revision] rtw rbw rev_height } if {$rev_height != 0} { set rh $rev_height } else { set rh $cur_height } lappend rdata $rtw $rh if {$rtw > $tag_width} { set tag_width $rtw } if {$rbw > $box_width} { set box_width $rbw } incr height $curr(spcy) incr height $rh } # At the end, we've saved the height and width of the whole column # Position branch. Query the canvas to look for overlaps, using the # lower-left x and y that were passed in, and the measured width and # accumulated height. Use tk's canvas overlap command to find and tag # any overlapping objects within the rectangle. We haven't drawn # anything yet, this is still just in memory # Look for overlap horizontally while {1} { set overlap_llx [expr {$x - $curr(spcx)}] set overlap_lly [expr {$y - $height + $curr(yfudge)}] set overlap_urx [expr {$x + $tag_width + $box_width}] set overlap_ury $y $branchwin.canvas addtag ol_x overlapping \ $overlap_llx $overlap_lly $overlap_urx $overlap_ury set bbox [$branchwin.canvas bbox ol_x] $branchwin.canvas dtag ol_x if {$bbox == {}} { break } gen_log:log D "horizontal overlap with $bbox" # Move branch to rightmost point of overlapped objects plus some space # N.B. +1 because exactly equal counts as an overlap set x [expr {[lindex $bbox 2] + $curr(spcx) + 1}] } # Look for overlap vertically set overlap_llx $x set overlap_lly [expr {$y - $height}] set overlap_urx [expr {$x + $tag_width + $box_width}] set overlap_ury [expr {$y - $height + $curr(yfudge)}] $branchwin.canvas addtag ol_y overlapping \ $overlap_llx $overlap_lly $overlap_urx $overlap_ury set bbox [$branchwin.canvas bbox ol_y] $branchwin.canvas dtag ol_y if {$bbox != {}} { # Move down to make space gen_log:log D "vertical overlap with $bbox" incr y [expr {[lindex $bbox 3] - ($y - $height) + $curr(spcy) + $tip_height}] } # Now we're ready to start drawing # Position to top of branch incr x $tag_width set top_y $y incr y -$height # Draw this branch set midx [expr {$x + $box_width/2}] set last_y "" foreach revision $revlist {rtag_width rheight} $rdata { incr y $curr(spcy) incr y $rheight # For each branch off this revision, draw it to the right of this # revision box and a little above the centre line of this box. set x2 [expr {$x + $box_width + $curr(spcx)}] set y2 [expr {$y - $box_height/2 - $curr(boff)}] set brevs "" set bxys "" if {[info exists revbranches($revision)]} { # Here we recurse into branches off of the current branch foreach r2 $revbranches($revision) { if {![info exists branchrevs($r2)] } { set branchrevs($r2) {} } # Don't display the branch if it is empty unless # logcfg(show_empty_branches) is set. Except for You are Here, # which is a special case if {$branchrevs($r2) == {} && $r2 != {current} && !\ $logcfg(show_empty_branches)} { continue } lappend brevs $r2 foreach {lx y2 lbw rh lly} [DrawBranch $x2 $y2 $revision $r2] { lappend bxys $lx $lbw $rh $lly break } set x2 [expr {$lx + $lbw + $curr(spcx)}] } } # y2 may have changed to accomodate a long branch. If so we need # to figure out what our y should be set y [expr {$y2 + $box_height/2 + $curr(boff)}] set rx [expr {$x + $box_width}] set ry [expr {$y - $box_height/2}] set by [expr {$ry - $curr(boff)}] # If it has brevs, it's the root of a branch # Draw the arrows before the boxes, leaving box-high spaces between them foreach b $brevs {bx bw rh ly} $bxys { set mx [expr {$bx + $bw/2}] if {$ly != {} && ! $in_git} { # The up-pointing arrow below the bottom revision, if that has been raised $branchwin.canvas create line \ $mx $ly $mx [expr {$by - $rh}] \ -fill $colorglb(canvfg) \ -arrow first -arrowshape $curr(arrowshape) -width $curr(width) } if {$in_git && $ly != {}} { set ny [expr {$ly + $curr(boff)}] if {$ny != $by} { # The up-pointing arrow below the bottom revision, if that has been raised $branchwin.canvas create line \ $mx $ly $mx [expr {$by - $curr(boff)}] \ -fill $colorglb(canvfg) \ -arrow first -arrowshape $curr(arrowshape) -width 1 } } if {$b == {current}} { # treat this "current" as a branch. The arrow points sideways to it DrawCurrent $bx $by $bw $cur_height $revision $branchwin.canvas lower [ \ $branchwin.canvas create line \ $rx $ry $mx $ry $mx $by \ -fill $colorglb(canvfg) \ -arrow last -arrowshape $curr(arrowshape) -width $curr(width) ] # And we're done, no arrows or boxes above it continue } else { # if the last (top) revision is current, we don't draw that one now. # We save it for when we draw the regular revboxes, below set last_rev [lindex $branchrevs($b) 0] if {$last_rev == {current}} { set last_rev [lindex $branchrevs($b) 1] } } if {!$in_git } { # The blue box at the base of each branch DrawRoot $bx $by $bw $lbl_height($b) $revision $b #if {$ly == {} } { #$branchwin.canvas create line \ #$mx [expr {$by - $rh}] $mx [expr {$by - $rh - $curr(boff)}] \ #-arrow last -arrowshape $curr(arrowshape) \ #-width $curr(width) -fill brown #} } # Arrow connecting the branch root box to its parent if {$in_git} { # Curved line. #set ay [expr {$by - $tip_height - $curr(boff)}] set ay [expr {$by - $curr(boff)}] $branchwin.canvas lower [ \ $branchwin.canvas create line \ $rx $ry $mx $ry $mx $ay \ -fill $colorglb(canvfg) \ -arrow last -arrowshape $curr(arrowshape) -smooth 1 ] } else { # Blue elbow $branchwin.canvas lower [ \ $branchwin.canvas create line \ $rx $ry $mx $ry $mx $by \ -arrow last -arrowshape $curr(arrowshape) -width $curr(width) \ -fill blue ] } if {$logcfg(update_drawing) < 1} { UpdateBndBox } } # finised drawing special items for sub-branches if {$last_y != {}} { # This is a regular between-revisions arrow $branchwin.canvas create line \ $midx $last_y $midx [expr {$y - $box_height}] \ -fill $colorglb(canvfg) \ -arrow first -arrowshape $curr(arrowshape) -width $curr(width) } # Start drawing the boxes. # First, the top one may well be "current" which is # a special case. if {$revision == {current}} { DrawCurrent $x $y $box_width $rheight $revision } else { # Otherwise, draw normal revision DrawRevision $x $y $box_width $rheight $revision } if {$logcfg(update_drawing) < 1} { UpdateBndBox } set last_y $y set last_rev $revision } # Finished individual revisions and their branches if {$in_git && ! $cvsglb(lightning)} { # For Git, now we draw the root box at the top lassign [CalcRoot $branch] rtw ignore bot_height if {$last_y != {} } { set gy [expr {$top_y - $height}] DrawRoot [expr {$midx - ($box_width/2)}] $gy $box_width $bot_height [lindex $branchrevs($branch) end] $branch $branchwin.canvas lower [ \ $branchwin.canvas create line \ $midx $gy $midx [expr {$gy + $curr(spcy)}] \ -fill blue \ -arrow first -arrowshape $curr(arrowshape) -width $curr(width) ] } } if {$logcfg(update_drawing) < 2} { UpdateBndBox } set new_y [expr {$y + $lbl_height($branch) + $curr(spcy)}] gen_log:log T "LEAVE ($x $new_y $box_width $lbl_height($branch) $last_y)" return [list $x $new_y $box_width $lbl_height($branch) $last_y] } proc DrawSideTree { x y root_rev } { variable in_git global colorglb variable curr variable lbl_height variable branchrevs variable revmergefrom variable xyw set branchwin [namespace inscope [namespace current] {set branchwin}] gen_log:log T "ENTER: ($x $y $root_rev)" gen_log:log D "Drawing SideTree branch at $root_rev" foreach {lx y2 lbw rh lly} [DrawBranch $x $y $root_rev $root_rev] { lappend bxys $lx $lbw $rh $lly break } gen_log:log D "Drawing root for $root_rev SideTree" lassign [CalcRoot $root_rev] rtw box_width box_height set x2 [expr {$lx + $lbw + $curr(spcx)}] set mx [expr {$lx + $lbw/2}] set ry [expr {$y2 - $rh/4 - $curr(spcy)}] set by [expr {$y2 - $curr(boff)}] lassign [CalcRoot $root_rev] rtw box_width ignore if {! $in_git } { # This is the blue box at the bottom of the side branch for a rootless tree DrawRoot $lx $y2 $lbw $lbl_height($root_rev) $root_rev $root_rev # This is the arrow at the base of the side branch $branchwin.canvas lower [\ $branchwin.canvas create line \ $mx $ry $mx [expr {$by - $rh}] \ -fill $colorglb(canvfg) \ -arrow last -arrowshape $curr(arrowshape) \ -width $curr(width) ] } # See if any merges were from this branch back to one we've already drawn foreach to [array names revmergefrom] { if {$revmergefrom($to) ni $branchrevs($root_rev)} continue #gen_log:log D "revmergefrom($to) $revmergefrom($to)" set from $revmergefrom($to) if {[info exists xyw($from)]} { #gen_log:log D " xyw($from) $xyw($from)" } else { #gen_log:log D " xyw($from) doesn't exist" continue } if {[info exists xyw($to)]} { gen_log:log D " xyw($to) $xyw($to)" } else { #gen_log:log D " xyw($to) doesn't exist" continue } set xto [lindex $xyw($from) 0] set yto [lindex $xyw($from) 1] set bwto [lindex $xyw($from) 2] set xfrom [lindex $xyw($to) 0] set yfrom [lindex $xyw($to) 1] set bwfrom [lindex $xyw($to) 2] set xmid $xto set ymid $yto if {$xto > $xfrom} { set xfrom [expr {$xfrom + $bwfrom}] set yfrom [expr {$yfrom - ($box_height / 2)}] set yto [expr {$yto - ($box_height / 2)}] set xmid [expr {$xfrom + (($xto - $xfrom) / 2)}] set ymid [expr {$yto - $box_height}] } elseif {$xfrom > $xto} { set xto [expr {$xto + $bwto}] set xmid [expr {$xto + (($xfrom - $xto) / 2)}] set ymid [expr {$yto + ($box_height / 2)}] } elseif {$xto == $xfrom} { set xmid [expr {$xto - ($bwfrom / 2)}] set ymid [expr {$yfrom - (($yfrom - $yto) / 2)}] } $branchwin.canvas create line \ $xfrom $yfrom $xmid $ymid $xto $yto \ -fill $colorglb(canvfg) \ -arrow first -smooth 1 } UpdateBndBox gen_log:log T "LEAVE" return $x2 } proc UpdateBndBox {} { variable in_git variable font_bold variable view_xoff variable view_yoff variable curr_x variable curr_y set branchwin [namespace inscope [namespace current] {set branchwin}] #gen_log:log T "ENTER ()" lassign [$branchwin.canvas bbox all] x1 y1 x2 y2 if {$x1 == ""} { gen_log:log D "No BBOX" return } if {! $in_git} { $branchwin.canvas configure \ -scrollregion [list \ [expr {$x1 - 5}] [expr {$y1 - 5}] \ [expr {$x2 + 5}] [expr {$y2 + 5}] ] } else { # In git, we may have merge arrows to the left of the first column. # tk doesn't include these in the bounding box, for some reason $branchwin.canvas configure \ -scrollregion [list \ [expr {$x1 - 25}] [expr {$y1 - 5}] \ [expr {$x2 + 5}] [expr {$y2 + 5}] ] } if {[info exists curr_x]} { set bbox [$branchwin.canvas bbox all] set llx [lindex $bbox 0] set lly [lindex $bbox 1] set urx [lindex $bbox 2] set ury [lindex $bbox 3] set bbox_width [expr {$urx - $llx}] set bbox_height [expr {$ury - $lly}] gen_log:log D "diagram bbox: $bbox_width x $bbox_height" set xvw [$branchwin.canvas xview] set yvw [$branchwin.canvas yview] set xvl_frac [lindex $xvw 0] set xvr_frac [lindex $xvw 1] set yvt_frac [lindex $yvw 0] set yvb_frac [lindex $yvw 1] set canvas_l [expr {int($bbox_width * $xvl_frac)}] set canvas_r [expr {int($bbox_width * $xvr_frac)}] set canvas_t [expr {int($bbox_height * $yvt_frac)}] set canvas_b [expr {int($bbox_height * $yvb_frac)}] set canv_width [expr {$canvas_r - $canvas_l}] set canv_height [expr {$canvas_b - $canvas_t}] gen_log:log D "canvas xrange $canvas_l $canvas_r ($canv_width)" gen_log:log D "canvas yrange $canvas_b $canvas_t ($canv_height)" gen_log:log D "calculated canvas: $canv_width x $canv_height" set view_y -$canv_height if {$curr_x > $canv_width} { set dist_x [expr {$curr_x - $canv_width/2}] set dist_x [expr {$dist_x - 3 * [font measure $font_bold \ -displayof $branchwin.canvas {You are}]}] #gen_log:log D "positioning x: new x $dist_x" } else { #gen_log:log D "not re-positioning x" set dist_x 0 } #gen_log:log D "y: (curr_y $curr_y) $xfrom} { set xfrom [expr {$xfrom + $bwfrom}] set yfrom [expr {$yfrom - ($box_height / 2)}] set yto [expr {$yto - ($box_height / 2)}] set xmid [expr {$xfrom + (($xto - $xfrom) / 2)}] set ymid [expr {$yto - $box_height}] } elseif {$xfrom > $xto} { set xto [expr {$xto + $bwto}] set xmid [expr {$xto + (($xfrom - $xto) / 2)}] set ymid [expr {$yto + ($box_height / 2)}] } elseif {$xto == $xfrom} { set xmid [expr {$xto - ($bwfrom / 2)}] set ymid [expr {$yfrom - (($yfrom - $yto) / 2)}] } $branchwin.canvas create line \ $xfrom $yfrom $xmid $ymid $xto $yto \ -fill $colorglb(canvfg) \ -arrow first -smooth 1 } } # Reselect the previously selected revisions variable sel_tag variable sel_rev foreach AorB {A B} { SetSelection $AorB $sel_tag($AorB) $sel_rev($AorB) } busy_done $branchwin } gen_log:log T "LEAVE ()" if {[info exists x2]} { return $x2 } else { return 0 } } proc SaveOptions {} { upvar ::logcfg logcfg variable loc # Save the options to the global set set logcfg(update_drawing) $logcfg(update_drawing) foreach {key value} [array get opt] { gen_log:log D "logcfg($key) $value" set logcfg($key) $value } save_options } # Search functionality for log viewer that searches for strings in the # log windows. It will create a new button and an entry box below the logs. You # can enter a glob-style search pattern in the entry field and click the search # button. With every click (or pressing enter), the log viewer jumps from one # occurrence of the pattern to the next, highlighting it in red. # # The following special characters are used in the search pattern: # # * Matches any sequence of characters in string, including a null string. # # ? Matches any single character in string. # # [chars] Matches any character in the set given by chars. If a sequence of the # form x-y appears in chars, then any character between x and y, inclusive, will # match. # # \x Matches the single character x. This provides a way of avoiding the # special interpretation of the characters *?[]\ in pattern. # # If you only enter "FOO" (without the ") in the entry box, it searches the exact # string "FOO". If you want to search all strings starting with "FOO", you have # to put "FOO*". For all strings containing "FOO", you must put "*FOO*". proc Search {} { global cvscfg global colorglb variable font_bold variable search_elements variable search_index variable search_lastpattern variable search_lastcase variable search_nocase variable revwho variable revdate variable revtime variable revcomment variable revtags variable revbtags set branchwin [namespace inscope [namespace current] {set branchwin}] gen_log:log T "ENTER search_index $search_index, search_elements $search_elements" # Read search pattern from entry box set pattern [string trim [$branchwin.down.search.e get]] # Check if search pattern or nocase flag have been changed since the # last call if {([string equal $pattern $search_lastpattern] == 0) \ ||($search_lastcase != $search_nocase)} { # Restore box colors foreach item [$branchwin.canvas find withtag box] { $branchwin.canvas itemconfigure $item -fill $colorglb(textbg) } $branchwin.canvas itemconfigure SelA -fill $cvscfg(colourA) $branchwin.canvas itemconfigure SelB -fill $cvscfg(colourB) # Rebuild matching element list set search_lastpattern $pattern set search_lastcase $search_nocase set search_elements [list] # Ignore empty patterns if {[string length $pattern] != 0} { # Collect all the revision data foreach r [array names revdate] { set data "$r " catch {append data "$revwho($r) "} catch {append data "$revdate($r) "} catch {append data "$revtime($r) "} catch {append data "$revcomment($r) "} catch {append data "$revtags($r) "} catch {append data "$revbtags($r) "} # Check if text element matches search pattern if {$search_nocase} { if {[string match -nocase "*$pattern*" $data]} { # Add element to list of matching elements lappend search_elements $r gen_log:log D "$pattern MATCHED $data" } } else { if {[string match "*$pattern*" $data]} { # Add element to list of matching elements lappend search_elements $r gen_log:log D " $pattern MATCHED $data" } } } } # Reset highlight index set search_index 0 # Pattern has not been changed since last call and there have been # matching elements found in the last call } elseif {[llength $search_elements] != 0} { # Select next matching element (restart if last one has been passed) incr search_index if {$search_index >= [llength $search_elements]} { set search_index 0 } set rev [lindex $search_elements $search_index] gen_log:log D " $rev" } # Check if there are matching elements set length [llength $search_elements] if {$length > 0} { foreach rev $search_elements { # This is the counter in the status bar $branchwin.down.search.l configure -text "[expr {$search_index + 1}] / $length" # Find canvas items with tag rect$r foreach item [$branchwin.canvas find withtag "box&&rect$rev"] { # Color the rectangle $branchwin.canvas itemconfigure $item -fill lightsalmon } } set rev [lindex $search_elements $search_index] # There should only be one match but things go wrong set items [$branchwin.canvas find withtag "box&&rect$rev"] set il [llength $items] if { $il > 1} { gen_log:log D "$il ITEMS MATCH the tag rect$rev" } set item [lindex $items 0] # There may be a data item for $rev but it isn't drawn if {$item != {}} { $branchwin.canvas itemconfigure $item -fill orangered # Scroll to next matching item set scrollregion [$branchwin.canvas cget -scrollregion] set coords [$branchwin.canvas bbox $item] set sx1 [lindex $scrollregion 0] set sy1 [lindex $scrollregion 1] set sx2 [lindex $scrollregion 2] set sy2 [lindex $scrollregion 3] set ix1 [lindex $coords 0] set iy1 [lindex $coords 1] set ix2 [lindex $coords 2] set iy2 [lindex $coords 3] set xview [$branchwin.canvas xview] set yview [$branchwin.canvas yview] set vx1 [lindex $xview 0] set vx2 [lindex $xview 1] set vy1 [lindex $yview 0] set vy2 [lindex $yview 1] set x [expr {(double($ix1 - $sx1) / double($sx2 - $sx1)) -(($vx2 - $vx1) / 2)}] set y [expr {(double($iy1 - $sy1) / double($sy2 - $sy1)) -(($vy2 - $vy1) / 2)}] $branchwin.canvas xview moveto $x $branchwin.canvas yview moveto $y if {! [info exists revcomment($rev)]} { set revcomment($rev) "*** empty log message ***" } } $branchwin.up.revA_rvers configure -state normal $branchwin.up.revA_rvers delete 0 end $branchwin.up.revA_rvers insert end "$rev" $branchwin.up.revA_rvers configure -state readonly if {$rev != {} && [info exists revwho($rev)]} { $branchwin.up.revA_rwho configure -text $revwho($rev) $branchwin.up.revA_rdate configure -text "$revdate($rev) $revtime($rev)" $branchwin.up.logA_rlogfm.rcomment configure -state normal $branchwin.up.logA_rlogfm.rcomment delete 1.0 end if {$item == {}} { $branchwin.up.logA_rlogfm.rcomment insert end "*** not drawn ***\n" } $branchwin.up.logA_rlogfm.rcomment insert end $revcomment($rev) $branchwin.up.logA_rlogfm.rcomment configure -state disabled } } else { $branchwin.down.search.l configure -text "Not found" } } ;# End of Search proc toplevel $branchwin wm title $branchwin "TkRev Branches $filename" menubar_menus $branchwin set filemenu_idx [$branchwin.menubar index "File"] $branchwin.menubar insert [expr {$filemenu_idx + 1}] cascade -label "Diagram"\ -menu [menu $branchwin.menubar.view] -underline 0 help_menu $branchwin # Diagram menu $branchwin.menubar.view.update $branchwin.menubar.view.update add radiobutton -label "Every Revision" \ -variable logcfg(update_drawing) -value 0 $branchwin.menubar.view.update add radiobutton -label "Every Branch" \ -variable logcfg(update_drawing) -value 1 $branchwin.menubar.view.update add radiobutton -label "When Finished" \ -variable logcfg(update_drawing) -value 2 $branchwin.menubar.view add separator $branchwin.menubar.view add cascade -label "Tree Layout" \ -menu $branchwin.menubar.view.tree menu $branchwin.menubar.view.tree $branchwin.menubar.view.tree add checkbutton -label \ "Show tags" \ -variable logcfg(show_tags) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.tree add checkbutton -label \ "Show branches" \ -variable logcfg(show_branches) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.tree add checkbutton -label \ "Show empty branches" \ -variable logcfg(show_empty_branches) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.tree add checkbutton -label \ "Show intermediate revisions" \ -variable logcfg(show_inter_revs) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.tree add checkbutton -label \ "Show merges" \ -variable logcfg(show_merges) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view add cascade -label "Branch Layout" \ -menu $branchwin.menubar.view.branch menu $branchwin.menubar.view.branch $branchwin.menubar.view.branch add command -label "Turn all options on" \ -command [namespace code { set logcfg(show_root_tags) 1 DrawTree }] $branchwin.menubar.view.branch add command -label "Turn all options off" \ -command [namespace code { set logcfg(show_root_tags) 0 DrawTree }] $branchwin.menubar.view.branch add separator $branchwin.menubar.view.branch add checkbutton -label "Show label" \ -variable logcfg(show_root_tags) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view add cascade -label "Revision Layout" \ -menu $branchwin.menubar.view.rev menu $branchwin.menubar.view.rev $branchwin.menubar.view.rev add command -label "Turn all options on" \ -command [namespace code { set logcfg(show_tags) 1 set logcfg(show_branches) 1 set logcfg(show_box_rev) 1 set logcfg(show_box_revwho) 1 set logcfg(show_box_revdate) 1 set logcfg(show_box_revtime) 1 DrawTree }] $branchwin.menubar.view.rev add command -label "Turn all options off" \ -command [namespace code { set logcfg(show_tags) 0 set logcfg(show_branches) 0 set logcfg(show_box_rev) 0 set logcfg(show_box_revwho) 0 set logcfg(show_box_revdate) 0 set logcfg(show_box_revtime) 0 DrawTree }] $branchwin.menubar.view.rev add separator $branchwin.menubar.view.rev add checkbutton -label "Show revision" \ -variable logcfg(show_box_rev) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.rev add checkbutton -label "Show author" \ -variable logcfg(show_box_revwho) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.rev add checkbutton -label "Show date" \ -variable logcfg(show_box_revdate) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view.rev add checkbutton -label "Show time" \ -variable logcfg(show_box_revtime) \ -onvalue 1 -offvalue 0 \ -command [namespace code { DrawTree }] $branchwin.menubar.view add separator $branchwin.menubar.view add cascade -label "Size" \ -menu $branchwin.menubar.view.size menu $branchwin.menubar.view.size foreach {label factor} $logcfg(scaling_options) { $branchwin.menubar.view.size add radiobutton -label $label \ -variable logcfg(scale) -value $factor \ -command [namespace code { DrawTree }] } $branchwin.menubar.view add separator $branchwin.menubar.view add command -label "Save options" \ -command [namespace code { SaveOptions }] if {$in_git} { # The git options menu git_branch_menu $branchwin $filename } if { [tk windowingsystem] eq "x11" } { wm iconphoto $branchwin Branch } else { wm iconphoto $branchwin -default AppIcon } wm protocol $branchwin WM_DELETE_WINDOW \ [namespace code {$branchwin.close invoke}] frame $branchwin.up -relief groove -borderwidth 2 set textfont $colorglb(listboxfont) set disbg [lindex [$branchwin.up configure -background] 4] label $branchwin.up.lfname -width 12 -anchor w entry $branchwin.up.rfname -font $textfont -relief groove \ -bd 1 -relief sunk -state readonly button $branchwin.up.bmodbrowse -image Modules \ -command modbrowse_run button $branchwin.up.bworkdir -image Workdir \ -command { workdir_setup } pack $branchwin.up -side top -fill x foreach fm {A B} { label $branchwin.up.rev${fm}_lvers -text "Revision $fm" entry $branchwin.up.rev${fm}_rvers -textvariable {} \ -width 8 -bd 1 -relief sunk -state readonly label $branchwin.up.rev${fm}_ldate -text "Committed" label $branchwin.up.rev${fm}_rdate -text {} \ -anchor w -font $textfont label $branchwin.up.rev${fm}_lwho -text " by " label $branchwin.up.rev${fm}_rwho -text {} \ -anchor w -font $textfont label $branchwin.up.log${fm}_lcomment -text "Log $fm" frame $branchwin.up.log${fm}_rlogfm -bd 3 -bg $cvscfg(colour$fm) text $branchwin.up.log${fm}_rlogfm.rcomment -height 5 \ -fg $colorglb(textfg) -bg $colorglb(textbg) -state disabled \ -yscrollcommand [namespace code\ "$branchwin.up.log${fm}_rlogfm.yscroll set"] ttk::scrollbar $branchwin.up.log${fm}_rlogfm.yscroll \ -command [namespace code\ "$branchwin.up.log${fm}_rlogfm.rcomment yview"] } grid columnconf $branchwin.up 5 -weight 1 grid $branchwin.up.lfname -column 0 -row 0 -sticky nw grid $branchwin.up.rfname -column 1 -row 0 -columnspan 5 -sticky ew grid $branchwin.up.bworkdir -column 6 -row 0 -rowspan 2 -sticky e\ -padx 2 -pady 1 grid $branchwin.up.bmodbrowse -column 7 -row 0 -rowspan 2 -sticky e\ -padx 2 -pady 1 grid $branchwin.up.revA_lvers -column 0 -row 1 -sticky w grid $branchwin.up.revA_rvers -column 1 -row 1 -sticky w grid $branchwin.up.revA_ldate -column 2 -row 1 -sticky w grid $branchwin.up.revA_rdate -column 3 -row 1 -sticky w grid $branchwin.up.revA_lwho -column 4 -row 1 -sticky w grid $branchwin.up.revA_rwho -column 5 -row 1 -sticky ew grid $branchwin.up.logA_lcomment -column 0 -row 2 -sticky nw grid $branchwin.up.logA_rlogfm -column 1 -row 2 -columnspan 7 -sticky ew pack $branchwin.up.logA_rlogfm.yscroll -side right -fill y pack $branchwin.up.logA_rlogfm.rcomment -side left -fill x -expand y grid $branchwin.up.revB_lvers -column 0 -row 3 -sticky w grid $branchwin.up.revB_rvers -column 1 -row 3 -sticky w grid $branchwin.up.revB_ldate -column 2 -row 3 -sticky w grid $branchwin.up.revB_rdate -column 3 -row 3 -sticky w grid $branchwin.up.revB_lwho -column 4 -row 3 -sticky w grid $branchwin.up.revB_rwho -column 5 -row 3 -sticky ew grid $branchwin.up.logB_lcomment -column 0 -row 4 -sticky nw grid $branchwin.up.logB_rlogfm -column 1 -row 4 -columnspan 7 -sticky ew pack $branchwin.up.logB_rlogfm.yscroll -side right -fill y pack $branchwin.up.logB_rlogfm.rcomment -side left -fill x -expand y # Pack the bottom before the middle so it doesnt disappear if # the window is resized smaller frame $branchwin.down -relief groove -borderwidth 2 pack $branchwin.down -side bottom -fill x frame $branchwin.down.search -relief sunk -bd 2 button $branchwin.down.search.b -text "Search" -command [namespace code {Search}] entry $branchwin.down.search.e bind $branchwin.down.search.e [namespace code {Search}] label $branchwin.down.search.l -anchor e -width 10 -text "" ttk::checkbutton $branchwin.down.search.c -text "Ignore case" \ -variable [namespace current]::search_nocase pack $branchwin.down.search -side top -fill x pack $branchwin.down.search.b -side left pack $branchwin.down.search.e -side left pack $branchwin.down.search.c -side left -padx 4 pack $branchwin.down.search.l -side left # The canvas for the big picture canvas $branchwin.canvas -relief sunken -borderwidth 2 \ -height 300 -bg $colorglb(canvbg) \ -yscrollcommand [namespace code "$branchwin.yscroll set"] \ -xscrollcommand [namespace code "$branchwin.xscroll set"] ttk::scrollbar $branchwin.xscroll -orient horizontal \ -command [namespace code "$branchwin.canvas xview"] ttk::scrollbar $branchwin.yscroll \ -command [namespace code "$branchwin.canvas yview"] # # Create buttons # frame $branchwin.down.btnfm frame $branchwin.down.closefm button $branchwin.refresh -image Refresh \ -command [namespace code { $scope\::reloadLog }] button $branchwin.view -image Fileview button $branchwin.log -image Log button $branchwin.annotate -image Annotate button $branchwin.diff -image Diff button $branchwin.patchdiff -image Patches button $branchwin.ddiff -image Difflines button $branchwin.merge -image Mergediff button $branchwin.viewtags -image Tags \ -command [namespace code { variable revtags variable revbtags set taglist "" foreach r [lsort -dictionary \ [concat [array names revtags] [array names revbtags]]] { if {[info exists revtags($r)]} { append taglist "$r: $revtags($r)\n" } elseif {[info exists revbtags($r)]} { append taglist "$r: $revbtags($r)\n" } } view_output::new Tags $taglist }] button $branchwin.close -text "Close" \ -command [namespace code { global cvscfg variable my_idx set cvscfg(loggeom) [wm geometry $branchwin] destroy $branchwin catch {namespace delete ::cvs_branchlog::$my_idx} catch {namespace delete ::svn_branchlog::$my_idx} namespace delete [namespace current] exit_cleanup 0 }] button $branchwin.stop -text "Stop" -bg red4 -fg white \ -activebackground red4 -activeforeground white \ -state [expr {$cvscfg(allow_abort) ? {normal} : {disabled}}] \ -command "$scope\::abortLog" pack $branchwin.refresh \ -in $branchwin.down -side left \ -ipadx 4 -ipady 4 pack $branchwin.down.btnfm -side left -fill y -expand 1 pack $branchwin.view \ $branchwin.log \ $branchwin.annotate \ $branchwin.diff \ -in $branchwin.down.btnfm -side left \ -ipadx 4 -ipady 4 if {$in_svn || $in_git} { pack $branchwin.patchdiff \ $branchwin.ddiff \ -in $branchwin.down.btnfm -side left \ -ipadx 4 -ipady 4 } pack $branchwin.merge \ $branchwin.viewtags \ -in $branchwin.down.btnfm -side left \ -ipadx 4 -ipady 4 pack $branchwin.down.closefm -side right -expand yes -fill x pack $branchwin.close \ -in $branchwin.down.closefm -side right -padx 15 set_tooltips $branchwin.refresh \ {"Re-read the log information"} set_tooltips $branchwin.up.bworkdir \ {"Open the Working Directory Browser"} set_tooltips $branchwin.up.bmodbrowse \ {"Open the Repository Browser"} set_tooltips $branchwin.view \ {"View a version of the file"} set_tooltips $branchwin.log \ {"Revision log of the file"} set_tooltips $branchwin.annotate \ {"View revision where each line was modified"} set_tooltips $branchwin.diff \ {"Side-by-side comparison of two versions of the file"} set_tooltips $branchwin.merge \ {"Merge to current"} set_tooltips $branchwin.viewtags \ {"List all the file\'s tags"} set_tooltips $branchwin.patchdiff \ {"Show file changes in a commit"} set_tooltips $branchwin.ddiff \ {"List changed files in a commit"} # # Put the canvas on to the display. # pack $branchwin.xscroll -side bottom -fill x -padx 1 -pady 1 pack $branchwin.yscroll -side right -fill y -padx 1 -pady 1 pack $branchwin.canvas -fill both -expand 1 scrollbindings $branchwin.canvas # # Window manager stuff. # wm minsize $branchwin 1 1 if {[info exists cvscfg(loggeom)]} { wm geometry $branchwin $cvscfg(loggeom) } $branchwin.canvas bind active \ "$branchwin.canvas config -cursor hand2" $branchwin.canvas bind active \ "$branchwin.canvas config -cursor {}" $branchwin.canvas bind tag \ [namespace code "PopupTags %x %y"] $branchwin.canvas bind selectable \ [namespace code "RevSelect A"] # Tcl/TK for Windows doesn't do Button 3, so we duplicate it on Button 2 $branchwin.canvas bind selectable \ [namespace code "RevSelect B"] $branchwin.canvas bind selectable \ [namespace code "RevSelect B"] # Clicking in a blank part of the canvas unselects boxes bind $branchwin.canvas \ [namespace code "Unselect A"] bind $branchwin.canvas \ [namespace code "Unselect B"] bind $branchwin.canvas \ [namespace code "Unselect B"] focus $branchwin.canvas # FIXME: Why isn't there a bbox when we get here? # Then the yview moveto doesn't work, although it does in tkinter $branchwin.canvas xview moveto 0 $branchwin.canvas yview moveto 0 return [list [namespace current] $branchwin] } } } tkrev_9.6.1/tkrev/dialog.tcl0000664000175000017500000017541115024334743016370 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # Smallish dialogs - add, tag # # Creates the widgets for the dynamic forms called from the module browser proc dialog_FormCreate { title form_data } { global colorglb global dynamic_dialog global dialog_action set font_star $colorglb(dialogfont) set font_normal $colorglb(listboxfont) set font_bold $colorglb(dialogfont) set font_italic [font create -family Helvetica -size -12 -slant italic] if {[winfo exists .dynamic_dialog]} { destroy .dynamic_dialog } set w .dynamic_dialog toplevel $w wm attributes $w -topmost 1 frame $w.form pack $w.form -side top -fill set row 0 foreach {field req type labeltext data} $form_data { # If you wanted another default, set it in the calling function if {! [info exists dynamic_dialog($field)]} { set dynamic_dialog($field) "" } if {$type == {l}} { # Section label frame $w.form.rule$field -relief groove -borderwidth 2 -height 4 label $w.form.l$field -font $font_bold -text $labeltext grid $w.form.rule$field -column 0 -row [incr row] -columnspan 3 -sticky ew grid $w.form.l$field -column 0 -row [incr row] -sticky w } else { # It's something else. It has a label and a req though. label $w.form.l$field -anchor w -text " $labeltext" label $w.form.r$field -anchor e -foreground red \ -font $font_star -text [expr {$req ? "*" : " "}] grid $w.form.l$field -column 0 -row [incr row] -sticky w grid $w.form.r$field -column 1 -row $row -sticky w if {$type == {t}} { # It's an entry entry $w.form.e$field -width 65 \ -textvariable dynamic_dialog($field) grid $w.form.e$field -column 2 -row $row -sticky w } elseif {$type == {r}} { # It's a radiobutton frame $w.form.f$field set k 1 foreach {text value} $data { ttk::radiobutton $w.form.f$field$k -text $text -value $value \ -variable dynamic_dialog($field) pack $w.form.f$field$k -in $w.form.f$field -side left -padx 4 incr k } grid $w.form.f$field -column 2 -row $row -sticky ew } } } incr row label $w.form.xstar -anchor e -foreground red \ -font $font_italic -text "* = required field" grid $w.form.xstar -column 1 -columnspan 2 -row $row -sticky w frame $w.buttons -relief groove -bd 2 pack $w.buttons -side top -fill x button $w.ok -text "OK" \ -command " if {\[dialog_FormComplete $w [list $form_data]\] } { destroy $w $dialog_action exit_cleanup 0 } " button $w.apply -text "Apply" \ -command " if {\[dialog_FormComplete $w [list $form_data]\] } { $dialog_action } " button $w.close -text "Cancel" \ -command " destroy $w exit_cleanup 0 " pack $w.close $w.apply $w.ok -in $w.buttons -side right \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title $w $title dialog_position $w .modbrowse wm minsize $w 1 1 return } proc dialog_FormComplete { w form_data } { global dynamic_dialog gen_log:log T "ENTER ($w ...)" foreach a [array names dynamic_dialog] { gen_log:log D "$a $dynamic_dialog($a)" } set section "" foreach {field req type labeltext data} $form_data { if {$type == {l}} { set section $dynamic_dialog($field) } else { if {$req && [set dynamic_dialog($field)] == {}} { cvsok "$field may not be blank" $w.form return 0 } } } return 1 } # Check out a CVS module from the module browser proc dialog_cvs_checkout { cvsroot module {revtag {} } } { global dynamic_dialog global dialog_action gen_log:log T "ENTER ($cvsroot $module $revtag)" # Remember tags from last time if {$revtag == {} && [info exists dynamic_dialog(revtag)]} { set revtag $dynamic_dialog(revtag) } set dir [pwd] set dynamic_dialog(cvsroot) $cvsroot set dynamic_dialog(module) $module set dynamic_dialog(revtag) $revtag set dynamic_dialog(prune) {-P} set dynamic_dialog(kflag) "" # field req type labeltext data set dialog_form_checkout { 1 0 l {CVS Repository} 1 cvsroot 1 t {CVSROOT} {} 2 0 l {Module} 1 module 1 t {Name/Path} {} revtag 0 t {Revision/Tag} {} date 0 t {Date} {} 3 0 l {Destination} 1 target 1 t {Target Directory} {} 4 0 l {Merge } 0 mtag1 0 t {Old tag} {} mtag2 0 t {New tag} {} 5 0 l {Advanced} 0 prune 0 r {Empty Directories} {{Create} {} {Don't Create} {-P}} kflag 0 r {Keyword Expansion} {{Default} {} {Keep as-is} {-ko} {Treat files as binary} {-kb} {Keywords only} {-kk}} } # Action function set dialog_action {cvs_checkout \ $dynamic_dialog(cvsroot) \ $dynamic_dialog(prune) $dynamic_dialog(kflag) \ $dynamic_dialog(revtag) $dynamic_dialog(date) $dynamic_dialog(target) \ $dynamic_dialog(mtag1) $dynamic_dialog(mtag2) $dynamic_dialog(module) } set form [dialog_FormCreate "Checkout Module" $dialog_form_checkout] gen_log:log T "LEAVE" } # Export a CVS module from the module browser proc dialog_cvs_export { cvsroot module {revtag {}} } { global dynamic_dialog global dialog_action gen_log:log T "ENTER ($cvsroot $module $revtag)" # Remember tags from last time if {$revtag == {} && [info exists dynamic_dialog(revtag)]} { set revtag $dynamic_dialog(revtag) } set dir [pwd] set dynamic_dialog(cvsroot) $cvsroot set dynamic_dialog(module) $module set dynamic_dialog(revtag) $revtag # field req type labeltext data set dialog_form_export { 1 0 l {CVS Repository} 1 cvsroot 1 t {CVSROOT} {} 2 0 l {Module} 1 module 1 t {Name/Path} {} revtag 0 t {Revision/Tag} {} date 0 t {Date} {} 3 0 l {Destination} 1 target 1 t {Target Directory} {} 4 0 l {Advanced} 0 kflag 0 r {Keyword Expansion} {{Default} {} {Keep as-is} {-ko} {Treat files as binary} {-kb} {Keywords only} {-kk}} } # Action function set dialog_action {cvs_export \ $dynamic_dialog(cvsroot) $dynamic_dialog(kflag) \ $dynamic_dialog(revtag) $dynamic_dialog(date) \ $dynamic_dialog(target) $dynamic_dialog(module) } set form [dialog_FormCreate "Export Module" $dialog_form_export] gen_log:log T "LEAVE" } # Checkout or Export a SVN module from the module browser proc dialog_svn_checkout { svnroot path command } { global dynamic_dialog global dialog_action if {[info exists dynamic_dialog(rev)]} { set rev $dynamic_dialog(rev) } set dir [pwd] set dynamic_dialog(path) $path set dynamic_dialog(svnroot) $svnroot set dynamic_dialog(command) $command # field req type labeltext data set dialog_form_export { 1 0 l {SVN Repository} 1 svnroot 1 t {SVN URL} {} path 1 t {Path in Repository} {} rev 0 t {Revision/Date} {} 2 0 l {Destination} 1 target 1 t {Target Directory} {} 3 0 l {Working Copy or Unversioned Copy} {} command 0 r {Versioning} {{Versioned (Checkout)} {checkout} {Un-Versioned (Export)} {export}} } # Action function set dialog_action {svn_checkout \ $dynamic_dialog(svnroot) $dynamic_dialog(path) \ $dynamic_dialog(rev) $dynamic_dialog(target) \ $dynamic_dialog(command) } set form [dialog_FormCreate "Checkout or Export" $dialog_form_export] gen_log:log T "LEAVE" } # Clone a Git branch from the module browser proc dialog_git_clone { gitroot path } { global dynamic_dialog global dialog_action if {[info exists dynamic_dialog(rev)]} { set rev $dynamic_dialog(rev) } set dir [pwd] set dynamic_dialog(path) $path set dynamic_dialog(gitroot) $gitroot # field req type labeltext data set dialog_form_clone { 1 0 l {Git Repository} 1 gitroot 1 t {Git URL} {} path 0 t {Branch} {} 2 0 l {Destination} 1 target 1 t {Target Directory} {} } # Action function set dialog_action {git_clone \ $dynamic_dialog(gitroot) $dynamic_dialog(path) \ $dynamic_dialog(target) } set form [dialog_FormCreate "Clone" $dialog_form_clone] gen_log:log T "LEAVE" } # Make a branch or tag (svn copy) from the module browser proc dialog_svn_tag { svnroot path b_or_t } { global dynamic_dialog global dialog_action set dynamic_dialog(path) $path set dynamic_dialog(svnroot) $svnroot set dynamic_dialog(b_or_t) $b_or_t set dynamic_dialog(frompath) "$dynamic_dialog(svnroot)/$dynamic_dialog(path)" # field req type labeltext data set dialog_form_tagcopy { 1 0 l {Copy Path to Tag or Branch} 1 frompath 1 t {Copy From} {} b_or_t 0 r {Tag or Branch} {{Branch} {branches} {Tag} {tags}} target 1 t {New Branch/Tag} {} } # Action function set dialog_action {svn_rcopy $dynamic_dialog(svnroot)/$dynamic_dialog(path) \ $dynamic_dialog(b_or_t) $dynamic_dialog(target) } set form [dialog_FormCreate "SVN Branch or Tag Copy" $dialog_form_tagcopy] gen_log:log T "LEAVE" } # Compare two revisions of a module, from the module browser # Can make a patch file or send a summary to the screen proc dialog_cvs_patch { cvsroot module summary {revtagA {}} {revtagB {}} } { global dynamic_dialog global dialog_action gen_log:log T "ENTER ( $cvsroot $module $summary $revtagA $revtagB )" # Remember tags if {$revtagA == {} && [info exists dynamic_dialog(revtagA)]} { set revtagA $dynamic_dialog(revtagA) } if {$revtagB == {} && [info exists dynamic_dialog(revtagB)]} { set revtagB $dynamic_dialog(revtagB) } set dynamic_dialog(cvsroot) $cvsroot set dynamic_dialog(module) $module set dynamic_dialog(revtagA) $revtagA set dynamic_dialog(revtagB) $revtagB set dynamic_dialog(outfile) "$module.patch" if {$summary} { set dynamic_dialog(outmode) 0 set dynamic_dialog(difffmt) {-s} } else { set dynamic_dialog(outmode) 1 set dynamic_dialog(difffmt) "" } # field req type labeltext data set dialog_form_patch { 1 0 l {CVS Repository} 1 cvsroot 1 t {CVSROOT} {} 2 0 l {Module} 1 module 1 t {Name/Path} {} 3 0 l {Destination} 1 outmode 0 r {Output Mode} {{To Screen} 0 {To File} 1} outfile 0 t {Output File} {outfile} 4 0 l {Old Revision} 1 revtagA 0 t {Revision/Tag} {} dateA 0 t {Date} {} 5 0 l {New Revision} 1 revtagB 0 t {Revision/Tag} {} dateB 0 t {Date} {} 6 0 l {Format} 1 difffmt 0 r {Diff Format} {{Default} {} {Context diff} {-c} {Unidiff} {-u} {One liner} {-s}} } # Action function set dialog_action {cvs_patch $dynamic_dialog(cvsroot) \ $dynamic_dialog(module) $dynamic_dialog(difffmt) \ $dynamic_dialog(revtagA) $dynamic_dialog(dateA) \ $dynamic_dialog(revtagB) $dynamic_dialog(dateB) \ $dynamic_dialog(outmode) $dynamic_dialog(outfile) } set form [dialog_FormCreate "Diff/Patch Module" $dialog_form_patch] gen_log:log T "LEAVE" } # Compare two revisions, from the module browser # Can make a patch file or send a summary to the screen proc dialog_svn_patch { svn_url {pathA {}} {pathB {}} {summary {}} } { global dynamic_dialog global dialog_action gen_log:log T "ENTER ( $svn_url $pathA $pathB $summary )" set dynamic_dialog(svn_url) $svn_url set dynamic_dialog(pathA) $pathA set dynamic_dialog(pathB) $pathB if {$summary} { set dynamic_dialog(outmode) 0 } else { set dynamic_dialog(outmode) 1 } set dynamic_dialog(outfile) "patchfile.patch" set dynamic_dialog(fullA) "$svn_url$pathA" if {$pathB == ""} { set dynamic_dialog(fullB) "" } else { set dynamic_dialog(fullB) "$svn_url$pathB" } # field req type labeltext data set dialog_form_patch { 1 0 l {Repository Paths} 1 pathA 1 t {Path A} {} pathB 0 t {Path B} {} 3 0 l {Destination} 1 outmode 0 r {Output Mode} {{To Screen} 0 {To File} 1} outfile 0 t {Output File} {outfile} 4 0 l {Old Revision} 1 revA 0 t {Revision} {} dateA 0 t {Date} {} 5 0 l {New Revision} 1 revB 0 t {Revision} {} dateB 0 t {Date} {} } # Action function set dialog_action { # Make new fullA and fullB from the pathA and pathB entries set dynamic_dialog(fullA) "$dynamic_dialog(svn_url)/$dynamic_dialog(pathA)" if {$dynamic_dialog(pathB) == ""} { set dynamic_dialog(fullB) "" } else { set dynamic_dialog(fullB) "$dynamic_dialog(svn_url)/$dynamic_dialog(pathB)" } svn_patch $dynamic_dialog(fullA) \ $dynamic_dialog(fullB) \ $dynamic_dialog(revA) $dynamic_dialog(dateA) \ $dynamic_dialog(revB) $dynamic_dialog(dateB) \ $dynamic_dialog(outmode) $dynamic_dialog(outfile) } set form [dialog_FormCreate "SVN Diff/Patch" $dialog_form_patch] gen_log:log T "LEAVE" } # Tag a module. CVS only. Called from the module browser. proc rtag_dialog { cvsroot module b_or_t } { gen_log:log T "ENTER ($cvsroot $module $b_or_t)" toplevel .modtag wm attributes .modtag -topmost 1 grab set .modtag frame .modtag.top pack .modtag.top -side top -fill x message .modtag.top.lbl -aspect 300 -relief groove \ -text "Tag the module \"$module\" with the new tag you specify.\ If you fill in \"Existing Tag\", the revisions having that tag will get\ the new tag. Otherwise, the head revision will be tagged." label .modtag.top.olbl -text "Existing Tag" -anchor w entry .modtag.top.oentry -textvariable otag \ -relief sunken label .modtag.top.nlbl -text "New Tag" -anchor w entry .modtag.top.nentry -textvariable ntag \ -relief sunken ttk::checkbutton .modtag.top.branch -text "Branch tag (-b)" \ -variable b_or_t -onvalue "branch" -offvalue "tag" ttk::checkbutton .modtag.top.force -text "Move existing (-F)" \ -variable force -onvalue "yes" -offvalue "no" grid columnconf .modtag.top 1 -weight 1 grid rowconf .modtag.top 4 -weight 1 grid .modtag.top.lbl -column 0 -row 0 -columnspan 2 -pady 2 -sticky ew grid .modtag.top.olbl -column 0 -row 1 -sticky nw grid .modtag.top.oentry -column 1 -row 1 grid .modtag.top.nlbl -column 0 -row 2 -sticky nw grid .modtag.top.nentry -column 1 -row 2 grid .modtag.top.branch -column 1 -row 3 -padx 4 -sticky w grid .modtag.top.force -column 1 -row 4 -padx 4 -sticky w frame .modtag.down -relief groove -bd 2 pack .modtag.down -side top -fill x button .modtag.down.tag -text "Tag" \ -command " cvs_rtag $cvsroot $module $b_or_t \$force \$otag \$ntag; \ .modtag.down.cancel invoke " button .modtag.down.delete -text "Remove" \ -command " cvs_rtag $cvsroot $module tag remove \$otag \$ntag; \ .modtag.down.cancel invoke " button .modtag.down.cancel -text "Cancel" \ -command { grab release .modtag destroy .modtag } pack .modtag.down.tag .modtag.down.delete .modtag.down.cancel -in .modtag.down -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 bind .modtag.top.nentry \ { .modtag.down.tag invoke } wm title .modtag "Tag Module" dialog_position .modtag .modbrowse wm minsize .modtag 1 1 gen_log:log T "LEAVE" } # Add files to the VCS. Called from workdir browser proc add_dialog {args} { global cvs global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" set binflag "" toplevel .add wm attributes .add -topmost 1 grab set .add set filelist [join $args] if {$filelist == ""} { set mess "This will add all new files" } else { set mess "This will add these files:\n\n" foreach file $filelist { append mess " $file\n" } } message .add.top -justify left -aspect 300 -relief groove \ -text "Add a file or files to the module. The repository\ will not be changed until you do a commit." pack .add.top -side top -fill x message .add.middle -text $mess -aspect 200 pack .add.middle -side top -fill x frame .add.down button .add.down.add -text "Add" if {$incvs} { .add.down.add configure -command { grab release .add destroy .add if {![info exists binflag]} {set binflag ""} cvs_add $binflag [workdir_list_files] } ttk::checkbutton .add.binary -text "-kb (binary)" \ -variable binflag -onvalue "-kb" -offvalue "" pack .add.binary -side top -padx 4 -fill x -expand 1 } elseif {$insvn} { .add.down.add configure -command { grab release .add destroy .add svn_add [workdir_list_files] } } elseif {$ingit} { .add.down.add configure -command { grab release .add destroy .add git_add [workdir_list_files] } } button .add.down.cancel -text "Cancel" \ -command { grab release .add; destroy .add } pack .add.down -side bottom -fill x -expand 1 pack .add.down.add .add.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .add "Add Files" dialog_position .add .workdir wm minsize .add 1 1 gen_log:log T "LEAVE" } # Tag file(s) or directory. Called from the workdir browser. proc tag_dialog {} { global incvs insvn inrcs ingit global tagcomment global forceflag gen_log:log T "ENTER" toplevel .tag wm attributes .tag -topmost 1 frame .tag.top set msg "" pack .tag.top -side top -fill x if {$incvs || $ingit} { set msg "Apply a new tag to the marked files\ or to the directory, recursively" } elseif {$insvn} { set msg "Create a new tag copy of the marked files\ or of the directory, recursively.\n\ \nAdvice: Update local directory to HEAD first." } elseif {$inrcs} { set msg "Apply a new tag to the marked files\ or the directory" } if {! [info exists forceflag]} { set forceflag "no" } if {! [info exists tagcomment]} { set tagcomment "tag copy by TkRev" } message .tag.top.msg -justify left -aspect 300 -relief groove \ -text $msg label .tag.top.lbl -text "Tag Name" -anchor w entry .tag.top.entry -relief sunken -textvariable tagname ttk::checkbutton .tag.top.force -text "Move existing tag" \ -variable forceflag -onvalue "yes" -offvalue "no" ttk::checkbutton .tag.top.annotate -text "Annotate" \ -variable annotateflag -onvalue "yes" -offvalue "no" \ -command {toggle_state .tag.top.comentry} label .tag.top.comlbl -text "Comment" -anchor w entry .tag.top.comentry -relief sunken -textvariable tagcomment grid columnconf .tag.top 1 -weight 1 grid rowconf .tag.top 3 -weight 1 grid .tag.top.msg -column 0 -row 0 -columnspan 2 -pady 2 -sticky ew grid .tag.top.lbl -column 0 -row 1 -sticky nw grid .tag.top.entry -column 1 -row 1 -sticky ew if {$incvs || $inrcs} { # If in CVS, offer -f option (forceflag) grid .tag.top.force -column 1 -row 3 -padx 4 -sticky w } elseif {$insvn} { grid .tag.top.comlbl -column 0 -row 4 -sticky nw grid .tag.top.comentry -column 1 -row 4 -sticky ew .tag.top.comentry configure -state normal } elseif {$ingit} { # If in Git, offer -a option (annotateflag) and comment entry # Start with the comment disabled. Annotate button will toggle it .tag.top.comentry configure -state disabled grid .tag.top.annotate -column 1 -row 3 -padx 4 -sticky w grid .tag.top.comlbl -column 0 -row 4 -sticky nw grid .tag.top.comentry -column 1 -row 4 -sticky ew } frame .tag.down -relief groove -bd 2 pack .tag.down -side bottom -fill x -expand 1 button .tag.down.tag -text "Tag" button .tag.down.cancel -text "Cancel" \ -command { grab release .tag; destroy .tag } pack .tag.down.tag .tag.down.cancel -in .tag.down -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 if {$incvs} { .tag.down.tag configure -command { cvs_tag $tagname $forceflag "tag" no [workdir_list_files] grab release .tag; destroy .tag } } elseif {$insvn} { .tag.down.tag configure -command { svn_tag $tagname "tag" no "$tagcomment" [workdir_list_files] grab release .tag; destroy .tag } } elseif {$ingit} { .tag.down.tag configure -command { git_tag $tagname $annotateflag "$tagcomment" [workdir_list_files] grab release .tag; destroy .tag } } elseif {$inrcs} { .tag.down.tag configure -command { rcs_tag $tagname $forceflag [workdir_list_files] grab release .tag; destroy .tag } } wm title .tag "Tag" dialog_position .tag .workdir wm minsize .tag 1 1 gen_log:log T "LEAVE" } # Branch file(s) or directory. Called from the workdir browser. proc branch_dialog {} { global incvs insvn inrcs ingit global branchcomment gen_log:log T "ENTER" toplevel .branch wm attributes .branch -topmost 1 frame .branch.top set msg "" pack .branch.top -side top -fill x if {$incvs} { set msg "Apply a new branch tag to the marked files\ or to the directory, recursively" } elseif {$insvn} { set msg "Create a new branch copy of the marked files\ or of the directory, recursively.\n\ \nAdvice: Update local directory to HEAD first." } elseif {$ingit} { set msg "Branch the marked files or\ the directory, recursively" } if {! [info exists branchcomment]} { set branchcomment "branch\ copy\ by\ TkRev" } message .branch.top.msg -justify left -aspect 300 -relief groove \ -text $msg label .branch.top.lbl -text "Branch Name" -anchor w entry .branch.top.entry -relief sunken -textvariable branchname ttk::checkbutton .branch.top.upd -text "Update current directory to be on new branch" \ -variable updflag -onvalue "yes" -offvalue "no" label .branch.top.comlbl -text "Comment" -anchor w entry .branch.top.coment -relief sunken -textvariable branchcomment grid columnconf .branch.top 1 -weight 1 grid rowconf .branch.top 3 -weight 1 grid .branch.top.msg -column 0 -row 0 -columnspan 2 -pady 2 -sticky ew grid .branch.top.lbl -column 0 -row 1 -sticky nw grid .branch.top.entry -column 1 -row 1 -sticky ew if {$insvn} { grid .branch.top.comlbl -column 0 -row 2 -sticky nw grid .branch.top.coment -column 1 -row 2 -sticky ew } # Offer update option for all VCSs grid .branch.top.upd -column 0 -row 3 -padx 4 -sticky w -columnspan 2 # frame .branch.down -relief groove -bd 2 pack .branch.down -side bottom -fill x -expand 1 button .branch.down.branch -text "Branch" button .branch.down.cancel -text "Cancel" \ -command { grab release .branch; destroy .branch } pack .branch.down.branch .branch.down.cancel -in .branch.down -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 if {$incvs} { .branch.down.branch configure -command { cvs_tag $branchname "no" "branch" $updflag [workdir_list_files] grab release .branch; destroy .branch } } elseif {$insvn} { .branch.down.branch configure -command { svn_tag $branchname "branch" $updflag $branchcomment [workdir_list_files] grab release .branch; destroy .branch } } elseif {$ingit} { .branch.down.branch configure -command { git_branch $branchname $updflag grab release .branch; destroy .branch } } wm title .branch "Branch" dialog_position .branch .workdir wm minsize .branch 1 1 gen_log:log T "LEAVE" } # Remove from VCS. Called from workdir browser proc subtract_dialog {args} { global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some files to delete first!" .workdir return } foreach f $filelist { if {$incvs && [file isdirectory $f]} { cvsfail "$f is a directory. Try \"Remove Recursively\" instead" .workdir return } } toplevel .subtract wm attributes .subtract -topmost 1 grab set .subtract set mess "This will remove these files:\n\n" foreach file $filelist { append mess " $file\n" } message .subtract.top -justify left -aspect 300 -relief groove \ -text "Remove a file or files from the module. The repository\ will not be changed until you do a commit." pack .subtract.top -side top -fill x message .subtract.middle -text $mess -aspect 200 pack .subtract.middle -side top -fill x frame .subtract.down button .subtract.down.remove -text "Remove" if {$incvs} { .subtract.down.remove configure -command { grab release .subtract destroy .subtract cvs_remove_file [workdir_list_files] } } elseif {$insvn} { .subtract.down.remove configure -command { grab release .subtract destroy .subtract svn_remove_file [workdir_list_files] } } elseif {$ingit} { .subtract.down.remove configure -command { grab release .subtract destroy .subtract git_rm [workdir_list_files] } } button .subtract.down.cancel -text "Cancel" \ -command { grab release .subtract; destroy .subtract } pack .subtract.down -side bottom -fill x -expand 1 pack .subtract.down.remove .subtract.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .subtract "Remove Files" dialog_position .subtract .workdir wm minsize .subtract 1 1 gen_log:log T "LEAVE" } # Set the edit flag on CVS files. Called from the workdir browser. proc edit_dialog {args} { global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] gen_log:log D "filelist $filelist" if {$filelist == "." || $filelist == ""} { cvsfail "Please select some files to edit first!" .workdir return 1 } toplevel .editflag wm attributes .editflag -topmost 1 grab set .editflag set mess "This will set the edit flag on these files:\n\n" foreach file $filelist { append mess " $file\n" } message .editflag.top -justify left -aspect 300 -relief groove \ -text "Set the edit flag on a file or files from the module" pack .editflag.top -side top -fill x message .editflag.middle -text $mess -aspect 200 pack .editflag.middle -side top -fill x frame .editflag.down button .editflag.down.remove -text "Edit" \ -command { grab release .editflag destroy .editflag cvs_edit [workdir_list_files] } button .editflag.down.cancel -text "Cancel" \ -command { grab release .editflag; destroy .editflag } pack .editflag.down -side bottom -fill x -expand 1 pack .editflag.down.remove .editflag.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .editflag "Edit Files" dialog_position .editflag .workdir wm minsize .editflag 1 1 gen_log:log T "LEAVE" return 0 } # Unset the edit flag on CVS files. Called from the workdir browser. proc unedit_dialog {args} { global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } if {$args == "." || [llength $args] == 0} { cvsfail "Please select some files to unedit first!" .workdir return 1 } toplevel .uneditflag wm attributes .uneditflag -topmost 1 grab set .uneditflag set filelist [join $args] set mess "This will reset the edit flag on these files:\n\n" foreach file $filelist { append mess " $file\n" } message .uneditflag.top -justify left -aspect 300 -relief groove \ -text "Reset the edit flag on a file or files from the module." pack .uneditflag.top -side top -fill x message .uneditflag.middle -text $mess -aspect 200 pack .uneditflag.middle -side top -fill x frame .uneditflag.down button .uneditflag.down.remove -text "Unedit" \ -command { grab release .uneditflag destroy .uneditflag cvs_unedit [workdir_list_files] } button .uneditflag.down.cancel -text "Cancel" \ -command { grab release .uneditflag; destroy .uneditflag } pack .uneditflag.down -side bottom -fill x -expand 1 pack .uneditflag.down.remove .uneditflag.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .uneditflag "Unedit Files" dialog_position .uneditflag .workdir wm minsize .uneditflag 1 1 gen_log:log T "LEAVE" } # CVS update with options. Called from workdir browser proc cvs_update_options {} { global cvsglb global colorglb global current_tagname gen_log:log T "ENTER" if {[winfo exists .cvs_update]} { wm deiconify .cvs_update raise .cvs_update gen_log:log T "LEAVE" return } # Set defaults if {! [info exists cvsglb(tagmode_selection)]} { update_set_defaults } toplevel .cvs_update wm attributes .cvs_update -topmost 1 grab set .cvs_update frame .cvs_update.explaintop # Provide an explanation of this dialog box message .cvs_update.explaintop.explain -justify left -aspect 500 -relief groove \ -text "Update all files in local directory" frame .cvs_update.options frame .cvs_update.options.whichrev -relief groove -borderwidth 2 frame .cvs_update.options.diropts -relief groove -borderwidth 2 frame .cvs_update.options.normbin -relief groove -borderwidth 2 frame .cvs_update.down # Always pack OK/Cancel first so they don't disappear pack .cvs_update.down -side bottom -fill x pack .cvs_update.explaintop -side top -fill x -pady 1 pack .cvs_update.explaintop.explain -side top -fill x -pady 1 pack .cvs_update.options -side top -fill x -pady 1 pack .cvs_update.options.whichrev -side top -fill x pack .cvs_update.options.diropts -side top -fill x pack .cvs_update.options.normbin -side top -fill x # keep-same-tag update ttk::radiobutton .cvs_update.options.whichrev.keep \ -text "Keep same branch or trunk" \ -variable cvsglb(tagmode_selection) -value "Keep" \ -command {.cvs_update.options.whichrev.getrev.lblentry.tname configure -state disabled .cvs_update.options.whichrev.getrev.lblentry.dirtag configure -state disabled} # update to the head revision ttk::radiobutton .cvs_update.options.whichrev.trunk \ -text "Update local files to be on main trunk (-A)" \ -variable cvsglb(tagmode_selection) -value "Trunk" \ -command {.cvs_update.options.whichrev.getrev.lblentry.tname configure -state disabled .cvs_update.options.whichrev.getrev.lblentry.dirtag configure -state disabled} # update to different branch/tag or not ttk::radiobutton .cvs_update.options.whichrev.tag \ -text "Update (-r) local files to be on tag/branch" \ -variable cvsglb(tagmode_selection) -value "Getrev" \ -command {.cvs_update.options.whichrev.getrev.lblentry.tname configure -state normal .cvs_update.options.whichrev.getrev.lblentry.dirtag configure -state normal} message .cvs_update.options.whichrev.explainkeep -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "If local directory is on main trunk, get latest on main trunk. If local directory is on a branch, get latest on that branch. If local directory/file has \"sticky\" non-branch tag, no update." message .cvs_update.options.whichrev.explaintrunk -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "Advice: If your local directories are currently on a branch, you may want to commit any local changes to that branch first." pack .cvs_update.options.whichrev.keep -side top -padx 4 -fill x pack .cvs_update.options.whichrev.explainkeep \ -side top -fill x -pady 1 -ipady 0 pack .cvs_update.options.whichrev.trunk -side top -padx 4 -fill x pack .cvs_update.options.whichrev.explaintrunk \ -side top -fill x -pady 1 -ipady 0 pack .cvs_update.options.whichrev.tag -side top -padx 4 -fill x frame .cvs_update.options.whichrev.getrev frame .cvs_update.options.whichrev.getrev.lblentry label .cvs_update.options.whichrev.getrev.lblentry.tlbl -text "Tag Name" -anchor w entry .cvs_update.options.whichrev.getrev.lblentry.tname -relief sunken \ -textvariable cvsglb(updatename) button .cvs_update.options.whichrev.getrev.lblentry.dirtag -text "$current_tagname" \ -command { set cvsglb(updatename) $current_tagname } message .cvs_update.options.whichrev.getrev.explaintag -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "Advice: Update local files to main trunk (head) first. Note: The tag will be 'sticky' for the directory and for each file." pack .cvs_update.options.whichrev.getrev -side top -expand 1 -fill x pack .cvs_update.options.whichrev.getrev.lblentry -side top -expand 1 -fill x pack .cvs_update.options.whichrev.getrev.lblentry.tlbl -side left pack .cvs_update.options.whichrev.getrev.lblentry.tname -side left -fill x -padx 2 -pady 4 pack .cvs_update.options.whichrev.getrev.lblentry.dirtag -side left -fill x -padx 2 -pady 4 pack .cvs_update.options.whichrev.getrev.explaintag \ -side top -fill x -pady 1 -ipady 0 # Where user chooses the action to take if tag is not on a file label .cvs_update.options.whichrev.getrev.asknotfound \ -text "If file doesn't exist on this branch/tag:" -anchor w frame .cvs_update.options.whichrev.getrev.notfound ttk::radiobutton .cvs_update.options.whichrev.getrev.notfound.remove \ -text "Remove file from local directory" \ -variable cvsglb(action_notag) -value "Remove" ttk::radiobutton .cvs_update.options.whichrev.getrev.notfound.gethead \ -text "Get head revision (-f)" \ -variable cvsglb(action_notag) -value "Get_head" pack .cvs_update.options.whichrev.getrev.asknotfound -side top -fill x pack .cvs_update.options.whichrev.getrev.notfound -side top -expand 1 -fill x pack .cvs_update.options.whichrev.getrev.notfound.remove -side left -padx 4 pack .cvs_update.options.whichrev.getrev.notfound.gethead -side left -padx 4 # Recurse or not. frame .cvs_update.options.diropts.radio1 ttk::radiobutton .cvs_update.options.diropts.radio1.recurse \ -text "Recurse the subdirectories" \ -variable cvsglb(update_recurse) -value "recurse" \ -command { .cvs_update.options.diropts.getdir configure -state normal .cvs_update.options.diropts.prune configure -state normal .cvs_update.options.diropts.lblentry.tdir configure -state normal } ttk::radiobutton .cvs_update.options.diropts.radio1.local -text "This directory only (-l)" \ -variable cvsglb(update_recurse) -value "local" \ -command { .cvs_update.options.diropts.getdir configure -state disabled .cvs_update.options.diropts.prune configure -state disabled .cvs_update.options.diropts.lblentry.tdir configure -state disabled } pack .cvs_update.options.diropts.radio1 -side top -expand 1 -fill x pack .cvs_update.options.diropts.radio1.recurse -side left -padx 4 pack .cvs_update.options.diropts.radio1.local -side left -padx 4 label .cvs_update.options.diropts.prunelbl \ -text "\nIf directory is here but no longer in repository:" -anchor w ttk::checkbutton .cvs_update.options.diropts.prune -text "Prune it (-P)" \ -variable cvsglb(update_prune) -onvalue "prune" -offvalue "no-prune" # Where user chooses whether to pick up directories not currently in local label .cvs_update.options.diropts.getlbl \ -text "If directory is in repository but not in local:" -anchor w ttk::checkbutton .cvs_update.options.diropts.getdir -text "Get it (-d)" \ -variable cvsglb(get_all_dirs) -onvalue "Yes" -offvalue "No" \ -command { if {$cvsglb(get_all_dirs) != "Yes"} { .cvs_update.options.diropts.lblentry.tdir configure -state disabled } else { .cvs_update.options.diropts.lblentry.tdir configure -state normal } } frame .cvs_update.options.diropts.lblentry label .cvs_update.options.diropts.lblentry.tlbl -text "Specific directory (optional)" -anchor w entry .cvs_update.options.diropts.lblentry.tdir -relief sunken -state disabled \ -textvariable cvsglb(getdirname) # State of top radiobuttons (keep same, main, or tag) if {$cvsglb(tagmode_selection) != "Getrev"} { .cvs_update.options.whichrev.getrev.lblentry.tname configure -state disabled .cvs_update.options.whichrev.getrev.lblentry.dirtag configure -state disabled } # state of -l radiobuttons if {$cvsglb(update_recurse) != "recurse"} { .cvs_update.options.diropts.getdir configure -state disabled .cvs_update.options.diropts.prune configure -state disabled .cvs_update.options.diropts.lblentry.tdir configure -state disabled } # State of -d checkbutton if {$cvsglb(get_all_dirs) != "Yes"} { .cvs_update.options.diropts.lblentry.tdir configure -state disabled } pack .cvs_update.options.diropts.prunelbl -side top -expand 1 -fill x pack .cvs_update.options.diropts.prune -side top -padx 4 -expand 1 -fill x pack .cvs_update.options.diropts.getlbl -side top -expand 1 -fill x pack .cvs_update.options.diropts.getdir -side top -padx 4 -expand 1 -fill x pack .cvs_update.options.diropts.lblentry -side top -expand 1 -fill x pack .cvs_update.options.diropts.lblentry.tlbl -side left pack .cvs_update.options.diropts.lblentry.tdir -side left -fill x -padx 2 -pady 4 # normal or binary? label .cvs_update.options.normbin.lnormbin -text "Treat files as:" -anchor w frame .cvs_update.options.normbin.radio ttk::radiobutton .cvs_update.options.normbin.radio.normalfile -text "Normal file" \ -variable cvsglb(norm_bin) -value "Normal" ttk::radiobutton .cvs_update.options.normbin.radio.binaryfile -text "Binary file (-kb)" \ -variable cvsglb(norm_bin) -value "Binary" pack .cvs_update.options.normbin.lnormbin -side top -fill both pack .cvs_update.options.normbin.radio -side top -expand 1 -fill x pack .cvs_update.options.normbin.radio.normalfile -side left -padx 4 pack .cvs_update.options.normbin.radio.binaryfile -side left -padx 4 # The OK/Cancel buttons button .cvs_update.ok -text "OK" \ -command { grab release .cvs_update; wm withdraw .cvs_update; cvs_opt_update } button .cvs_update.apply -text "Apply" \ -command cvs_opt_update button .cvs_update.reset -text "Reset defaults" \ -command update_set_defaults button .cvs_update.quit -text "Close" \ -command { grab release .cvs_update; wm withdraw .cvs_update } pack .cvs_update.ok .cvs_update.apply .cvs_update.reset .cvs_update.quit -in .cvs_update.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Window Manager stuff wm title .cvs_update "Update a Module" wm minsize .cvs_update 1 1 dialog_position .cvs_update .workdir gen_log:log T "LEAVE" } # Set defaults for "Update with Options" dialog proc update_set_defaults {} { global cvsglb set cvsglb(tagmode_selection) "Keep" set cvsglb(updatename) "" set cvsglb(update_recurse) "recurse" set cvsglb(action_notag) "Remove" set cvsglb(update_prune) "prune" set cvsglb(get_all_dirs) "No" set cvsglb(getdirname) "" set cvsglb(norm_bin) "Normal" } # Recursively add directories. Called from workdir browser. proc addir_dialog {args} { global cvs global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set binflag "" toplevel .add wm attributes .add -topmost 1 grab set .add set filelist [join $args] if {$filelist == ""} { set mess "This will add all new directories" } else { set mess "This will add these directories:\n\n" foreach file $filelist { append mess " $file\n" } } message .add.top -justify left -aspect 300 -relief groove \ -text "Add (recursively) a directory to the module.\ The repository will not be changed until you do a commit." pack .add.top -side top -fill x message .add.middle -text $mess -aspect 200 pack .add.middle -side top -fill x ttk::checkbutton .add.binary -text "-kb (binary)" \ -variable binflag -onvalue "-kb" -offvalue "" pack .add.binary -side top -padx 4 -expand 1 -fill x frame .add.down button .add.down.add -text "Add" \ -command { grab release .add destroy .add foreach dir [workdir_list_files] { cvs_add_dir $binflag $dir } } button .add.down.cancel -text "Cancel" \ -command { grab release .add; destroy .add } pack .add.down -side bottom -fill x -expand 1 pack .add.down.add .add.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .add "Add Directories" dialog_position .add .workdir wm minsize .add 1 1 return 0 gen_log:log T "LEAVE" } # Remove directories from module. Called from workdir browser proc subtractdir_dialog {args} { global cvs global incvs insvn inrcs ingit gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some directories to remove first!" .workdir return } toplevel .subtract wm attributes .subtract -topmost 1 grab set .subtract set mess "This will remove these directories:\n\n" foreach file $filelist { append mess " $file\n" } message .subtract.top -justify left -aspect 300 -relief groove \ -text "Remove (recursively) a directory from the module. The repository\ will not be changed until you do a commit." pack .subtract.top -side top -fill x message .subtract.middle -text $mess -aspect 200 pack .subtract.middle -side top -fill x frame .subtract.down button .subtract.down.remove -text "Remove" if {$incvs} { .subtract.down.remove configure -command { grab release .subtract destroy .subtract cvs_remove_dir [workdir_list_files] } } elseif {$ingit} { .subtract.down.remove configure -command { grab release .subtract destroy .subtract git_remove_dir [workdir_list_files] } } button .subtract.down.cancel -text "Cancel" \ -command { grab release .subtract; destroy .subtract } pack .subtract.down -side bottom -fill x -expand 1 pack .subtract.down.remove .subtract.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .subtract "Remove Directories" dialog_position .subtract .workdir wm minsize .subtract 1 1 gen_log:log T "LEAVE" } # For New Directory and Edit File. Allows entry of name. Called from workdir browser. proc file_input_and_do {title command {filearg {}}} { global filename gen_log:log T "ENTER ($title $command)" toplevel .file_input_and_do wm attributes .file_input_and_do -topmost 1 grab set .file_input_and_do frame .file_input_and_do.top pack .file_input_and_do.top -side top -fill both -expand 1 -pady 4 -padx 4 label .file_input_and_do.top.lbl -text "File Name" -anchor w entry .file_input_and_do.top.entry -relief sunken -textvariable filename bind .file_input_and_do.top.entry \ { .file_input_and_do.ok invoke } pack .file_input_and_do.top.lbl -side left pack .file_input_and_do.top.entry -side left -fill x -expand 1 frame .file_input_and_do.bottom pack .file_input_and_do.bottom -side bottom -fill x -pady 4 -padx 4 # The command has to be a tcl command, not something to be exec'd if {$filearg != ""} { button .file_input_and_do.ok -text "Ok" \ -command " .file_input_and_do.close invoke $command $filearg \\\"\$filename\\\" " } else { button .file_input_and_do.ok -text "Ok" \ -command " .file_input_and_do.close invoke $command \"\$filename\" " } button .file_input_and_do.close -text "Cancel" \ -command { grab release .file_input_and_do destroy .file_input_and_do } pack .file_input_and_do.ok .file_input_and_do.close \ -in .file_input_and_do.bottom \ -side left -fill both -expand 1 wm title .file_input_and_do $title dialog_position .file_input_and_do .workdir wm minsize .file_input_and_do 1 1 focus .file_input_and_do.top.entry gen_log:log T "LEAVE" } # To release a CVS directory from being recorded in the history # file as checked out. Called from workdir browser proc release_dialog { args } { gen_log:log T "ENTER ($args)" set delflag "" toplevel .release wm attributes .release -topmost 1 grab set .release set filelist [join $args] message .release.top -justify left -aspect 300 -relief groove \ -text "Tell CVS that the directory is no longer being\ worked on. CVS will stop tracking it in the\ CVS history file. Optionally, delete the directory." pack .release.top -side top -fill x ttk::checkbutton .release.binary -text "delete (-d)" \ -variable delflag -onvalue "-d" -offvalue "" pack .release.binary -side top -padx 4 -expand 1 -fill x frame .release.down button .release.down.release -text "Release" \ -command { grab release .release destroy .release cvs_release $delflag [workdir_list_files] } button .release.down.cancel -text "Cancel" \ -command { grab release .release; destroy .release } pack .release.down -side bottom -fill x -expand 1 pack .release.down.release .release.down.cancel -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 wm title .release "Release Directories" dialog_position .release .workdir wm minsize .release 1 1 gen_log:log T "LEAVE" } # SVN update with options. Called from workdir browser proc svn_update_options {} { global cvsglb global colorglb gen_log:log T "ENTER" if {[winfo exists .svn_update]} { wm deiconify .svn_update raise .svn_update gen_log:log T "LEAVE" return } # Set defaults if {! [info exists cvsglb(tagmode_selection)]} { update_set_defaults } toplevel .svn_update wm attributes .svn_update -topmost 1 frame .svn_update.explaintop frame .svn_update.options frame .svn_update.down frame .svn_update.options.keep -relief groove -borderwidth 2 frame .svn_update.options.trunk -relief groove -borderwidth 2 frame .svn_update.options.branch -relief groove -borderwidth 2 frame .svn_update.options.tag -relief groove -borderwidth 2 frame .svn_update.options.revision -relief groove -borderwidth 2 pack .svn_update.down -side bottom -fill x pack .svn_update.explaintop -side top -fill x -pady 1 pack .svn_update.options -side top -fill x -pady 1 # Provide an explanation of this dialog box message .svn_update.explain -justify left -aspect 500 -relief groove \ -text "Update all files in local directory" pack .svn_update.explain \ -in .svn_update.explaintop -side top -fill x pack .svn_update.options.keep -side top -fill x pack .svn_update.options.trunk -side top -fill x pack .svn_update.options.branch -side top -fill x pack .svn_update.options.tag -side top -fill x pack .svn_update.options.revision -side top -fill x # If the user wants to simply do a normal update ttk::radiobutton .svn_update.options.keep.select \ -text "Update to most recent revision on same branch or trunk." \ -variable cvsglb(tagmode_selection) -value "Keep" message .svn_update.options.keep.explain -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "If local directory is on main trunk, get latest on main trunk. If local directory is on a branch, get latest on that branch." pack .svn_update.options.keep.select -side top -fill x -padx 4 pack .svn_update.options.keep.explain -side top -fill x -pady 1 -ipady 0 # If the user wants to update to the head revision ttk::radiobutton .svn_update.options.trunk.select \ -text "Switch local files to be on main trunk" \ -variable cvsglb(tagmode_selection) -value "Trunk" message .svn_update.options.trunk.explain -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "Advice: If your local directories are currently on a branch, \ you may want to commit any local changes to that branch first." pack .svn_update.options.trunk.select -side top -fill x -padx 4 pack .svn_update.options.trunk.explain -side top -fill x -pady 1 -ipady 0 # If the user wants to update to a branch ttk::radiobutton .svn_update.options.branch.select \ -text "Switch local files to be on a branch" \ -variable cvsglb(tagmode_selection) -value "Branch" frame .svn_update.options.branch.lblentry label .svn_update.lbranch -text "Branch" -justify left entry .svn_update.tbranch -relief sunken -textvariable cvsglb(branchname) pack .svn_update.options.branch.select -side top -fill x -padx 4 pack .svn_update.options.branch.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .svn_update.lbranch -in .svn_update.options.branch.lblentry \ -side left -fill x -pady 4 pack .svn_update.tbranch -in .svn_update.options.branch.lblentry \ -side left -fill x -padx 2 -pady 4 # If the user wants to update to a tag ttk::radiobutton .svn_update.options.tag.select \ -text "Switch local files to be on a tag" \ -variable cvsglb(tagmode_selection) -value "Tag" frame .svn_update.options.tag.lblentry label .svn_update.ltag -text "Tag" -anchor w entry .svn_update.ttag -relief sunken -textvariable cvsglb(tagname) pack .svn_update.options.tag.select -side top -fill x -padx 4 pack .svn_update.options.tag.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .svn_update.ltag -in .svn_update.options.tag.lblentry \ -side left -fill x -pady 4 pack .svn_update.ttag -in .svn_update.options.tag.lblentry \ -side left -fill x -padx 2 -pady 4 # Where user enters a revision number ttk::radiobutton .svn_update.options.revision.select \ -text "Update local files to be a specific revision:" \ -variable cvsglb(tagmode_selection) -value "Revision" frame .svn_update.options.revision.lblentry label .svn_update.lrev -text "Revision" -anchor w entry .svn_update.trev -relief sunken -textvariable cvsglb(revnumber) pack .svn_update.options.revision.select -side top -fill x -padx 4 pack .svn_update.options.revision.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .svn_update.lrev -in .svn_update.options.revision.lblentry \ -side left -fill x -pady 4 pack .svn_update.trev -in .svn_update.options.revision.lblentry \ -side left -fill x -padx 2 -pady 4 # The OK/Cancel buttons button .svn_update.ok -text "OK" \ -command { svn_opt_update; wm withdraw .svn_update } button .svn_update.apply -text "Apply" \ -command { svn_opt_update } button .svn_update.quit -text "Close" \ -command { wm withdraw .svn_update } pack .svn_update.ok .svn_update.apply .svn_update.quit -in .svn_update.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Window Manager stuff wm title .svn_update "Update from Repository" dialog_position .svn_update .workdir wm minsize .svn_update 1 1 gen_log:log T "LEAVE" } # Called from merge procs in svn.tcl and cvs.tcl proc assemble_mergetags {from} { global cvscfg global current_tagname gen_log:log T "ENTER ($from)" # Construct tag names set totagbegin [string first "_BRANCH_" $cvscfg(mergetoformat)] set totagend [expr {$totagbegin + 8}] set toprefix [string range $cvscfg(mergetoformat) 0 [expr {$totagbegin - 1}]] set fromtagbegin [string first "_BRANCH_" $cvscfg(mergefromformat)] set fromprefix [string range $cvscfg(mergefromformat) 0 [expr {$fromtagbegin - 1}]] set datef [string range $cvscfg(mergetoformat) $totagend end] set today [clock format [clock seconds] -format "$datef"] if {[llength $current_tagname] == 1} { set curr_tag $current_tagname } else { set curr_tag "trunk" } set curr $curr_tag gen_log:log D "curr_tag $curr" if {$curr == "trunk"} {set curr $cvscfg(mergetrunkname)} if {$from == "trunk"} {set from $cvscfg(mergetrunkname)} set totag "${toprefix}_${curr}_$today" set fromtag "${fromprefix}_${from}_$today" # I had symbolic tags in mind, but some people are using untagged versions. # Substitute the dots, which are illegal for tagnames. regsub -all {\.} $totag {-} totag regsub -all {\.} $fromtag {-} fromtag gen_log:log T "LEAVE ($curr_tag $fromtag $totag)" return [list $curr_tag $fromtag $totag] } # Ask to verify and finish (commit) a merge. Called from workdir browser proc dialog_merge_notice {sys from frombranch fromtag totag filelist} { global cvscfg if {[winfo exists .reminder]} { destroy .reminder } toplevel .reminder wm attributes .reminder -topmost 1 wm title .reminder "Tag and Commit" dialog_position .reminder .workdir frame .reminder.top label .reminder.m1 -text \ "Now, you must examine the merged files and resolve any conflicts.\ \nLeave this dialog up, and when you are ready to commit,\ press the Ready button" button .reminder.ready -text "I'm ready" \ -command { foreach w {m2 totag fromtag bottom.ok} { .reminder.$w configure -state normal } foreach w {m1 ready} { .reminder.$w configure -state disabled } } label .reminder.m2 -text \ "If you check the box, TkRev will apply the \"to\" tag,\ \ncommit your changes, and finally\napply the \"from\" tag.\ \nIf you don't check the box, the changes will be committed\ \nbut no tagging will be done" ttk::checkbutton .reminder.autotag -text "Apply these tags" \ -variable cvscfg(auto_tag) entry .reminder.totag -width 32 .reminder.totag insert end $totag entry .reminder.fromtag -width 32 .reminder.fromtag insert end $fromtag frame .reminder.bottom -relief raised -bd 2 button .reminder.bottom.cancel -text "Cancel" \ -command {destroy .reminder} button .reminder.bottom.ok -text "OK" \ -command "${sys}_merge_tag_seq $from $frombranch $totag $fromtag $filelist;\ destroy .reminder" pack .reminder.bottom -side bottom -fill x pack .reminder.bottom.ok -side left -expand yes pack .reminder.bottom.cancel -side right -expand yes pack .reminder.top -side top -expand yes -fill both pack .reminder.m1 -in .reminder.top -side top pack .reminder.ready -in .reminder.top -side top pack .reminder.m2 -in .reminder.top -side top pack .reminder.autotag -in .reminder.top -side top -padx 4 pack .reminder.fromtag -in .reminder.top -side top -padx 2 pack .reminder.totag -in .reminder.top -side top -padx 2 foreach w {m2 totag fromtag bottom.ok} { .reminder.$w configure -state disabled } } # Keep a log of commit log messages. We want to do this whether the # history has ever been examined by the user or not proc commit_history {comment} { global cvsglb set comment [string trimright $comment] set c 0 foreach ch [array names cvsglb commit_comment,*] { if {$comment eq $cvsglb($ch)} { # We already have this one. We don't have to # do anything else. gen_log:log D "Comment is a duplicate" return } incr c } # We don't have this one yet set cvsglb(commit_comment,$c) $comment gen_log:log D "New comment $c" if {[winfo exists .ci_history]} { .ci_history.text insert end "$comment" .ci_history.text insert end "\n" .ci_history.text insert end "================================================================================\n" } } # See the previous log messages proc history_browser {} { global cvsglb gen_log:log T "ENTER history_browser" if {! [winfo exists .ci_history]} { toplevel .ci_history wm protocol .ci_history WM_DELETE_WINDOW { wm withdraw .ci_history } wm title .ci_history "Commit Log History for Session" text .ci_history.text -setgrid yes -relief sunken -borderwidth 2 \ -exportselection 1 -yscrollcommand" .ci_history.scroll set" ttk::scrollbar .ci_history.scroll -command ".ci_history.text yview" frame .ci_history.bottom search_textwidget_init button .ci_history.bottom.srchbtn -text Search \ -command "search_textwidget .ci_history.text" entry .ci_history.bottom.entry -width 20 -textvariable cvsglb(searchstr) bind .ci_history.bottom.entry \ "search_textwidget .ci_history.text" button .ci_history.bottom.close -text "Close" \ -command { wm withdraw .ci_history } pack .ci_history.bottom -side bottom -fill x pack .ci_history.scroll -side right -fill y pack .ci_history.text -fill both -expand 1 pack .ci_history.bottom.srchbtn -side left pack .ci_history.bottom.entry -side left pack .ci_history.bottom.close -side right # If this is the first time we've built the window, add the history we have so far foreach ch [array names cvsglb commit_comment,*] { .ci_history.text insert end $cvsglb($ch) .ci_history.text insert end "\n" .ci_history.text insert end "================================================================================\n" } } wm deiconify .ci_history gen_log:log T "LEAVE" } # Git update with options. Called from workdir bupdateopts button proc git_update_options {} { global cvscfg global cvsglb global colorglb gen_log:log T "ENTER" if {[winfo exists .git_update]} { wm deiconify .git_update raise .git_update gen_log:log T "LEAVE" return } # Set defaults if {! [info exists cvsglb(tagmode_selection)]} { update_set_defaults } toplevel .git_update wm attributes .git_update -topmost 1 frame .git_update.explaintop frame .git_update.options frame .git_update.down frame .git_update.options.keep -relief groove -borderwidth 2 frame .git_update.options.trunk -relief groove -borderwidth 2 frame .git_update.options.branch -relief groove -borderwidth 2 frame .git_update.options.tag -relief groove -borderwidth 2 frame .git_update.options.revision -relief groove -borderwidth 2 pack .git_update.down -side bottom -fill x pack .git_update.explaintop -side top -fill x -pady 1 pack .git_update.options -side top -fill x -pady 1 # Provide an explanation of this dialog box message .git_update.explain -justify left -aspect 500 -relief groove \ -text "Update all files in local directory" pack .git_update.explain \ -in .git_update.explaintop -side top -fill x pack .git_update.options.keep -side top -fill x pack .git_update.options.trunk -side top -fill x pack .git_update.options.branch -side top -fill x pack .git_update.options.tag -side top -fill x pack .git_update.options.revision -side top -fill x # If the user wants to simply do a normal update ttk::radiobutton .git_update.options.keep.select \ -text "Update to most recent revision on same branch or trunk." \ -variable cvsglb(tagmode_selection) -value "Keep" message .git_update.options.keep.explain -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "If local directory is on main trunk, get latest on main trunk. If local directory is on a branch, get latest on that branch." pack .git_update.options.keep.select -side top -fill x -padx 4 pack .git_update.options.keep.explain -side top -fill x -pady 1 -ipady 0 # If the user wants to update to the head revision ttk::radiobutton .git_update.options.trunk.select \ -text "Switch local files to be on master" \ -variable cvsglb(tagmode_selection) -value "Trunk" message .git_update.options.trunk.explain -font $colorglb(listboxfont) \ -justify left -width 400 \ -text "Advice: If your local directories are currently on a branch, \ you may want to commit any local changes to that branch first." pack .git_update.options.trunk.select -side top -fill x -padx 4 pack .git_update.options.trunk.explain -side top -fill x -pady 1 -ipady 0 # If the user wants to update to a branch ttk::radiobutton .git_update.options.branch.select \ -text "Switch local files to be on a branch" \ -variable cvsglb(tagmode_selection) -value "Branch" frame .git_update.options.branch.lblentry label .git_update.lbranch -text "Branch" -justify left entry .git_update.tbranch -relief sunken -textvariable cvsglb(branchname) pack .git_update.options.branch.select -side top -fill x -padx 4 pack .git_update.options.branch.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .git_update.lbranch -in .git_update.options.branch.lblentry \ -side left -fill x -pady 4 pack .git_update.tbranch -in .git_update.options.branch.lblentry \ -side left -fill x -padx 2 -pady 4 # If the user wants to update to a tag ttk::radiobutton .git_update.options.tag.select \ -text "Switch local files to be on a tag" \ -variable cvsglb(tagmode_selection) -value "Tag" frame .git_update.options.tag.lblentry label .git_update.ltag -text "Tag" -anchor w entry .git_update.ttag -relief sunken -textvariable cvsglb(tagname) pack .git_update.options.tag.select -side top -fill x -padx 4 pack .git_update.options.tag.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .git_update.ltag -in .git_update.options.tag.lblentry \ -side left -fill x -pady 4 pack .git_update.ttag -in .git_update.options.tag.lblentry \ -side left -fill x -padx 2 -pady 4 # Where user enters a commit number ttk::radiobutton .git_update.options.revision.select \ -text "Update local files to be a specific ID:" \ -variable cvsglb(tagmode_selection) -value "Commit" frame .git_update.options.revision.lblentry label .git_update.lrev -text "Commit ID" -anchor w entry .git_update.trev -relief sunken -textvariable cvsglb(revnumber) pack .git_update.options.revision.select -side top -fill x -padx 4 pack .git_update.options.revision.lblentry -side top -fill x \ -expand y -pady 1 -ipady 0 pack .git_update.lrev -in .git_update.options.revision.lblentry \ -side left -fill x -pady 4 pack .git_update.trev -in .git_update.options.revision.lblentry \ -side left -fill x -padx 2 -pady 4 # The OK/Cancel buttons button .git_update.ok -text "OK" \ -command { git_opt_update; wm withdraw .git_update } button .git_update.apply -text "Apply" \ -command { git_opt_update } button .git_update.quit -text "Close" \ -command { wm withdraw .git_update } pack .git_update.ok .git_update.apply .git_update.quit -in .git_update.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Window Manager stuff wm title .git_update "Update from Repository" dialog_position .git_update .workdir wm minsize .git_update 1 1 gen_log:log T "LEAVE" } # Toggle the state of a widget proc toggle_state {widg} { set curstate [$widg cget -state] switch -- $curstate { "normal" { $widg configure -state disabled } "disabled" { $widg configure -state normal } } } tkrev_9.6.1/tkrev/mkmanpage0000775000175000017500000000156614702572343016314 0ustar dorothyrdorothyr#!/bin/sh #-*-tcl-*- # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} # This prints the help text in manpage format # First, source in the help procs source help.tcl # Get the manual sections as defined there define_sections # Nop the gen_log calls proc gen_log:log {args} {} set manpage "tkrev.1" if {[catch {set fo [open $manpage w]}]} { puts stderr "Can't open file $manpage" exit } puts $fo ".TH tkrev 1" puts $fo ".SH NAME" puts $fo "\\fBtkrev\\fP - a Tk/Tcl Graphical Interface to CVS, Subversion and Git" # Now do the sections in the online help dict for {section title} $toc_dict { # Call the proc in help.tcl puts stderr $title $section null "$title" $fo } puts $fo ".SH SEE ALSO" puts $fo "\t\\fBtkdiff\\fP online help, \\fBcvs\\fP, \\fBsvn\\fP, \\fBgit<\\fP" close $fo puts "Wrote $manpage" puts "To look at it, \"man -l tkrev.1\"" tkrev_9.6.1/tkrev/modbrowse.tcl0000664000175000017500000006243215024174573017133 0ustar dorothyrdorothyr# # Set up a check out dialog. # proc modbrowse_setup {} { global cwd global cvsroot global modbrowse_module global modbrowse_path global modbrowse_title global env global cvsglb global cvscfg global colorglb global tcl_platform gen_log:log T "ENTER" set cwd [pwd] if {[winfo exists .modbrowse]} { wm deiconify .modbrowse raise .modbrowse return } # Window manager stuff. toplevel .modbrowse wm title .modbrowse "TkRev Repository Browser" wm iconname .modbrowse "TkRev Repository Browser" wm iconphoto .modbrowse -default AppIcon wm minsize .modbrowse 430 300 wm protocol .modbrowse WM_DELETE_WINDOW {.modbrowse.bottom.buttons.close invoke} wm withdraw .modbrowse if {[info exists cvscfg(modgeom)]} { update wm geometry .modbrowse $cvscfg(modgeom) } menubar_menus .modbrowse modbrowse_menus .modbrowse help_menu .modbrowse # # Top section - module, tags, root # frame .modbrowse.top -relief groove -borderwidth 2 pack .modbrowse.top -side top -fill x label .modbrowse.top.lmcode -text "Module" entry .modbrowse.top.tmcode -textvariable modbrowse_module \ -font $colorglb(listboxfont) -borderwidth 2 bind .modbrowse.top.tmcode { modbrowse_run } # We have these possibilities foreach VCS {cvs svn git} { if {[info exists env(${VCS}ROOT)]} { gen_log:log D "env(${VCS}ROOT) $env(${VCS}ROOT)" picklist_used cvsroot "$env(${VCS}ROOT)" } } foreach VCS {cvs svn git} { if {[info exists cvscfg(${VCS}root)]} { gen_log:log D "cvscfg(${VCS}root) $cvscfg(${VCS}root)" picklist_used cvsroot "$cvscfg(${VCS}root)" } } # Where do we think we are? gen_log:log D "cvsglb(root) $cvsglb(root) cvsglb(vcs) $cvsglb(vcs)" label .modbrowse.top.lroot -text "Repository" ttk::combobox .modbrowse.top.troot -textvariable cvsglb(root) .modbrowse.top.troot configure -values $cvsglb(cvsroot) bind .modbrowse.top.troot { modbrowse_run } bind .modbrowse.top.troot <> { modbrowse_run } button .modbrowse.top.bworkdir -image Workdir \ -command {workdir_setup} label .modbrowse.top.lcwd -text "Current Directory" ttk::combobox .modbrowse.top.tcwd -textvariable cwd .modbrowse.top.tcwd configure -values $cvsglb(directory) .modbrowse.top.tcwd configure -values $cvsglb(directory) bind .modbrowse.top.tcwd {set cwd [validate_dirpath %W $cwd]} bind .modbrowse.top.tcwd ".modbrowse.top.tcwd configure -foreground $colorglb(textfg)" bind .modbrowse.top.tcwd { if {[change_dir "$cwd"]} {%W configure -foreground black} } bind .modbrowse.top.tcwd <> { if {[change_dir "$cwd"]} {%W configure -foreground black} } grid columnconf .modbrowse.top 1 -weight 1 grid rowconf .modbrowse.top 3 -weight 1 grid .modbrowse.top.lroot -column 0 -row 0 -sticky w grid .modbrowse.top.troot -column 1 -row 0 -columnspan 2 -padx 4 -sticky ew grid .modbrowse.top.lmcode -column 0 -row 1 -sticky w grid .modbrowse.top.tmcode -column 1 -row 1 -padx 3 -sticky ew grid .modbrowse.top.lcwd -column 0 -row 2 -sticky w grid .modbrowse.top.tcwd -column 1 -row 2 -padx 4 -sticky ew grid .modbrowse.top.bworkdir -column 2 -row 1 -rowspan 2 -sticky w # Pack the bottom before the middle so it doesnt disappear if # the window is resized smaller frame .modbrowse.bottom -relief groove -borderwidth 2 -height 128 frame .modbrowse.bottom.buttons frame .modbrowse.bottom.buttons.cvsfuncs -relief groove -bd 2 frame .modbrowse.bottom.buttons.svnfuncs -relief groove -bd 2 frame .modbrowse.bottom.buttons.modfuncs -relief groove -bd 2 frame .modbrowse.bottom.buttons.closefm pack .modbrowse.bottom -side bottom -fill x pack .modbrowse.bottom.buttons -side top -fill x -expand yes pack .modbrowse.bottom.buttons.closefm -side right -expand yes pack .modbrowse.bottom.buttons.cvsfuncs -side left pack .modbrowse.bottom.buttons.svnfuncs -side left -expand yes pack .modbrowse.bottom.buttons.modfuncs -side left -expand yes # # Create buttons # button .modbrowse.bottom.buttons.modfuncs.filebrowse -image Files \ -command { browse_files $modbrowse_module } button .modbrowse.bottom.buttons.modfuncs.patchsummary -image Patches \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 1 } button .modbrowse.bottom.buttons.modfuncs.patchfile -image Patchfile \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 0 } button .modbrowse.bottom.buttons.modfuncs.checkout -image Checkout \ -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module } button .modbrowse.bottom.buttons.modfuncs.export -image Export \ -command { dialog_cvs_export $cvscfg(cvsroot) $modbrowse_module } button .modbrowse.bottom.buttons.modfuncs.tag -image Tag \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "tag" } button .modbrowse.bottom.buttons.modfuncs.branchtag -image Branchtag \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "branch" } button .modbrowse.bottom.buttons.svnfuncs.filecat -image Fileview \ -command { svn_filecat $cvscfg(svnroot) $modbrowse_path $modbrowse_title} button .modbrowse.bottom.buttons.svnfuncs.filelog -image Log \ -command { svn_filelog $cvscfg(svnroot) $modbrowse_path $modbrowse_title} button .modbrowse.bottom.buttons.svnfuncs.remove -image SvnRemove \ -command { svn_delete $cvscfg(svnroot) $modbrowse_path } button .modbrowse.bottom.buttons.cvsfuncs.import -image Import \ -command { cvs_import_setup } button .modbrowse.bottom.buttons.cvsfuncs.who -image Who \ -command {cvs_history all $modbrowse_module} button .modbrowse.bottom.buttons.cvsfuncs.brefresh -image Refresh \ -command { modbrowse_run } button .modbrowse.bottom.buttons.close -text "Close" \ -command { module_exit; exit_cleanup 0 } grid .modbrowse.bottom.buttons.cvsfuncs.brefresh -column 0 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.cvsfuncs.who -column 1 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.cvsfuncs.import -column 2 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.filebrowse -column 0 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.checkout -column 1 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.export -column 2 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.tag -column 3 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.branchtag -column 4 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.patchsummary -column 5 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.modfuncs.patchfile -column 6 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.svnfuncs.filecat -column 0 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.svnfuncs.filelog -column 1 -row 0 \ -ipadx 4 -ipady 4 grid .modbrowse.bottom.buttons.svnfuncs.remove -column 2 -row 0 \ -ipadx 4 -ipady 4 pack .modbrowse.bottom.buttons.close \ -in .modbrowse.bottom.buttons.closefm -side right \ -fill both -expand yes set_tooltips .modbrowse.bottom.buttons.modfuncs.checkout \ {"Check out selection from the repository"} set_tooltips .modbrowse.bottom.buttons.modfuncs.export \ {"Export selection from the repository"} set_tooltips .modbrowse.bottom.buttons.modfuncs.tag \ {"Tag all files in a module"} set_tooltips .modbrowse.bottom.buttons.modfuncs.branchtag \ {"Branch all files in a module"} set_tooltips .modbrowse.bottom.buttons.modfuncs.filebrowse \ {"Browse the files in a CVS module"} set_tooltips .modbrowse.bottom.buttons.svnfuncs.filecat \ {"Show a file in the repository"} set_tooltips .modbrowse.bottom.buttons.svnfuncs.filelog \ {"Show the history log of a file"} set_tooltips .modbrowse.bottom.buttons.svnfuncs.remove \ {"Remove something from the SVN repository"} set_tooltips .modbrowse.bottom.buttons.modfuncs.patchsummary \ {"Show a summary of differences between versions"} set_tooltips .modbrowse.bottom.buttons.modfuncs.patchfile \ {"Create a patch file"} set_tooltips .modbrowse.bottom.buttons.cvsfuncs.import \ {"Import the current directory into the repository"} set_tooltips .modbrowse.bottom.buttons.cvsfuncs.who \ {"Show who has modules checked out"} set_tooltips .modbrowse.bottom.buttons.cvsfuncs.brefresh \ {"Re-read the modules"} set_tooltips .modbrowse.bottom.buttons.close \ {"Close the repository browser"} set_tooltips .modbrowse.top.bworkdir \ {"Open the Working Directory Browser"} frame .modbrowse.treeframe -bg $colorglb(treebg) pack .modbrowse.treeframe -side bottom -fill both -expand yes -pady 0 set screenWidth [winfo vrootwidth .] set screenHeight [winfo vrootheight .] wm maxsize .modbrowse $screenWidth $screenHeight wm minsize .modbrowse 430 300 gen_log:log T "LEAVE" } # Try to contact the repository somehow to guess what kind it is proc modbrowse_guess_vcs {} { global cvsglb global cvscfg global modbrowse_module gen_log:log T "ENTER" gen_log:log D "cvsglb(root) = $cvsglb(root)" # If there's no root at all, don't waste our time if {$cvsglb(root) eq ""} { gen_log:log D "cvsglb(root) is empty. Not proceeding further." gen_log:log T "LEAVE ($cvsglb(vcs))" return $cvsglb(vcs) } set vcs "" set cvs_cmd "cvs -d $cvsglb(root) rdiff -l -s -D 01/01/1971 \"$modbrowse_module\"" gen_log:log C $cvs_cmd set cvsret [catch {exec {*}$cvs_cmd > $cvscfg(null)} cvsout] if {[string match {*Diffing*} $cvsout]} { gen_log:log T "LEAVE (cvs)" return "cvs" } else { gen_log:log E $cvsout } set svn_cmd "svn list $cvsglb(root)" gen_log:log C $svn_cmd set svnret [catch {exec {*}$svn_cmd} svnout] if {$svnret} { gen_log:log E $svnout } else { gen_log:log T "LEAVE (svn)" return "svn" } set git_cmd "git ls-remote $cvsglb(root)" gen_log:log C $git_cmd set gitret [catch {exec {*}$git_cmd} gitout] if {$gitret} { gen_log:log E $gitout } else { set cvscfg(gitroot) $cvsglb(root) gen_log:log T "LEAVE (git)" return "git" } gen_log:log T "LEAVE ($cvsglb(vcs))" return $cvsglb(vcs) } proc modbrowse_run {} { global env global incvs insvn inrcs ingit global cvscfg global cvsglb global cvs global cmd global cvsroot global modval global modtitle global modbrowse_module global modbrowse_path global modbrowse_title gen_log:log T "ENTER ()" gen_log:log D "incvs=$incvs insvn=$insvn inrcs=$inrcs ingit=$ingit" gen_log:log D "cvsglb(root) $cvsglb(root)" catch {unset modval} catch {unset modtitle} set modbrowse_module "" if {$incvs} { set cvsglb(vcs) cvs read_cvs_dir "[pwd]/CVS" } elseif {$insvn} { set cvsglb(vcs) svn read_svn_dir "[pwd]" set cvsglb(root) $cvscfg(url) set cvscfg(root) $cvsglb(root) } elseif {$ingit} { set cvsglb(vcs) git read_git_dir "[pwd]" set cvsglb(root) $cvsglb(repos_top) } elseif {$inrcs} { set cvsglb(vcs) rcs } else { set cvsglb(vcs) [modbrowse_guess_vcs] } gen_log:log D "cvsglb(vcs) $cvsglb(vcs)" if {! [winfo exists .modbrowse]} { modbrowse_setup } wm deiconify .modbrowse raise .modbrowse ModTree:destroy .modbrowse.treeframe busy_start .modbrowse switch $cvsglb(vcs) { svn { .modbrowse.top.lroot configure -text "SVN URL" .modbrowse.top.lmcode configure -text "Selection" # Set up ModTree and tell it to use clbk just-in-time-listdir ModTree:create .modbrowse.treeframe pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes .modbrowse.treeframe.pw heading file -text "File" .modbrowse.treeframe.pw heading information -text "Date" .modbrowse.treeframe.pw configure -selectmode extended # parse_svnmodules will do "svn list" and post the files and directories bind .modbrowse.treeframe.pw <> svn_jit_listdir bind .modbrowse.treeframe.pw <> svn_closedir bind .modbrowse.treeframe.pw <> { global modbrowse_module global modbrowse_path global modbrowse_title set selection [.modbrowse.treeframe.pw selection] set modbrowse_title [string trimleft $selection "/"] set modbrowse_path $modbrowse_title set modbrowse_module $modbrowse_path } # parse_svnmodules does svn list of the repository # For SVN. The URL changes depending on what directory we're in, so if we're # in an SVN directory, use svnroot instead of cvsglb(root) if {! [info exists cvscfg(svnroot)]} { set cvscfg(svnroot) $cvsglb(root) } parse_svnmodules $cvscfg(svnroot) } cvs { .modbrowse.top.lroot configure -text "CVSROOT" .modbrowse.top.lmcode configure -text "Module" # Set up ModTree ModTree:create .modbrowse.treeframe pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes .modbrowse.treeframe.pw heading file -text "Module" .modbrowse.treeframe.pw heading information -text "Information" .modbrowse.treeframe.pw column #0 -width [expr {$cvsglb(mod_iconwidth) * 2}] .modbrowse.treeframe.pw configure -selectmode extended bind .modbrowse.treeframe.pw <> { global modbrowse_module global modbrowse_path global modbrowse_title set selection [.modbrowse.treeframe.pw selection] set modbrowse_title [string trimleft $selection "/"] set modbrowse_path $modbrowse_title set modbrowse_module $modbrowse_path } # parse_cvsmodules will check out CVSROOT/modules and post what it finds parse_cvsmodules $cvsglb(root) } git { .modbrowse.top.lroot configure -text "Origin" .modbrowse.top.lmcode configure -text "Selection" # Set up ModTree for a git ls-remote ModTree:create .modbrowse.treeframe pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes .modbrowse.treeframe.pw heading file -text "Reference" .modbrowse.treeframe.pw heading information -text "Commit ID" .modbrowse.treeframe.pw column #0 -width 0 .modbrowse.treeframe.pw configure -selectmode browse bind .modbrowse.treeframe.pw <> { global modbrowse_module global modbrowse_path global modbrowse_title set selection [.modbrowse.treeframe.pw selection] set modbrowse_title $selection set modbrowse_path $modbrowse_title # The hash, not the name lappend modbrowse_module [lindex [.modbrowse.treeframe.pw item $modbrowse_path -values] 1] } # parse_gitlist will do git ls-remote and post what it finds parse_gitlist $cvsglb(root) } rcs { .modbrowse.top.lroot configure -text "RCS Path" .modbrowse.top.lmcode configure -text "Selection" # There's no such thing as a remote RCS repository as far as I know, # so we can just do a directory listing ModTree:create .modbrowse.treeframe pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes .modbrowse.treeframe.pw heading file -text "File" .modbrowse.treeframe.pw heading information -text "Date" .modbrowse.treeframe.pw column #0 -width 0 .modbrowse.treeframe.pw column #2 -width 150 .modbrowse.treeframe.pw column #2 -width 30 .modbrowse.treeframe.pw configure -selectmode browse bind .modbrowse.treeframe.pw <> { global modbrowse_module global modbrowse_path global modbrowse_title set selection [.modbrowse.treeframe.pw selection] set modbrowse_title $selection set modbrowse_path $modbrowse_title #set modbrowse_module $modbrowse_path set modbrowse_module [lindex [.modbrowse.treeframe.pw item $modbrowse_path -values] 0] } find_rcsfiles $cvsglb(root) } default { # Just make an empty frame ModTree:create .modbrowse.treeframe pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes busy_done .modbrowse return } } busy_done .modbrowse # Maybe this root is new to us? picklist_used cvsroot "$cvsglb(root)" # Have to do this to display the new value in the list .modbrowse.top.troot configure -values $cvsglb(cvsroot) # Start without revision-control menu gen_log:log D "CONFIGURE VCS MENUS" foreach label {"CVS" "SVN" "GIT" "RCS" "Import"} { if {! [catch {set vcsmenu_idx [.modbrowse.menubar index "$label"]}]} { .modbrowse.menubar delete $vcsmenu_idx } } set filemenu_idx [.modbrowse.menubar index "File"] switch $cvsglb(vcs) { cvs { .modbrowse.bottom.buttons.modfuncs.filebrowse configure \ -command { browse_files $modbrowse_module } .modbrowse.bottom.buttons.modfuncs.checkout configure -state normal \ -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module } .modbrowse.bottom.buttons.cvsfuncs.import configure -state normal \ -command { cvs_import_setup } .modbrowse.bottom.buttons.modfuncs.checkout configure -state normal \ -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module } .modbrowse.bottom.buttons.modfuncs.export configure -state normal \ -command { dialog_cvs_export $cvscfg(cvsroot) $modbrowse_module } .modbrowse.bottom.buttons.modfuncs.tag configure -state normal \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "tag" } .modbrowse.bottom.buttons.modfuncs.branchtag configure -state normal \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "branch" } .modbrowse.bottom.buttons.modfuncs.patchsummary configure -state normal \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 1 } .modbrowse.bottom.buttons.modfuncs.patchfile configure -state normal \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 0 } .modbrowse.bottom.buttons.cvsfuncs.who configure -state normal .modbrowse.bottom.buttons.svnfuncs.filecat configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filelog configure -state disabled .modbrowse.bottom.buttons.svnfuncs.remove configure -state disabled .modbrowse.menubar insert [expr {$filemenu_idx + 1}] cascade -label "CVS" \ -menu .modbrowse.menubar.cvs } svn { .modbrowse.bottom.buttons.cvsfuncs.import configure -state normal \ -command { svn_import_run } .modbrowse.bottom.buttons.modfuncs.filebrowse configure -state disabled .modbrowse.bottom.buttons.modfuncs.checkout configure -state normal \ -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path checkout} .modbrowse.bottom.buttons.modfuncs.export configure -state normal \ -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path export} .modbrowse.bottom.buttons.modfuncs.tag configure -state normal \ -command { dialog_svn_tag $cvscfg(svnroot) $modbrowse_path "tags" } .modbrowse.bottom.buttons.modfuncs.branchtag configure -state normal \ -command { dialog_svn_tag $cvscfg(svnroot) $modbrowse_path "branches" } .modbrowse.bottom.buttons.modfuncs.patchsummary configure -state normal \ -command { dialog_svn_patch $cvscfg(svnroot) $modbrowse_path {} 1 } .modbrowse.bottom.buttons.modfuncs.patchfile configure -state normal \ -command { dialog_svn_patch $cvscfg(svnroot) $modbrowse_path {} 0 } .modbrowse.bottom.buttons.cvsfuncs.who configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filecat configure -state normal .modbrowse.bottom.buttons.svnfuncs.filelog configure -state normal .modbrowse.bottom.buttons.svnfuncs.remove configure -state normal .modbrowse.menubar insert [expr {$filemenu_idx + 1}] cascade -label "SVN" \ -menu .modbrowse.menubar.svn } git { # Disable all except clone .modbrowse.bottom.buttons.cvsfuncs.import configure -state disabled .modbrowse.bottom.buttons.modfuncs.filebrowse configure -state disabled .modbrowse.bottom.buttons.modfuncs.checkout configure -state normal \ -command { dialog_git_clone $cvscfg(gitroot) $modbrowse_module } .modbrowse.bottom.buttons.modfuncs.export configure -state disabled .modbrowse.bottom.buttons.modfuncs.tag configure -state disabled .modbrowse.bottom.buttons.modfuncs.branchtag configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchsummary configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchfile configure -state disabled .modbrowse.bottom.buttons.cvsfuncs.who configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filecat configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filelog configure -state disabled .modbrowse.bottom.buttons.svnfuncs.remove configure -state disabled .modbrowse.menubar insert [expr {$filemenu_idx + 1}] cascade -label "GIT" \ -menu .modbrowse.menubar.git } rcs { # Disable all except fileview and filelog .modbrowse.bottom.buttons.cvsfuncs.import configure -state disabled .modbrowse.bottom.buttons.modfuncs.filebrowse configure -state disabled .modbrowse.bottom.buttons.modfuncs.checkout configure -state disabled .modbrowse.bottom.buttons.modfuncs.export configure -state disabled .modbrowse.bottom.buttons.modfuncs.tag configure -state disabled .modbrowse.bottom.buttons.modfuncs.branchtag configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchsummary configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchfile configure -state disabled .modbrowse.bottom.buttons.cvsfuncs.who configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filecat configure -state normal \ -command { rcs_fileview_checkout . "$modbrowse_module" } .modbrowse.bottom.buttons.svnfuncs.filelog configure -state normal \ -command { rcs_log verbose "$modbrowse_module" } .modbrowse.bottom.buttons.svnfuncs.remove configure -state disabled } default { # Disable all .modbrowse.bottom.buttons.cvsfuncs.import configure -state disabled .modbrowse.bottom.buttons.modfuncs.filebrowse configure -state disabled .modbrowse.bottom.buttons.modfuncs.checkout configure -state disabled .modbrowse.bottom.buttons.modfuncs.export configure -state disabled .modbrowse.bottom.buttons.modfuncs.tag configure -state disabled .modbrowse.bottom.buttons.modfuncs.branchtag configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchsummary configure -state disabled .modbrowse.bottom.buttons.modfuncs.patchfile configure -state disabled .modbrowse.bottom.buttons.cvsfuncs.who configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filecat configure -state disabled .modbrowse.bottom.buttons.svnfuncs.filelog configure -state disabled .modbrowse.bottom.buttons.svnfuncs.remove configure -state disabled } } if {$insvn || $incvs || $inrcs || $ingit} { # Don't allow an attempt to import from a version-controlled directory .modbrowse.bottom.buttons.cvsfuncs.import configure -state disabled } # Populate the tree switch $cvsglb(vcs) { svn { # Make sure branches and tags names come first, before any of their # contents, so we get the "# tags" and "# branches" labels set newlist "" foreach item [array names modval] { if {! ($item == $cvscfg(svn_branchdir) || $item == $cvscfg(svn_tagdir))} { lappend newlist $item } } set newlist [lsort $newlist] set newlist [concat {$cvscfg(svn_branchdir} {$cvscfg(svn_tagdir)} $newlist] } cvs { cvs_modbrowse_tree [lsort [array names modval]] "/" } git { # Nothing to do here } } busy_done .modbrowse gen_log:log T "LEAVE" } proc module_exit { } { global cvscfg global cvs global cmd gen_log:log T "ENTER" # Stop any checkout that may be in process if {[info exists cmd(cvs_co)]} { catch {$cmd(cvs_co)\::abort} catch {unset cmd(cvs_co)} } set pid [pid] set cwd [pwd] set sandbox [file join $cvscfg(tmpdir) cvstmpdir.$pid] if {[file isdirectory $sandbox]} { gen_log:log F "CD $sandbox" cd $sandbox set dirs "" foreach d [glob -nocomplain *] { lappend dirs $d } gen_log:log C "$cvs -Q release $dirs" catch {exec {*}$cvs -Q release $dirs} # Doing it this way makes it pop up an error on windows. # Very annoying. #set finish [exec::new "$cvs -Q release $dirs"] #$finish\::wait } cd $cwd gen_log:log F "CD [pwd]" set cvscfg(modgeom) [wm geometry .modbrowse] ModTree:destroy .modbrowse.modtree destroy .modbrowse catch {destroy .tooltips_wind} exit_cleanup 0 gen_log:log T "LEAVE" } proc ModTree:create {w} { global cvsglb global cvscfg ttk::treeview $w.pw -yscrollcommand "$w.yscroll set" $w.pw configure -columns "file information" $w.pw column #0 -minwidth 0 $w.pw column #0 -width $cvsglb(mod_iconwidth) $w.pw column #0 -stretch no ttk::scrollbar $w.yscroll -orient vertical \ -command "$w.pw yview" pack $w.yscroll -side right -fill y focus $w.pw } proc ModTree:destroy {w} { destroy $w.pw destroy $w.yscroll } tkrev_9.6.1/tkrev/preferences.tcl0000664000175000017500000003407414715513010017421 0ustar dorothyrdorothyr # Make a tabbed notebook for Preferences proc prefdialog {} { global cvscfg if {[winfo exists .prefdlg]} { destroy .prefdlg } set pd .prefdlg toplevel $pd wm title $pd "TkRev Preferences" wm protocol $pd WM_DELETE_WINDOW { prefs_close } wm withdraw .prefdlg lassign [winfo pointerxy .] x y incr x -150 wm geometry .prefdlg +$x+$y ttk::notebook $pd.prefnb ttk::notebook::enableTraversal $pd.prefnb frame $pd.bot -relief raised -bd 2 button $pd.bot.save -text "Save" -command { set cvsglb(vcspref) $cvscfg(vcspref); save_options } button $pd.bot.close -text "Close" -command { prefs_close } pack $pd.bot.save -side left -padx 4 -pady 2 pack $pd.bot.close -side right -padx 4 -pady 2 pack $pd.bot -side bottom -expand 0 -fill x # Build the pages prefs_general $pd.prefnb prefs_diagram $pd.prefnb prefs_git $pd.prefnb prefs_subversion $pd.prefnb prefs_cvs $pd.prefnb pack $pd.prefnb -side top -expand y -fill both if {[info exists cvscfg(preftab)]} { .prefdlg.prefnb select $cvscfg(preftab) } if {! [winfo ismapped .prefdlg]} { wm deiconify .prefdlg } bind .prefdlg.prefnb <> {set cvscfg(preftab) [.prefdlg.prefnb select]} raise $pd } # General preferences proc prefs_general {w} { global cvscfg global colorglb frame $w.general -background $colorglb(menubg) $w add $w.general -text "General" -sticky nsew ttk::checkbutton $w.general.allfiles -style Tabs.TCheckbutton \ -text "Show Dotfiles" -variable cvscfg(allfiles) -onvalue true -offvalue false ttk::checkbutton $w.general.confirmation -style Tabs.TCheckbutton \ -text "Show Confirmation Dialogs" \ -variable cvscfg(confirm_prompt) -onvalue true -offvalue false ttk::checkbutton $w.general.auto -style Tabs.TCheckbutton \ -text "Automatic Workdir Status" \ -variable cvscfg(auto_status) -onvalue true -offvalue false label $w.general.lshell -text "Terminal" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.general.eshell -textvariable cvscfg(shell) label $w.general.leditor -text "Text Editor" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.general.eeditor -textvariable cvscfg(editor) ttk::checkbutton $w.general.ext_editor -style Tabs.TCheckbutton \ -text "Use Native Editor for Check In" \ -variable cvscfg(use_cvseditor) -onvalue true -offvalue false label $w.general.ldiff -text "Diff Visualizer" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.general.ediff -textvariable cvscfg(tkdiff) label $w.general.lvcsorder -text "VCS Precedence" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.general.evcsorder -textvariable cvscfg(vcspref) grid columnconf $w.general 1 -weight 1 grid $w.general.allfiles -padx 4 -sticky w -column 0 -row 0 -columnspan 2 grid $w.general.confirmation -padx 4 -sticky w -column 0 -row 1 -columnspan 2 grid $w.general.auto -padx 4 -sticky w -column 0 -row 2 -columnspan 2 grid $w.general.ext_editor -padx 4 -sticky w -column 0 -row 3 -columnspan 2 grid $w.general.leditor -sticky w -column 0 -row 4 grid $w.general.eeditor -sticky ew -column 1 -row 4 -padx 2 grid $w.general.ldiff -sticky w -column 0 -row 5 grid $w.general.ediff -sticky ew -column 1 -row 5 -padx 2 grid $w.general.lshell -sticky w -column 0 -row 6 grid $w.general.eshell -sticky ew -column 1 -row 6 -padx 2 grid $w.general.lvcsorder -sticky w -column 0 -row 7 grid $w.general.evcsorder -sticky ew -column 1 -row 7 -padx 2 if {[tk windowingsystem] eq "x11"} { ttk::separator $w.general.sep1 label $w.general.x11lbl -text "X11" \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::checkbutton $w.general.match_desk -style Tabs.TCheckbutton \ -text "Match GTK or CDE colors (requires restart)" \ -variable cvscfg(match_desktop) -onvalue true -offvalue false grid $w.general.sep1 -sticky ew -column 0 -row 8 -columnspan 3 -pady 4 grid $w.general.x11lbl -sticky w -column 0 -row 9 -pady 2 grid $w.general.match_desk -sticky w -column 0 -row 10 -padx 4 -columnspan 3 } } # For the Branch diagrams proc prefs_diagram {w} { global logcfg global colorglb frame $w.logcanv -bg $colorglb(menubg) $w add $w.logcanv -text "Branch Browser" -sticky nsew frame $w.logcanv.layout -bg $colorglb(menubg) ttk::checkbutton $w.logcanv.layout.showtags -style Tabs.TCheckbutton \ -text "Show Tags" \ -variable logcfg(show_tags) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.layout.showbranches -style Tabs.TCheckbutton \ -text "Show Branches" \ -variable logcfg(show_branches) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.layout.showempty -style Tabs.TCheckbutton \ -text "Show Empty Branches (CVS)" \ -variable logcfg(show_empty_branches) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.layout.showintermed -style Tabs.TCheckbutton \ -text "Show Intermediate Revisions" \ -variable logcfg(show_inter_revs) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.layout.showmerg -style Tabs.TCheckbutton \ -text "Show Merges" \ -variable logcfg(show_merges) -onvalue 1 -offvalue 0 pack $w.logcanv.layout -side top -fill x grid columnconf $w.logcanv.layout 1 -weight 1 grid $w.logcanv.layout.showtags -padx 4 -sticky w -column 0 -row 0 -columnspan 2 grid $w.logcanv.layout.showbranches -padx 4 -sticky w -column 0 -row 1 -columnspan 2 grid $w.logcanv.layout.showempty -padx 4 -sticky w -column 0 -row 2 -columnspan 2 grid $w.logcanv.layout.showintermed -padx 4 -sticky w -column 0 -row 3 -columnspan 2 grid $w.logcanv.layout.showmerg -padx 4 -sticky w -column 0 -row 4 -columnspan 2 ttk::separator $w.logcanv.sep1 pack $w.logcanv.sep1 -side top -fill x -pady 3 frame $w.logcanv.scale -bg $colorglb(menubg) label $w.logcanv.scale.lspin -text "Scale" \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::spinbox $w.logcanv.scale.sspin -from .2 -to 1.5 -increment .1 \ -textvariable logcfg(scale) pack $w.logcanv.scale grid columnconf $w.logcanv.scale 1 -weight 1 grid $w.logcanv.scale.lspin -sticky w -column 0 -row 0 grid $w.logcanv.scale.sspin -sticky w -column 1 -row 0 ttk::separator $w.logcanv.sep2 pack $w.logcanv.sep2 -side top -fill x -pady 3 frame $w.logcanv.revs -bg $colorglb(menubg) ttk::checkbutton $w.logcanv.revs.showrev -style Tabs.TCheckbutton \ -text "Show Revision #" \ -variable logcfg(show_box_rev) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.revs.showrevwho -style Tabs.TCheckbutton \ -text "Show Author" \ -variable logcfg(show_box_revwho) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.revs.showrevdate -style Tabs.TCheckbutton \ -text "Show Date" \ -variable logcfg(show_box_revdate) -onvalue 1 -offvalue 0 ttk::checkbutton $w.logcanv.revs.showrevtime -style Tabs.TCheckbutton \ -text "Show Time" \ -variable logcfg(show_box_revtime) -onvalue 1 -offvalue 0 pack $w.logcanv.revs -side top -fill x grid columnconf $w.logcanv.revs 1 -weight 1 grid $w.logcanv.revs.showrev -padx 4 -sticky w -column 0 -row 0 -columnspan 2 grid $w.logcanv.revs.showrevwho -padx 4 -sticky w -column 0 -row 1 -columnspan 2 grid $w.logcanv.revs.showrevdate -padx 4 -sticky w -column 0 -row 2 -columnspan 2 grid $w.logcanv.revs.showrevtime -padx 4 -sticky w -column 0 -row 3 -columnspan 2 } # For CVS proc prefs_cvs {w} { global colorglb frame $w.cvs -bg $colorglb(menubg) $w add $w.cvs -text "CVS" -sticky nsew ttk::checkbutton $w.cvs.editing -style Tabs.TCheckbutton \ -text "Allow cvs edit" \ -variable cvscfg(econtrol) -onvalue true -offvalue false -state disabled ttk::checkbutton $w.cvs.locking -style Tabs.TCheckbutton \ -text "Allow cvs lock" \ -variable cvscfg(cvslock) -onvalue true -offvalue false -state disabled grid columnconf $w.cvs 1 -weight 1 grid $w.cvs.editing -padx 4 -sticky w -column 0 -row 0 grid $w.cvs.locking -padx 4 -sticky w -column 0 -row 1 } # For Subversion proc prefs_subversion {w} { global colorglb frame $w.svn -bg $colorglb(menubg) $w add $w.svn -text "Subversion" -sticky nsew frame $w.svn.dirnames -bg $colorglb(menubg) label $w.svn.dirnames.ltrunkdir -text "Trunk Directory" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.svn.dirnames.etrunkdir -textvariable cvscfg(svn_trunkdir) label $w.svn.dirnames.lbranchdir -text "Branches Directory" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.svn.dirnames.ebranchdir -textvariable cvscfg(svn_branchdir) label $w.svn.dirnames.ltagdir -text "Tags Directory" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.svn.dirnames.etagdir -textvariable cvscfg(svn_tagdir) pack $w.svn.dirnames -side top -fill x grid columnconf $w.svn.dirnames 1 -weight 1 grid $w.svn.dirnames.ltrunkdir -sticky w -column 0 -row 0 grid $w.svn.dirnames.etrunkdir -sticky ew -column 1 -row 0 -padx 2 grid $w.svn.dirnames.lbranchdir -sticky w -column 0 -row 1 grid $w.svn.dirnames.ebranchdir -sticky ew -column 1 -row 1 -padx 2 grid $w.svn.dirnames.ltagdir -sticky w -column 0 -row 2 grid $w.svn.dirnames.etagdir -sticky ew -column 1 -row 2 -padx 2 ttk::separator $w.svn.sep1 pack $w.svn.sep1 -side top -fill x -pady 3 frame $w.svn.branchbr -bg $colorglb(menubg) label $w.svn.branchbr.lmaxtag -text "Maximum SVN Tags" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.svn.branchbr.emaxtag -textvariable cvscfg(toomany_tags) pack $w.svn.branchbr -side top -fill x grid columnconf $w.svn.branchbr 1 -weight 1 grid $w.svn.branchbr.lmaxtag -sticky w -column 0 -row 0 grid $w.svn.branchbr.emaxtag -sticky ew -column 1 -row 0 -padx 2 } # For Git proc prefs_git {w} { global colorglb frame $w.git -bg $colorglb(menubg) $w add $w.git -text "Git" -sticky nsew frame $w.git.workdir -bg $colorglb(menubg) ttk::checkbutton $w.git.workdir.detail -style Tabs.TCheckbutton \ -text "Detailed Workdir Status" \ -variable cvscfg(gitdetail) -onvalue true -offvalue false pack $w.git.workdir -side top -fill x grid columnconf $w.git.workdir 1 -weight 1 grid $w.git.workdir.detail -padx 4 -sticky w -column 0 -row 0 -columnspan 2 ttk::separator $w.git.sep1 pack $w.git.sep1 -side top -fill x -pady 3 frame $w.git.blame -bg $colorglb(menubg) label $w.git.blame.blamelbl -text "Annotate/Blame" \ -background $colorglb(menubg) -foreground $colorglb(menufg) label $w.git.blame.lgitblame_since -text "Since" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.blame.egitblame_since -textvariable cvscfg(gitblame_since) pack $w.git.blame -side top -fill x grid columnconf $w.git.blame 1 -weight 1 grid $w.git.blame.blamelbl -sticky w -column 0 -row 0 -columnspan 2 grid $w.git.blame.lgitblame_since -sticky w -column 0 -row 1 grid $w.git.blame.egitblame_since -sticky ew -column 1 -row 1 -padx 2 ttk::separator $w.git.sep2 pack $w.git.sep2 -side top -fill x -pady 3 frame $w.git.branchbr -bg $colorglb(menubg) label $w.git.branchbr.blamelbl -text "Log Browser" \ -background $colorglb(menubg) -foreground $colorglb(menufg) label $w.git.branchbr.lgitlog_since -text "Since" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.branchbr.egitlog_since -textvariable cvscfg(gitlog_since) label $w.git.branchbr.lmaxhist -text "Maximum Git History" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.branchbr.emaxhist -textvariable cvscfg(gitmaxhist) label $w.git.branchbr.lmaxbranches -text "Maximum Git Branches" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.branchbr.emaxbranches -textvariable cvscfg(gitmaxbranch) label $w.git.branchbr.llogopts -text "Git Log Options" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.branchbr.elogopts -textvariable cvscfg(gitlog_opts) ttk::radiobutton $w.git.branchbr.br_file -style Tabs.TCheckbutton \ -text " File-specific branches only" \ -variable cvscfg(gitbranchgroups) -value "F" ttk::radiobutton $w.git.branchbr.br_local -style Tabs.TCheckbutton \ -text " All local branches" \ -variable cvscfg(gitbranchgroups) -value "FL" ttk::radiobutton $w.git.branchbr.br_remote -style Tabs.TCheckbutton \ -text " Local + Remote branches" \ -variable cvscfg(gitbranchgroups) -value "FLR" label $w.git.branchbr.lbrglob -text "Git Branch Filter (regex)" \ -background $colorglb(menubg) -foreground $colorglb(menufg) entry $w.git.branchbr.ebrglob -textvariable cvscfg(gitbranchregex) label $w.git.branchbr.hbrglob -text "master and current always included" \ -background $colorglb(menubg) -foreground $colorglb(menufg) pack $w.git.branchbr -side top -fill x grid columnconf $w.git.branchbr 1 -weight 1 grid $w.git.branchbr.blamelbl -sticky w -column 0 -row 0 -columnspan 2 grid $w.git.branchbr.lgitlog_since -sticky w -column 0 -row 1 grid $w.git.branchbr.egitlog_since -sticky ew -column 1 -row 1 -padx 2 grid $w.git.branchbr.lmaxhist -sticky w -column 0 -row 2 grid $w.git.branchbr.emaxhist -sticky ew -column 1 -row 2 -padx 2 grid $w.git.branchbr.lmaxbranches -sticky w -column 0 -row 3 grid $w.git.branchbr.emaxbranches -sticky ew -column 1 -row 3 -padx 2 grid $w.git.branchbr.llogopts -sticky w -column 0 -row 4 grid $w.git.branchbr.elogopts -sticky ew -column 1 -row 4 -padx 2 grid $w.git.branchbr.br_file -padx 4 -sticky w -column 1 -row 5 grid $w.git.branchbr.br_local -padx 4 -sticky w -column 1 -row 6 grid $w.git.branchbr.br_remote -padx 4 -sticky w -column 1 -row 7 grid $w.git.branchbr.lbrglob -sticky w -column 0 -row 8 grid $w.git.branchbr.ebrglob -sticky ew -column 1 -row 8 -padx 2 grid $w.git.branchbr.hbrglob -sticky w -column 1 -row 9 } proc prefs_close { } { global cvscfg gen_log:log D "Preferences Tab $cvscfg(preftab)" destroy .prefdlg exit_cleanup 0 } tkrev_9.6.1/tkrev/svn_import.tcl0000664000175000017500000000674315015446517017335 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # Adds a new document to the repository. # proc svn_import_run {} { global cvsglb global cvscfg global incvs insvn inrcs ingit gen_log:log T "ENTER" lassign [vcs_detect [pwd]] incvs insvn inrcs ingit if {$insvn} { cvsok "This directory is already in Subversion.\nCan\'t import here!" .svn_import gen_log:log T "LEAVE" return } elseif {$incvs} { cvsok "There are CVS directories here.\nPlease remove them first." .svn_import gen_log:log T "LEAVE" return } set cvsglb(imdir) [file tail [pwd]] # This is just a default. The user can change it. if {[info exists cvscfg(svnroot)] && $cvscfg(svnroot) != ""} { set cvsglb(imtop) $cvscfg(svnroot) } else { set cvsglb(imtop) "< URL Required >" } # Can't use file join or it will mess up the URL set cvsglb(imtop) "$cvsglb(imtop)/trunk" if {[winfo exists .svn_import]} { wm deiconify .svn_import raise .svn_import grab set .svn_import gen_log:log T "LEAVE" return } toplevel .svn_import grab set .svn_import frame .svn_import.top message .svn_import.top.explain -justify left -width 500 -relief groove \ -text "This will import the current directory and its sub-directories\ into SVN. If you haven't created a Subversion repository,\ you must do that first with \"svnadmin create.\"" label .svn_import.top.lsvnroot -text "URL of SVN Repository" -anchor w entry .svn_import.top.tsvnroot -textvariable cvsglb(imtop) grid .svn_import.top.explain -column 0 -row 0 -columnspan 3 -sticky ew #grid .svn_import.top.lnewdir -column 0 -row 1 -sticky w #grid .svn_import.top.tnewdir -column 1 -row 1 -sticky ew grid .svn_import.top.lsvnroot -column 0 -row 2 -sticky e grid .svn_import.top.tsvnroot -column 1 -row 2 -sticky ew frame .svn_import.down -relief groove -borderwidth 2 button .svn_import.down.ok -text "OK" \ -command { grab release .svn_import wm withdraw .svn_import svn_do_import $cvsglb(imtop) $cvsglb(imdir) } button .svn_import.down.quit -text "Cancel" \ -command { grab release .svn_import wm withdraw .svn_import } pack .svn_import.down -side bottom -expand yes -fill x pack .svn_import.top -side top -expand yes -fill x pack .svn_import.down.ok -side left -expand yes pack .svn_import.down.quit -side left -expand yes wm title .svn_import "Import a Project into Subversion" wm minsize .svn_import 1 1 gen_log:log T "LEAVE" } proc svn_do_import {imtop imdir} { gen_log:log T "ENTER" set imdir [pwd] set cwd [pwd] set commandline "svn import . $imtop -m \"Imported using TkRev\"" set v [viewer::new "Import Project"] $v\::log "\nSVN Import\n" $v\::do "$commandline" $v\::wait update # Now check out the new module cd .. gen_log:log F "CD [pwd]" # We have to move the original stuff entirely out of the way. # Otherwise checkout won't do the whole tree. gen_log:log F "MOVE $imdir $imdir.orig" if {[file isdirectory $imdir.orig]} { file delete -force -- $imdir.orig } file rename $imdir $imdir.orig set commandline "svn checkout $imtop $imdir" $v\::log "\nSVN Checkout\n" $v\::do "$commandline" $v\::wait if {[catch "cd $imdir" err]} { # If we didn't check out the new dir sucessfully, put the old one back file rename $imdir.orig $imdir cvsok "$err" .isvn_mport } else { gen_log:log F "CD [pwd]" } setup_dir modbrowse_run gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/ui_misc.tcl0000664000175000017500000003211515033645673016561 0ustar dorothyrdorothyr # Bindings to make canvases scroll. Canvases have no bindings at all # by default. proc scrollbindings {cnvs} { # Page keys bind $cnvs [list %W yview scroll 1 pages] bind $cnvs [list %W yview scroll -1 pages] bind $cnvs [list %W yview scroll -1 units] bind $cnvs [list %W yview scroll 1 units] bind $cnvs [list %W xview scroll -1 pages] bind $cnvs [list %W xview scroll 1 pages] # Middle button dragging bind $cnvs [list dragbind %W %x %y] # Wheelmouse bind $cnvs [list wheelbind %W %D] bind $cnvs [list %W yview scroll -1 pages] bind $cnvs [list %W yview scroll 1 pages] } # Generic Copy popup for read-only text widgets proc copy_paste_popup {win X Y} { global colorglb #gen_log:log T "ENTER ($win $X $Y)" if {! [winfo exists $win.copy_paste_pop] } { menu $win.copy_paste_pop $win.copy_paste_pop add command -label "Copy selection" \ -command [list event generate $win <>] $win.copy_paste_pop add command -label "Select all" \ -command [list $win tag add sel 0.0 end] } tk_popup $win.copy_paste_pop $X $Y $win.copy_paste_pop configure -background $colorglb(menubg) -foreground $colorglb(menufg) } # Disable all key sequences for text widget except for navigation # and copy-to-clipboard proc ro_textbindings {txtw} { #gen_log:log T "ENTER ($txtw)" bind $txtw {break} bind $txtw {catch {%W yview moveto 0};break} bind $txtw {catch {%W yview scroll -1 units};break} bind $txtw {catch {%W yview scroll -1 pages};break} bind $txtw {catch {%W yview scroll 1 pages};break} bind $txtw {catch {%W yview scroll 1 units};break} bind $txtw {catch {%W yview moveto 1};break} bind $txtw {catch {%W xview scroll -1 units};break} bind $txtw {catch {%W xview scroll 1 units};break} bind $txtw {tk_textCopy %W;break} bind $txtw {tk_textCopy %W;break} bind $txtw {%W tag add sel 0.0 end;break} bind $txtw {%W tag add sel 0.0 end;break} # Disable the cut and paste events. bind $txtw <> "break" bind $txtw <> "break" bind $txtw <2> "copy_paste_popup $txtw %X %Y" bind $txtw <3> "copy_paste_popup $txtw %X %Y" } # Save the contents of a text widget to a file proc save_viewcontents {w} { global tcl_version set types { {"Text Files" {*.txt *.log}} {"All Files" *} } set savfile [ \ tk_getSaveFile -title "Save Results Summary" \ -initialdir "." \ -filetypes $types \ -parent $w \ ] if {$savfile == ""} { return } if {[catch {set fo [open $savfile w]}]} { puts "Cannot open $savfile for writing" return } if {$tcl_version >= 9.0} {chan configure $fo -profile tcl8} puts $fo [$w.text get 1.0 end] close $fo } # Get the selected text lines, to pass to git annotate # Works with what's already selected proc get_textlines {w} { lassign [$w.text tag ranges sel] firstsel lastsel set firstline [lindex [split $firstsel "."] 0] set lastline [lindex [split $lastsel "."] 0] return [list $firstline $lastline] } # # Search functionality for text widgets # proc search_textwidget_init {} { # Initialize the globals for general text searches global cvsglb if {! [info exists cvsglb(searchstr)] } { set cvsglb(searchstr) "" } if {! [info exists cvsglb(last_searchstr)] } { set cvsglb(last_searchstr) "" } set cvsglb(searchidx) "1.0" } proc search_textwidget { wtx } { # Search the text widget global cvsglb #gen_log:log T "ENTER ($wtx)" if {$cvsglb(searchstr) != $cvsglb(last_searchstr)} { $wtx tag delete match set cvsglb(searchidx) "1.0" } $wtx tag configure sel -background gray -foreground #000000 $wtx tag raise sel $wtx tag configure match -background gray -foreground #000000 \ -relief groove -borderwidth 2 $wtx tag raise match set searchstr $cvsglb(searchstr) set match [$wtx search -- $searchstr $cvsglb(searchidx)] if {[string length $match] > 0} { set length [string length $searchstr] $wtx mark set insert $match $wtx tag add match $match "$match + ${length}c" $wtx see $match set cvsglb(searchidx) "$match + ${length}c" } set cvsglb(last_searchstr) $cvsglb(searchstr) } proc search_listbox_init {} { # Initialize the globals for searches global cvsglb if {! [info exists cvsglb(searchstr)] } { set cvsglb(searchstr) "" } if {! [info exists cvsglb(last_searchstr)] } { set cvsglb(last_searchstr) "" } set cvsglb(lsearchidx) 0 } proc search_listbox { lbx } { # Search a listbox global cvsglb global colorglb gen_log:log T "ENTER ($lbx)" #gen_log:log D "search string = \"$cvsglb(searchstr)\"" #gen_log:log D "search index = \"$cvsglb(lsearchidx)\"" set ndx [$lbx index end] if {$cvsglb(searchstr) != $cvsglb(last_searchstr)} { set cvsglb(lsearchidx) 0 for {set i 0} {$i < $ndx} {incr i} { $lbx itemconfigure $i -background $colorglb(bg) } } if {$cvsglb(lsearchidx) > $ndx} { gen_log:log D "No more matches" return } for {set i $cvsglb(lsearchidx)} {$i < $ndx} {incr i} { set str [$lbx get $i] if {[string match "*$cvsglb(searchstr)*" $str]} { gen_log:log D "MATCH $str $cvsglb(searchstr)" set cvsglb(lsearchidx) $i $lbx itemconfigure $i -background $colorglb(hlbg) $lbx see $i break } else { $lbx itemconfigure $i -background $colorglb(bg) } } set cvsglb(last_searchstr) $cvsglb(searchstr) incr cvsglb(lsearchidx) } proc dragbind {W x y} { set height [$W cget -height] if {$y < 0} {set y 0} if {$y > $height} {set y $height} set yfrac [expr {double($y) / $height}] set width [$W cget -width] if {$x < 0} {set x 0} if {$x > $height} {set x $height} set xfrac [expr {double($x) / $width}] eval $W yview moveto $yfrac eval $W xview moveto $xfrac } proc wheelbind {W D} { eval $W yview scroll [expr {-($D/120)*4}] units } # start and stop busy cursor proc busy_start {w} { foreach widget [winfo children $w] { catch {$widget config -cursor watch} } update idletasks } proc busy_done {w} { foreach widget [winfo children $w] { catch {$widget config -cursor ""} } } # Position the dialogs relative to the workdir or module browser proc dialog_position {dialog parent} { set x [winfo x $parent] set x [winfo x $parent] set X [expr {$x + 60}] set y [winfo y $parent] set Y [expr {$y + 40}] wm geometry $dialog +$X+$Y } # Read a file containing user's saved picklist variables and values proc picklist_load {} { global cvscfg global cvsglb if {! [catch {set file [open [file join $cvscfg(home) {.tkrev-picklists}] r]}]} { while {[gets $file var_name] > 0} { lappend vars $var_name while {[gets $file item] > 0} { lappend cvsglb($var_name) "$item" } } close $file } } # See if current value is in the saved list. If not, add it. # If so, promote it to the beginning (last used) proc picklist_used {var_name value} { global cvsglb gen_log:log T "ENTER ($var_name $value)" if {$value == {} } { return } if {[info exists cvsglb($var_name)]} { if {[set i [lsearch -exact $cvsglb($var_name) "$value"]] >= 0} { gen_log:log D "$value is already in cvsglb($var_name). Removing to change position" set cvsglb($var_name) [lreplace $cvsglb($var_name) $i $i] } # The value might have spaces. That's what the concat list is about. set cvsglb($var_name) [lrange [concat [list "$value"] $cvsglb($var_name)] 0 50] gen_log:log D "appending $value to cvsglb($var_name)" #lappend cvsglb($var_name) "$value" } else { gen_log:log D "Initializing variable cvsglb($var_name)!" set cvsglb($var_name) [concat [list "$value"]] } } # Save user's picklist variables and values to a file proc picklist_save {} { global cvscfg global cvsglb if {! [catch {set file [open [file join $cvscfg(home) {.tkrev-picklists}] w]}]} { foreach var_name {cvsroot directory} { puts $file $var_name set c 0 if {! [info exists cvsglb($var_name)]} { puts $file "" continue } foreach item $cvsglb($var_name) { # number of items saved is a preference if {$c >= $cvscfg(picklist_items)} {break} puts $file "$item" incr c } puts $file "" } close $file } } proc validate_dirpath {W path} { # Returning path instead of canonpath preserves tcl8.x # behavior when using that version global colorglb if {$path == ""} { return $path } set ret [tildChk $path checkresult canonpath] if {$ret} { $W configure -foreground red set checkresult 0 return $path } if {$checkresult == 1} { $W configure -foreground green $W icursor end return $path } if {![file isdirectory $path]} { $W configure -foreground red return $path } $W configure -foreground $colorglb(textfg) return $path } proc change_dir {new_dir} { global cwd set new_dir [tildecheck "$new_dir"] if {![file isdirectory "$new_dir"]} { set cwd [pwd] cvsfail "Directory $new_dir doesn\'t exist or isn't a directory" .workdir return 1 } cd "$new_dir" set cwd $new_dir gen_log:log F "CD $new_dir" # Deleting the tree discards the saved scroll position # so we start with yview 0 in a new directory if {[winfo exists .workdir]} { DirCanvas:deltree .workdir.main.tree setup_dir } if {[winfo exists .modbrowse]} { vcs_detect $cwd modbrowse_run } return 0 } # tcl/tk 9.0 won't allow tilde in filenames proc tildecheck {path} { global tcl_version if {$tcl_version < 9.0} { return $path } else { if {[catch {file tildeexpand $path} exp]} { gen_log:log E "$exp" return $exp } else { set fullpath $exp #gen_log:log F "expand: $path -> $fullpath" return $fullpath } } } # By vampm, borrowed from tkdiff proc tildChk {fnam result canon} { global tcl_version # point OUR locals AT callers Vars upvar $result resptr upvar $canon canptr # CALLER is responsible for which returned values (RetCode/result/canon) # are of logical importance within ITS specific CALLING situation # Original V8 check produced 3 possible 'result' value sets (w/o errs): # 0 - fnam doesnt exist w/RetCod=0 # 1 - fnam does exist w/RetCod=0 # FailedMsg - tilde conversion failed (no such user) w/Retcod=1 # V9 adds an ADDITIONAL output datum (canon) to those sets: # 0 - defaulted as fnam CLONE w/Retcod=1 # 1 - canonical form of converted fnam w/Retcod=0 # FailedMsg - tilde conversion failed (no user/home) w/Retcod=1 # # User EXPECTED to prefix initial fnam with './' to PREVENT tildeexpand, # although code ATTEMPTS such evaluation if tildeexpand was IMPOSSIBLE if {$tcl_version >= 9.0 && [string index $fnam 0] == "~"} { # isolate first fragment from ANY subsequent GLOB syntax # THEN perform tilde expansion on JUST 1st frag, OR (if that fails) # a DIRECT CWD filename search, again on only that 1st fragment set f1 [lindex [set frags [file split $fnam]] 0] if {![set Err [catch {file tildeexpand $f1} newf1]] || \ [llength [set nms [glob -n $f1]]]} { # If Err non-zero HERE, there IS a CWD-relative LITERAL tilde name # (of which there MUST be only a SINGLE name via the V9 GLOB) # TWO possible ways to success: if {$Err && [llength $nms] == 1} { # reassemble fnam w/FOUND literal tilde as 1st frag, THEN ... set fnam [file join $nms [lrange $frags 1 end]] } elseif {!$Err} { # reassemble fnam using tilde EXPANDED 1st fragment, THEN ... set fnam [file join $newf1 [lrange $frags 1 end]] } else { # failed: expansion was IMPOSSIBLE (w/no SINGLE LITERAL tilde) set resptr $newf1; # shove msg where it belongs set canptr $fnam; # has NO canonical form; return unaltered return $Err; # and tell caller theres a DEFINITE problem } # ...EXIT via V8 GLOB code secure it'll GLOB from PROPER (HOME/CWD) # (N.B> catch is superfluous as V9 GLOB has no reason to fault) } else { # failed: expansion was IMPOSSIBLE (AND found no LITERAL tilde) set resptr $newf1; # shove msg where it belongs set canptr $fnam; # has NO canonical form; return unaltered return $Err; # and tell caller theres a definite problem } # replicate default V9 semantic tildeexpand behavior as preparartion for V8 } else { set canptr $fnam } # (N.B> V8/V9 BOTH rely on GLOB to provide filesystem EXISTENCE of result) if {![set Err [catch {llength [set nms [glob -n $fnam]]} resptr]]} { # success, but given the V9 semantic, must overwrite canon now ... if {$resptr == 1} { set canptr $nms ; # rewrite using expanded name # ... Yet multiple names NOT permitted; TREAT the same as NONE found } else { set resptr 0 } } return $Err } tkrev_9.6.1/tkrev/cvs_subimport.tcl0000664000175000017500000001764415033645673020042 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # subimport.tcl is similar to import.tcl except that it is used for # importing to an existing module. # By: Eugene Lee, Aerospace Corporation, 10/16/03 # # Called from "Import To An Existing Module" proc cvs_subimport_setup {} { global cwd global incvs global insvn global ingit global inrcs global cvsglb gen_log:log T "ENTER" # Make sure we're not in a directory that's already under revision control lassign [vcs_detect [pwd]] incvs insvn inrcs ingit if {$incvs} { cvsok "This directory is already in CVS.\nCan\'t import here!" .import gen_log:log T "LEAVE" return } if {$insvn} { cvsok "There are Subversion directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {$ingit} { cvsok "There are Git directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {$inrcs} { cvsok "There are RCS directories here.\nPlease remove them first." .import gen_log:log T "LEAVE" return } if {[winfo exists .subimport]} { wm deiconify .subimport raise .subimport grab set .subimport gen_log:log T "LEAVE" return } # Set some defaults set cvsglb(existmodule) "" set cvsglb(newcode) [file tail $cwd] set cvsglb(newdir) $cvsglb(newcode) set cvsglb(newdesc) "" set cvsglb(newvers) "1.1.1" toplevel .subimport grab set .subimport frame .subimport.top message .subimport.top.explain -justify left -width 500 -relief groove \ -text "This will import the current directory and its sub-directories\ into an Existing CVS module." label .subimport.top.lnewcode -text "Module Name" -anchor w label .subimport.top.lnewdir -text "Path relative to \$CVSROOT" -anchor w label .subimport.top.lnewdesc -text "Descriptive Title" -anchor w label .subimport.top.lnewvers -text "Version Number" -anchor w label .subimport.top.tnewcode -textvariable cvsglb(existmodule) \ -relief sunken -width 40 -anchor w label .subimport.top.tnewdir -textvariable cvsglb(newdir) \ -relief sunken -width 40 -anchor w entry .subimport.top.tnewvers -textvariable cvsglb(newvers) -width 40 button .subimport.top.bnewcode -text "Browse ..." -command "moduleDialog" grid .subimport.top.explain -column 0 -row 0 -columnspan 3 -sticky ew grid .subimport.top.lnewcode -column 0 -row 1 -sticky w grid .subimport.top.tnewcode -column 1 -row 1 -sticky w grid .subimport.top.bnewcode -column 2 -row 1 -sticky e grid .subimport.top.lnewdir -column 0 -row 2 -sticky w grid .subimport.top.tnewdir -column 1 -row 2 -sticky w grid .subimport.top.lnewvers -column 0 -row 3 -sticky w grid .subimport.top.tnewvers -column 1 -row 3 -sticky ew frame .subimport.down -relief groove -borderwidth 2 button .subimport.down.ok -text "OK" \ -command { if {! [cvs_import_errorcheck]} { grab release .subimport wm withdraw .subimport cvs_subimport_do } } button .subimport.down.quit -text "Cancel" -command { grab release .subimport wm withdraw .subimport } pack .subimport.down -side bottom -expand yes -fill x pack .subimport.top -side top -expand yes -fill x pack .subimport.down.ok -side left -expand yes pack .subimport.down.quit -side left -expand yes wm title .subimport "Import To An Existing Module" wm minsize .subimport 1 1 # The module browser has to be running for the module selection dialog to work if {! [info exists modlist_sorted]} { modbrowse_run } gen_log:log T "LEAVE" } proc cvs_subimport_do {} { global cvs global cvsglb global cvscfg global cwd global modlist_sorted global modval gen_log:log T "ENTER" set imdir [pwd] # Error checks if {$cvsglb(existmodule) == ""} { cvsok "You must select an existing module from the repository." .subimport raise .subimport grab set .subimport return 1 } if {$cvsglb(newdir) == ""} { cvsok "You must select an existing module from the repository." .subimport raise .subimport grab set .subimport return 1 } if {$cvsglb(newvers) == ""} { cvsok "You must type in a version number." .subimport raise .subimport grab set .subimport return 1 } wm withdraw .subimport # After no more errors # See if all apropriate Directories in newdirname exist. CVS import will # create them, but we'll want to make a #D entry. set cvsglb(newdir) [string trimleft $cvsglb(newdir) "/"] set pathname [file dirname $cvsglb(newdir)] set need_Dir 0 if {$pathname != "."} { foreach idx $modlist_sorted { lappend knowndirs [lindex $idx 0] } gen_log:log D "looking for $pathname in known directories ($knowndirs)" if {$pathname ni $knowndirs} { set need_Dir 1 } } # Make a baseline tag set versions [split $cvsglb(newvers) ".,/ -"] set baseline "baseline-[join $versions {_}]" set v [viewer::new "Import Module"] set commandline "$cvs -d $cvscfg(cvsroot) import -m \"Imported using TkRev\" $cvsglb(newdir) VENDOR $baseline" $v\::log "\nCVS Import\n" $v\::do "$commandline" $v\::wait update # No need to update the modules file. cd ../ gen_log:log F "CD [pwd]" set commandline "$cvs -d $cvscfg(cvsroot) -Q release -d CVSROOT" $v\::do "$commandline" $v\::wait cd $cwd gen_log:log F "CD [pwd]" # Now check out the new module cd .. gen_log:log F "CD [pwd]" set ckmoddir $cwd # save later for use in checking out # We have to move the original stuff entirely out of the way. # Otherwise checkout won't do the whole tree. gen_log:log F "MOVE $imdir $imdir.orig" file rename $imdir $imdir.orig set $cwd $cwd.orig set commandline "$cvs -d $cvscfg(cvsroot) checkout -r$baseline \"$cvsglb(existmodule)\"" $v\::log "\nCVS Checkout\n" $v\::do "$commandline" $v\::wait set cwd $imdir.orig # cd to the checked out module. $cwd is the correct directory to cd to # only if the name of the existing module is the same as the directory name # where the source code is in. If the existing module name is different modify # ckmoddir if {$cvsglb(existmodule) != [file tail $ckmoddir]} { set ckmoddir [file join [file dirname $ckmoddir] $cvsglb(existmodule)] } change_dir $ckmoddir gen_log:log F "CD [pwd]" if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc getExistModDialog {} { global modval global ExModList ExModDirList set ExModList "" set ExModDirList "" foreach {key value} [array get modval] { if {$key != ""} { lappend ExModList $key lappend ExModDirList $value } } set ExModList [lsort $ExModList] } proc moduleDialog {} { global ExModList ExModDirList set w .modDialog grab release .subimport catch {destroy $w} toplevel $w wm title $w "Select An Existing Module" wm minsize $w 28 3 grab set $w frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m button $w.buttons.ok -text Ok -command { destroy .modDialog raise .subimport grab set .subimport } button $w.buttons.cancel -text Cancel -command { grab release .modDialog wm withdraw .modDialog } pack $w.buttons.ok -side left -expand 1 pack $w.buttons.cancel -side left -expand 1 frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview" listbox $w.frame.list -yscrollcommand "$w.frame.scroll set" -setgrid 1 -height 5 pack $w.frame.scroll -side right -fill y pack $w.frame.list -side left -expand 1 -fill both getExistModDialog set nModule [llength $ExModList] for {set i 0} {$i < $nModule} {incr i} { $w.frame.list insert end [lindex $ExModList $i] } bind $w.frame.list { set cvsglb(existmodule) [%W get [%W nearest %y]] set tmp [%W get [%W nearest %y]] set cvsglb(newdir) $tmp set index [lsearch -exact $ExModList $tmp] set cvsglb(newdir) [lindex $ExModDirList $index] } } tkrev_9.6.1/tkrev/help.tcl0000664000175000017500000017325515034126547016067 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # Help procedures and help data. # ######################################### # # Developers: Please don't majorly change the formatting of this # file unless you know what you're doing. # The script "mkmanpage.pl" builds a manpage out of it, and the # thing is the product of an unbelievable number of hours spent # tweaking this file and the script so that both the help and # the manpage look sort of OK. # # If you do add something to this, do "mkmanpage.pl > tkrev.n" # to keep the manpage in sync, then look at it to make sure # it worked. # # - dorothy ######################################### proc aboutbox {} { global cvscfg global colorglb toplevel .about wm title .about "About TkRev" frame .about.top frame .about.top.g1 message .about.top.msg1 -width 400 -justify c \ -text "\nTkRev Version $cvscfg(version)\n" -font $colorglb(guifont) pack .about.top -side top -expand 1 -fill both label .about.top.g1.gif1 -image Tclfish label .about.top.g1.gif2 -image Toothyfish label .about.top.gif3 -image Squid append string2 "A friendly graphical interface\n" append string2 "for CVS, Subversion and Git\n" append string2 "\nConsult the Help menu to\n" append string2 "learn about its features.\n\n" append string2 "TkCVS was written by Del.\n" append string2 "Later, Subversion functionality\n" append string2 "was added by Dorothy.\n" append string2 "Later still, Git functionality\n" append string2 "was added by Dorothy with some\n" append string2 "assistance from Mentor Graphics.\n" append string2 "Finally, the name was changed to TkRev.\n" message .about.top.msg3 -width 400 -justify c \ -text $string2 append about_string "Download: https://sourceforge.net/projects/tkcvs\n" message .about.top.msg4 -width 365 -justify c \ -text $about_string -font $colorglb(listboxfont) pack .about.top -side top -expand 1 -fill both pack .about.top.msg1 -expand 1 -fill x pack .about.top.g1 -side top -expand 1 -fill both pack .about.top.g1.gif1 -side left -pady 2 pack .about.top.gif3 -side top pack .about.top.g1.gif2 -side right -pady 2 pack .about.top.msg3 -expand 1 -fill x pack .about.top.msg4 -expand 1 -fill x frame .about.down button .about.down.ok -text "OK" -command {destroy .about} pack .about.down -side bottom -expand 1 -fill x -pady 2 pack .about.down.ok } proc help_cvs_version {visual} { # # This shows the banners of the available revision control systems. # global cvs global cvsglb gen_log:log T "ENTER" set cvsglb(have_cvs) 0 set cvsglb(have_svn) 0 set cvsglb(have_rcs) 0 set cvsglb(have_git) 0 set whichcvs [auto_execok $cvs] if {[llength $whichcvs]} { set whichcvs [join $whichcvs] set commandline "$cvs -v" gen_log:log C "$commandline" catch {exec {*}$commandline} cvs_output set cvsglb(have_cvs) 1 } set whichsvn [auto_execok svn] if {[llength $whichsvn]} { set whichsvn [join $whichsvn] set commandline "svn --version" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} svn_output] set cvsglb(have_svn) 1 } set whichrcs [auto_execok rcs] if {[llength $whichrcs]} { set whichrcs [join $whichrcs] set commandline "rcs --version" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} rcs_output] set cvsglb(have_rcs) 1 } set whichgit [auto_execok git] if {[llength $whichgit]} { set whichgit [join $whichgit] set commandline "git --version" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} git_output] set cvsglb(have_git) 1 } if {$visual} { set v [viewer::new "Versions"] $v\::log "-----------------------------------------\n" blue if {$cvsglb(have_cvs)} { $v\::log "$whichcvs\n$cvs_output" } else { $v\::log "$cvs was not found in your path." } $v\::log "\n-----------------------------------------\n" blue if {$cvsglb(have_svn)} { $v\::log "$whichsvn\n$svn_output" } else { $v\::log "svn was not found in your path." } $v\::log "\n-----------------------------------------\n" blue if {$cvsglb(have_rcs)} { $v\::log "$whichrcs\n$rcs_output" } else { $v\::log "rcs was not found in your path." } $v\::log "\n-----------------------------------------\n" blue if {$cvsglb(have_git)} { $v\::log "$whichgit\n$git_output" } else { $v\::log "git was not found in your path." } } gen_log:log T "LEAVE" } proc wish_version {{parent {.}}} { global tk_patchLevel set version $tk_patchLevel set whichwish [info nameofexecutable] set about_string "$whichwish\n\n" append about_string "Tk version $version" tk_messageBox -title "About Wish" \ -message $about_string \ -parent $parent \ -type ok } ###################################################################### # # text formatting routines derived from Klondike # Reproduced here with permission from their author. # # Copyright (C) 1993,1994 by John Heidemann # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # 3. The name of John Heidemann may not be used to endorse or promote products # derived from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY JOHN HEIDEMANN ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL JOHN HEIDEMANN BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # ###################################################################### # This posts the tagged text to the text widget proc post_text {tw t} { gen_log:log T "ENTER ($tw ...)" set t $t while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} { set start [lindex $inds 0] set end [lindex $inds 1] set keyword [string range $t $start $end] #set oldend [$tw index end] $tw insert end [string range $t 0 [expr {$start - 2}]] if {[string range $keyword 0 0] == "/"} { set keyword [string trimleft $keyword "/"] if {[info exists tags($keyword)] == 0} { error "end tag $keyword without beginning" } $tw tag add $keyword $tags($keyword) insert unset tags($keyword) } else { if {[info exists tags($keyword)] == 1} { error "nesting of begin tag $keyword" } set tags($keyword) [$tw index insert] } set t [string range $t [expr {$end + 2}] end] } #set oldend [$tw index end] $tw insert end $t gen_log:log T "LEAVE" } # This outputs the text in nroff format for the manpage proc put_text {t fo} { gen_log:log T "ENTER ( ...)" # Strip the first newline set t [string trimleft $t "\n"] # and trailing space set t [string trimright $t " \n"] # That should have left only internal newlines #regsub -all {\n} $t "\n.br\n" t # Bold regsub -all {} $t {\\fB} t regsub -all {} $t {\\fP} t # Italic (underline) regsub -all {} $t {\\fI} t regsub -all {} $t {\\fP} t # Section Head (SYNOPSIS, OPTIONS, etc) regsub -all {

} $t {.SH } t regsub -all {

} $t {} t # Subsection heading regsub -all {

} $t {.SS } t regsub -all {

} $t {} t # .TP "term paragraph" - Term is idented, paragraphs are indented more regsub -all {

} $t ".TP\n.B " t regsub -all {

} $t {} t # No alternate fonts in nroff regsub -all {} $t {} t regsub -all {} $t {} t # No hyperlinks but embolden regsub -all {} $t {\\fB} t regsub -all {} $t {\\fP} t # Regular paragraph regsub -all {} $t {} t regsub -all {} $t {} t # Double indent regsub -all {} $t {} t regsub -all {} $t {} t puts $fo ".PP" #foreach m [split $t "\n"] { #puts $fo "$m" #} puts $fo $t gen_log:log T "LEAVE" } proc clear_text {tw} { $tw delete 1.0 end } proc hyperlink { hviewer xpos ypos} { gen_log:log T "ENTER ($hviewer $xpos $ypos)" upvar 1 toc_dict toc_dict set i [$hviewer index @$xpos,$ypos] set range [$hviewer tag prevrange hyp $i] set linktext [eval $hviewer get $range] gen_log:log D "$linktext" dict for {section title} $toc_dict { gen_log:log D "$title: $section" if {$linktext eq $title} { gen_log:log D "$section $hviewer $title" $section $hviewer $title break } } gen_log:log T "LEAVE" } ###################################################################### # # End of text formatting routines. # ###################################################################### proc do_help {parent title helptext} { global cvscfg global cvsglb global colorglb global tcl_platform gen_log:log T "ENTER $title )" if {! [info exists colorglb(linkfg)]} { if {[colors:contrast $colorglb(textbg)] eq "#000000"} { set colorglb(linkfg) darkblue } else { set colorglb(linkfg) lightblue } } if {! [info exists cvsglb(last_searchstr)]} {set cvsglb(last_searchstr) ""} set tw .cvshelpview.top.text if {[winfo exists .cvshelpview]} { clear_text $tw wm deiconify .cvshelpview raise .cvshelpview } else { toplevel .cvshelpview frame .cvshelpview.top text $tw -setgrid yes -wrap word \ -exportselection 1 \ -width 80 -height 28 -relief sunken -borderwidth 2 \ -background $colorglb(textbg) -foreground $colorglb(textfg) \ -yscrollcommand ".cvshelpview.top.scroll set" ttk::scrollbar .cvshelpview.top.scroll -command "$tw yview" frame .cvshelpview.bot button .cvshelpview.bot.toc -text "Back to Table of Contents" \ -command "table_of_contents $parent" button .cvshelpview.bot.close -text "Close" \ -command "destroy .cvshelpview; exit_cleanup 0" button .cvshelpview.bot.searchbtn -text Search \ -command "search_textwidget .cvshelpview.top.text" entry .cvshelpview.bot.entry -width 20 -textvariable cvsglb(searchstr) bind .cvshelpview.bot.entry \ "search_textwidget .cvshelpview.top.text" pack .cvshelpview.bot -side bottom -fill x pack .cvshelpview.bot.searchbtn -side left pack .cvshelpview.bot.entry -side left pack .cvshelpview.bot.toc -side left pack .cvshelpview.bot.close -side right pack .cvshelpview.top -side top -fill both -expand y pack .cvshelpview.top.scroll -side right -fill y pack $tw -fill both -expand y wm title .cvshelpview "TkRev Help" dialog_position .cvshelpview $parent if { [tk windowingsystem] eq "x11" } { wm iconphoto .cvshelpview Help } wm minsize .cvshelpview 1 1 $tw configure -font TkTextFont set tabwidth [font measure TkTextFont -displayof $tw "\t"] set doubletab [expr {$tabwidth * 2}] # Indented paragraph, normal for text $tw tag configure pgph -lmargin1 $tabwidth -lmargin2 $tabwidth # Double-indened, fo hang under a h3 heading $tw tag configure indt -lmargin1 $doubletab -lmargin2 $doubletab # Bold $tw tag configure bld -font {-family TkHeadingFont} # Italic $tw tag configure itl -font {-family TkTextFont -slant italic} # Section Head (SYNOPSIS, OPTIONS, etc) $tw tag configure h1 -font {-family TkTextFont -weight bold} -lmargin1 0 -lmargin2 0 # Subsection heading $tw tag configure h2 -font {-family TkTextFont -weight bold} # term for "term paragraph" #$tw tag configure h3 -font {-family TkTextFont} $tw tag configure h3 -font {-family TkTooltipFont -weight bold} # Code block in monospace font $tw tag configure cmp -font Courier # Hyperlink $tw tag configure hyp -font TkTextFont -underline 1 -foreground $colorglb(linkfg) $tw mark set insert 0.0 $tw tag bind hyp "hyperlink $tw %x %y" $tw tag bind hyp "$tw config -cursor hand2" $tw tag bind hyp "$tw config -cursor {}" ro_textbindings $tw } post_text $tw "

$title

\n\n$helptext" gen_log:log T "LEAVE ($tw)" } proc define_sections {} { # Make it available above upvar 1 toc_dict toc_dict set toc_dict [dict create \ man_description "Overview" \ man_cli_options "Command Line Options" \ man_current_directory "Current Directory Browser" \ man_module_browser "Repository Browser" \ man_branch_diagram_browser "Branch Diagram Browser" \ man_directory_branch_viewer "Directory Merge Tool for CVS" \ man_importing_new_modules "Importing New Modules" \ man_importing_to_existing_module "Importing to an Existing Module" \ man_vendor_merge "Vendor Merge for CVS" \ man_configuration_files "TkRev Configuration Files" \ man_user_defined_menu "User Defined Menu" \ man_cvs_modules_file "CVS Modules File" \ man_environment_variables "Environment" \ ] } proc table_of_contents {parent} { gen_log:log T "ENTER ($parent)" upvar 1 toc_dict toc_dict # Run the proc where the list is defined define_sections # Generate the text for the ToC dict for {procname title} $toc_dict { #gen_log:log D "procname $title" append toc_list "$title\n" append toc_list "\n" } # Post the ToC if {[winfo exists .cvshelpview]} { clear_text .cvshelpview.top.text post_text .cvshelpview.top.text "

$title

\n\n$toc_list" } else { do_help $parent "Table of Contents" $toc_list } gen_log:log T "LEAVE" } # # Help procedures for the TkRev users guide. # proc man_description {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { tkrev [-dir directory] [-root cvsroot] [-win workdir|module|merge] tkrev [-log|blame file] tkrev file - same as tkrev -log file } set help_body_2 { TkRev is a Tcl/Tk-based graphical interface to the CVS, Subversion and Git configuration management systems. It displays the status of the files in the current working directory, and provides buttons and menus to execute configuration-management commands on the selected files. Limited RCS functionality is also present. Git functionality is new in version 9. TkDiff is bundled in for browsing and merging your changes. TkRev also aids in browsing the repository. For Subversion, the repository tree looks like an ordinary file tree. For CVS, the CVSROOT/modules file is read. TkRev extends CVS with a method to produce a browsable, "user friendly" listing of modules. This requires special comments in the CVSROOT/modules file. See the CVS Modules File section for more guidance. } # In the manpage, this is two sections, but in the help, it's one if {$manpage ne ""} { puts $manpage ".SH SYNOPSIS" put_text $help_body_1 $manpage puts $manpage ".SH DESCRIPTION" put_text $help_body_2 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 } } # End man_description proc man_cli_options {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { TkRev accepts the following options

-d, --dir

directory Start TkRev in the specified directory

-h, --help

Print a usage message

-l, --log

file Invoke a log browser for the specified file

-b, --blame

file Invoke a blame (annotation) browser for the specified file

-v, --vcs

cvs|svn|git|rcs Use the specified version control system

-r, --root

cvsroot Use the specified repository root

-w, --win

workdir|module|merge Start by displaying the directory browser (the default), the module browser, or the directory-merge tool. -win and -log are mutually exclusive. } set help_body_2 {

Examples

Browse the modules located in CVSROOT /jaz/repository: % tkrev --win module --root /jaz/repository View the log of the file tstheap.c: % tkrev ---log tstheap.c } if {$manpage ne ""} { puts $manpage ".SH OPTIONS" put_text $help_body_1 $manpage put_text $help_body_2 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 } } # End man_cli_options proc man_current_directory {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { The working directory browser shows the files in your local working copy, or "sandbox." It shows the status of the files at a glance and provides tools to help with most of the common version control operations you might do. At the top of the browser you will find: * The name of the current directory. You can change directories by typing in this field. Recently visited directories are saved in the picklist. * The relative path of the current directory in the repository. If it is not contained in the repository you may import it using the menu or toolbar button. * A Directory Tag name, if the directory is contained in the repository and it has been checked out against a particular branch or tag. In Subversion, the branch or tag is inferred from the URL based on the conventional trunk-branches-tags repository organization. * The repository location of the current directory - CVSROOT if it's under CVS control, the URL of the Subversion repository if it's under Subversion control, or the origin if it's controlled by Git. If not a version-controlled directory, it may default to the value of the $CVSROOT environment variable. The main part of the working directory browser is a list of the files in the current directory with an icon next to each showing its status. You select a file by clicking on its name or icon once with the left mouse button. Holding the Control key while clicking will add the file to the group of those already selected. You can select a contiguous group of files by holding the Shift key while clicking. You can also select a group of files by dragging the mouse with the middle or right button pressed to select an area. Selecting an item that's already selected de-selects that item. To unselect all files, click the left mouse button in an empty area of the file list. * The Date column (can be hidden) shows the modification time of the file is shown. The format of the date column may be specified with cvscfg(dateformat). The default format was chosen because it sorts the same way alphabetically as chronologically. If the directory belongs to a revision system, other columns are present. * The revision column shows which revision of the file is checked out, and whether it's on the trunk or on a branch. * The status column (can be hidden) shows the revision of the file spelled out in text. This information is mostly redundant to the icon in the file column. * The Editor/Author/Locker column (can be hidden) varies according to revision system. In Subversion, the author of the most recent checkin is shown. In CVS, it shows a list of people editing the files if your site uses "cvs watch" and/or "cvs edit". Otherwise, it will be empty. In RCS, it shows who, if anyone, has the file locked. The optional columns can be displayed or hidden using the Options menu. You can move into a directory by double-clicking on it. Double clicking on a file will load the file into a suitable editor so you can change it. A different editor can be used for different file types (see Configuration Files). } set help_body_2 {

File Status

When you are in a directory that is under CVS, Subversion, or Git control, the file status will be shown by an icon next to each file. Checking the "Status Column" option causes the status to be displayed in text in its own column. Some possible statuses are:

Up-to-date

The file is up to date with respect to the repository.

Locally Modified

The file has been modified in the current directory since being checked out of the repository.

Locally Added

The file has been added to the repository. This file will become permanent in the repository once a commit is made.

Locally Removed

You have removed the file with remove, and not yet committed your changes.

Needs Checkout

Someone else has committed a newer revision to the repository. The name is slightly misleading; you will ordinarily use update rather than checkout to get that newer revision.

Needs Patch

Like Needs Checkout, but the CVS server will send a patch rather than the entire file. Sending a patch or sending an entire file accomplishes the same thing.

Needs Merge

Someone else has committed a newer revision to the repository, and you have also made modifications to the file.

Unresolved Conflict

This is like Locally Modified, except that a previous update command gave a conflict. You need to resolve the conflict before checking in.

?

The file is not contained in the repository. You may need to add the file to the repository by pressing the "Add" button.

[directory:CVS]

A directory which has been checked out from a CVS repository.

[directory:SVN]

A directory which has been checked out from a Subversion repository. In Subversion, directories are themselves versioned objects.

[directory:RCS]

A directory which contains an RCS sub-directory or some files with the ,v suffix, presumably containing some files that are under RCS revision control.

[directory:GIT]

A directory which has been cloned from a Git repository.

[directory]

A directory not controlled by one of the supported revision control systems } set help_body_3 {

File Filters

Clean

You can specify file matching patterns to instruct TkRev which files you wish to see. You can also specify patterns telling it which files to remove when you press the "Clean" button or select the File -> Cleanup menu item.

Hide

"Hide" works exactly the way a .cvsignore file works. That is, it causes non-CVS files with the pattern to be ignored. It's meant for hiding .o files and such. Any file under CVS control will be listed anyway.

Show

"Show" is the inverse. It hides non-CVS files except for those with the pattern.

Buttons

Module Browser:

The big button at the upper right opens the module browser opens a module browser window which will enable you to explore items in the repository even if they're not checked out. In CVS, this requires that there be entries in the CVSROOT/modules file. Browsing can be improved by using TkRev-specific comments in CVSROOT/modules.

Go Up:

The button to the left of the entry that shows the current directory. Press it and you go up one level. } set help_body_4 { There are a number of buttons at the bottom of the window. Pressing on one of these causes the following actions:

Delete:

Press this button to delete the selected files. The files will not be removed from the repository. To remove the files from the repository as well as delete them, press the "Remove" button instead.

Edit:

Press this button to load the selected files in to an appropriate editor.

View:

Press this button to view the selected files in a Tk text window. This can be a lot faster then Edit, in case your preferred editor is xemacs or something of that magnitude.

Refresh:

Press this button to re-read the current directory, in case the status of some files may have changed.

Status Check:

Shows, in a searchable text window, the status of all the files. By default, it is recursive and lists unknown (?) files. These can be changed in the Options menu.

Directory Branch Browser:

For merging the entire directory. In Subversion, it opens the Branch Browser for "." In CVS, it chooses a "representative" file in the current directory and opens a graphical tool for directory merges.

Log (Branch) Browse:

This button will bring up the log browser window for each of the selected files in the window. See the Branch Diagram Browser section.

Annotate:

This displays a window in which the selected file is shown with the lines highlighted according to when and by whom they were last revised. In Subversion, it's also called "blame."

Diff:

This compares the selected files with the equivalent files in the repository. A separate program called "TkDiff" (also supplied with TkRev) is used to do this. For more information on TkDiff, see TkDiff's help menu.

Merge Conflict:

If a file's status says "Needs Merge", "Conflict", or is marked with a "C" in CVS Check, there was a difference which CVS needs help to reconcile. This button invokes TkDiff with the -conflict option, opening a merge window to help you merge the differences.

Check In:

This button commits your changes to the repository. This includes adding new files and removing deleted files. When you press this button, a dialog will appear asking you for the version number of the files you want to commit, and a comment. You need only enter a version number if you want to bring the files in the repository up to the next major version number. For example, if a file is version 1.10, and you do not enter a version number, it will be checked in as version 1.11. If you enter the version number 3, then it will be checked in as version 3.0 instead. It is usually better to use symbolic tags for that purpose. If you use rcsinfo to supply a template for the comment, you must use an external editor. Set cvscfg(use_cvseditor) to do this. For checking in to RCS, an externel editor is always used.

Update:

This updates your sandbox directory with any changes committed to the repository by other developers.

Update with Options:

Allows you to update from a different branch, with a tag, with empty directories, and so on.

Add Files:

Press this button when you want to add new files to the repository. You must create the file before adding it to the repository. To add some files, select them and press the Add Files button. The files that you have added to the repository will be committed next time you press the Check In button. It is not recursive. Use the menu CVS -> Add Recursively for that.

Remove Files:

This button will remove files. To remove files, select them and press the Remove button. The files will disappear from the directory, and will be removed from the repository next time you press the Check In button. It is not recursive. Use the menu CVS -> Remove Recursively for that.

Tag:

This button will tag the selected files. In CVS, the -F (force) option will move the tag if it already exists on the file.

Branch Tag:

This button will tag the selected files, creating a branch. In CVS, the -F (force) option will move the tag if it already exists on the file.

Lock (CVS and RCS):

Lock an RCS file for editing. If cvscfg(cvslock) is set, lock a CVS file. Use of locking is philosophically discouraged in CVS since it's against the "concurrent" part of Concurrent Versioning System, but locking policy is nevertheless used at some sites. One size doesn't fit all.

Unlock (CVS and RCS):

Unlock an RCS file. If cvscfg(cvslock) is set, unlock a CVS file.

Set Edit Flag (CVS):

This button sets the edit flag on the selected files, enabling other developers to see that you are currently editing those files (See "cvs edit" in the CVS documentation).

Reset Edit Flag (CVS):

This button resets the edit flag on the selected files, enabling other developers to see that you are no longer editing those files (See "cvs edit" in the CVS documentation). As the current version of cvs waits on a prompt for "cvs unedit" if changes have been made to the file in question (to ask if you want to revert the changes to the current revision), the current action of tkrev is to abort the unedit (by piping in nothing to stdin). Therefore, to lose the changes and revert to the current revision, it is necessary to delete the file and do an update (this will also clear the edit flag). To keep the changes, make a copy of the file, delete the original, update, and then move the saved copy back to the original filename.

Close:

Press this button to close the Working Directory Browser. If no other windows are open, TkRev exits. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body_1 $manpage put_text $help_body_2 $manpage put_text $help_body_3 $manpage put_text $help_body_4 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 post_text $wn $help_body_3 post_text $wn $help_body_4 } } # #nd man_current_directory proc man_branch_diagram_browser {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { The TkRev Log Browser window enables you to view a graphical display of the revision log of a file, including all previous versions and any branched versions. You can get to the log browser window in three ways, either by invoking it directly with tkrev [-log] filename, by selecting a file in the main window of TkRev and pressing the Log Browse button, or by selecting a file in a list invoked from the module browser and pressing the Log Browse button. If the Log Browser is examining a checked-out file, the buttons for performing merge operations are enabled.

Log Browser Window

The log browser window has three components. These are the file name and version information section at the top, the log display in the middle, and a row of buttons along the bottom.

Log Display

The main log display is fairly self explanatory. It shows a group of boxes connected by lines indicating the main trunk of the file development (on the left hand side) and any branches that the file has (which spread out to the right of the main trunk). Each box contains the version number, author of the version, and other information determined by the menu Diagram -> Revision Layout. Constructing the branch diagram from Subversion is inefficient, so the Log Browser counts the tags when doing a Subversion diagram and pops up a dialog giving you a chance to skip the tag step if there are too many tags (where "many" arbitrarily equals 10.)

Version Numbers

Once a file is loaded into the log browser, one or two version numbers may be selected. The primary version (Selection A) is selected by clicking the left mouse button on a version box in the main log display. The secondary version (Selection B) is selected by clicking the right mouse button on a version box in the main log display. Operations such as "View" and "Annotate" operate only on the primary version selected. Operations such as "Diff" and "Merge Changes to Current" require two versions to be selected.

Searching the Diagram

You can search the canvas for tags, revisions, authors, and dates. The following special characters are used in the search pattern: * Matches any sequence of characters in string, including a null string. ? Matches any single character in string. [chars] Matches any character in the set given by chars. If a sequence of the form x-y appears in chars, then any character between x and y, inclusive, will match. \\x Matches the single character x. This provides a way of avoiding interpretation of the spacial characters in a pattern. If you only enter "foo" (without the quotes) in the entry box, it searches the exact string "foo". If you want to search all strings starting with "foo", you have to put "foo*". For all strings containing "foo", you must put "*foo*".

Log Browser Buttons

The log browser contains the following buttons:

Refresh:

Re-reads the revision history of the file

View:

Pressing this button displays a Tk text window containing the version of the file at Selection A.

Annotate:

This displays a window in which the file is shown with its lines highlighted according to when and by whom they were last revised. In Subversion, it's also called "blame."

Diff:

Pressing this button runs the "tkdiff" program to display the differences between version A and version B.

Merge:

To use this button, select a branch version of the file, other than the branch you are currently on, as the primary version (Selection A). The changes made along the branch up to that version will be merged into the current version, and stored in the current directory. Optionally, select another version (Selection B) and the changes will be from that point rather than from the base of the branch. The version of the file in the current directory will be merged, but no commit will occur. Then you inspect the merged files, correct any conflicts which may occur, and commit when you are satisfied. Optionally, TkRev will tag the version that the merge is from. It suggests a tag of the form "mergefrom_rev_date." If you use this auto-tagging function, another dialog containing a suggested tag for the merged-to version will appear. It's suggested to leave the dialog up until you are finished, then copy-and-paste the suggested tag into the "Tag" dialog. It is always a good practice to tag when doing merges, and if you use tags of the suggested form, the Branch Browser can diagram them. (Auto-tagging is not implemented in Subversion because, despite the fact that tags are "cheap," it's somewhat impractical to auto-tag single files. You can do the tagging manually, however.)

View Tags:

This button lists all the tags applied to the file in a searchable text window.

Close:

This button closes the Log Browser. If no other windows are open, TkRev exits. } set help_body_2 {

The Diagram Menu

The Diagram Menu allows you to control what you see in the branch diagram. You can choose how much information to show in the boxes, whether to show empty revisions, and whether to show tags. You can even control the size of the boxes. If you are using Subversion, you may wish to turn the display of tags off. If they aren't asked for they won't be read from the repository, which can save a lot of time. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body_1 $manpage put_text $help_body_2 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 } } # End man_branch_diagram_browser proc man_directory_branch_viewer {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { The Directory Merge Tool chooses a "representative" file in the current directory and diagrams the branch tags. It tries to pick the "bushiest" file, or failing that, the most-revised file. If you disagree with its choice, you can type the name of another file in the top entry and press Return to diagram that file instead. The main purpose of this tool is to do merges (cvs update -j rev [-j rev]) on the whole directory. For merging one file at a time, you should use the Log Browser. You can only merge to the line (trunk or branch) that you are currently on. Select a branch to merge from by clicking on it. Then press either the "Merge" or "Merge Changes" button. The version of the file in the current directory will be over-written, but it will not be committed to the repository. You do that after you've reconciled conflicts and decided if it's what you really want.

Merge Branch to Current:

The changes made on the branch since its beginning will be merged into the current version.

Merge Changes to Current:

Instead of merging from the base of the branch, this button merges the changes that were made since a particular version on the branch. It pops up a dialog in which you fill in the version. It should usually be the version that was last merged. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_directory_branch_viewer proc man_module_browser {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { Operations that are performed on the repository instead of in a checked-out working directory are done with the Module Browser. The most common of these operations is checking out or exporting from the repository. The Module Browser can be started from the command line (tkrev -win module) or started from the main window by pressing the big button. Subversion repositories can be browsed like a file tree, and that is what you will see in the Module Browser. CVS repositories aren't directly browsable, but if the CVSROOT/modules file is maintained appropriately, TkRev can display the modules and infer tree structures if they are present. See the CVS Modules File section. Using the module browser window, you can select a module to check out. When you check out a module, a new directory is created in the current working directory with the same name as the module.

Tagging and Branching (cvs rtag)

You can tag particular versions of a module or file in the repository, with plain or branch tags, without having the module checked out.

Exporting

Once a software release has been tagged, you can use a special type of checkout called an export. This allows you to cleanly check out files from the repository, without all of the administrivia that CVS needs to have while working on the files. It is useful for delivery of a software release to a customer.

Importing

TkRev contains a special dialog to allow users to import new files into the repository. In CVS, new modules can be assigned places within the repository, as well as descriptive names (so that other people know what they are for). When the Module Browser displays a CVS repository, the first column is a tree showing the module codes and directory names of all of the items in the repository. The icon shows whether the item is a directory (which may contain other directories or modules), or whether it is a module (which may be checked out from TkRev). It is possible for an item to be both a module and a directory. If it has a red ball on it, you can check it out. If it shows a plain folder icon, you have to open the folder to get to the items that you can check out. To select a module, click on it with the left mouse button. The right mouse button will perform a secondary selection, which is used only for Subversion diff and patch. To clear the selection, click on the item again or click in an empty area of the module column. There can only be one primary and one secondary selection.

Repository Browser Buttons

The module browser contains the following buttons:

Who:

CVS only. Shows which modules are checked out by whom.

Import:

This item will import the contents of the current directory (the one shown in the Working Directory Browser) into the repository as a module. See the section titled Importing for more information.

File Browse:

Displays a list of the selected module's files. From the file list, you can view the file, browse its revision history, or see a list of its tags.

Check Out:

Checks out the current version of a module. A dialog allows you to specify a tag, change the destination, and so on.

Export:

Exports the current version of a module. A dialog allows you to specify a tag, change the destination, and so on. Export is similar to check-out, except exported directories do not contain the CVS or administrative directories, and are therefore cleaner (but cannot be used for checking files back in to the repository). You must supply a tag name when you are exporting a module to make sure you can reproduce the exported files at a later date.

Tag:

This button tags an entire module.

Branch Tag:

This creates a branch of a module by giving it a branch tag.

Patch Summary:

This item displays a short summary of the differences between two versions of a module.

Create Patch File:

This item creates a Larry Wall format patch(1) file of the module selected.

Close:

This button closes the Repository Browser. If no other windows are open, TkRev exits. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_module_browser proc man_importing_new_modules {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { Before importing a new module, first check to make sure that you have write permission to the repository. Also you'll have to make sure the module name is not already in use. To import a module you first need a directory where the module is located. Make sure that there is nothing in this directory except the files that you want to import. Press the big "Repository Browser" button in the top part of the tkrev UI, or use CVS -> Import WD into Repository from the menu bar. In the module browser, press the Import button on the bottom, the one that shows a folder and an up arrow. In the dialog that pops up, fill in a descriptive title for the module. This will be what you see in the right side of the module browser. OK the dialog. Several things happen now. The directory is imported, the CVSROOT/module file is updated, your original directory is saved as directory.orig, and the newly created module is checked out. When it finishes, you should find the original Working Directory Browser showing the files in the newly created, checked out module. Here is a more detailed description of the fields in the Import Dialog.

Module Name:

A name for the module. This name must not already exist in the repository. Your organization could settle on a single unambiguous code for modules. One possibility is something like: [project code]-[subsystem code]-[module code]

Module Path:

The location in the repository tree where your new module will go.

Descriptive Title:

A one-line descriptive title for your module. This will be displayed in the right-hand column of the browser.

Version Number:

The current version number of the module. This should be a number of the form X.Y.Z where .Y and .Z are optional. You can leave this blank, in which case 1 will be used as the first version number. } set help_body_2 { Importing a directory into Subversion is similar but not so complicated. You use the SVN -> Import CWD into Repository menu. You need supply only the path in the repository where you want the directory to go. The repository must be prepared and the path must exist, however. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body_1 $manpage put_text $help_body_2 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 } } # End man_importing_new_modules proc man_importing_to_existing_module {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { Before importing to an existing module, first check to make sure that you have write permission to the repository. To import to an existing module you first need a directory where the code is located. Make sure that there is nothing in this directory (including no CVS directory) except the files that you want to import. Open up the Repository Browser by selecting File -> Browse Modules from the menu bar. In the Repository Browser, select File -> Import To An Existing Module from the menu bar. In the dialog that pops up, press the Browse button and select the name of an existing module. Press the OK to close this dialog box. Enter the version number of the code to be imported. OK the dialog. Several things happen now. The directory is imported, your original directory is saved as directory.orig, and the newly created module is checked out. When it finishes, you will find the original Working Directory Browser showing the original code. If you press the "Re-read the current directory" button you will see the results of the checked out code. Here is a more detailed description of the fields in the Import Dialog.

Module Name:

A name for the existing module. Filled in by the use of the the Browse button

Module Path:

The location in the repository tree where the existing module is. Filled in by the use of the Browse button.

Version Number:

The current version number of the module to be imported. This should be a number of the form X.Y.Z where .Y and .Z are optional. You can leave this blank, in which case 1 will be used as the first version number. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_importing_to_existing_mdoule proc man_vendor_merge {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { Software development is sometimes based on source distribution from a vendor or third-party distributor. After building a local version of this distribution, merging or tracking the vendor's future release into the local version of the distribution can be done with the vendor merge command. The vendor merge command assumes that a separate module has already been defined for the vendor or third-party distribution with the use of the "Import To A New Module" and "Import To An Existing Module" commands. It also assumes that a separate module has already been defined for the local code for which the vendor merge operation is to be applied to. Start from an empty directory and invoke tkrev. Open up the Repository Browser by selecting File -> Browse Modules from the menu bar. Checkout the module of the local code to be merged with changes from the vendor module. (Use the red icon with the down arrow) In the Repository Browser, after verifying that the Module entry box still has the name the module of the local code to which the vendor code is to be merged into, select File/Vendor Merge from the menu bar. In the Module Level Merge With Vendor Code window, press the Browse button to select the module to be used as the vendor module. OK the dialog. All revisions from the vendor module will be shown in the two scroll lists. Fill in the From and To entry boxes by clicking in the appropriate scroll lists. Ok the dialog. Several things happens now. Several screens will appear showing the output from cvs commands for (1)checking out temp files, (2)cvs merge, and (3)cvs rdiff. Information in these screens will tell you what routines will have merge conflicts and what files are new or deleted. After perusing the files, close each screen. (In the preceding dialog box, there was an option to save outputs from the merge and rdiff operations to files CVSmerge.out and CVSrdiff.out.) The checked out local code will now contain changes from a merge between two revisions of the vendor modules. This code will not be checked into the repository. You can do that after you've reconciled conflicts and decide if that is what you really want. A detailed example on how to use the vendor merge operation is provided in the PDF file vendor5readme.pdf. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_vendor_merge proc man_configuration_files {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { There are two configuration files for TkRev. The first is stored in the directory in which the *.tcl files for TkRev are installed. This is called tkrev_def.tcl. You can put a file called site_def in that directory, too. That's a good place for site-specific things like tagcolours. Unlike tkrev_def.tcl, it will not be overwritten when you install a newer version of TkRev. Values in the site configuration files can be over-ridden at the user level by placing a .tkrev file in your home directory. Commands in either of these files should use Tcl syntax. In other words, to set a variable name, you should have the following command in your .tkrev file: set variablename value for example: set cvscfg(editor) "gvim" The following variables are supported by TkRev:

Startup

cvscfg(startwindow)

Which window you want to see on startup. (workdir or module)

cvscfg(vcspref)

When more than one revision control system is present in a directory, this specifies an order of precedence. The default order is {cvs svn git rcs}

GUI

tk scaling

In case your display resolution is unusual, you can scale all the text to make the UI larger or smaller. For example tk scaling 1.9 would make it almost double size.

cvscfg(large_icons)

If not zero, the UI icons will be displayed at double size

cvscfg(match_desktop)

If true, tkrev will attempt to detect colors set by the desktop environment, whether gtk or CDE. It's turned off by default, because it's experimental, except for CDE which has been there since CDE was in general use.

CVS

cvscfg(cvsroot)

If set, it overrides the CVSROOT environment variable.

Subversion

If your SVN repository has a structure similar to trunk, branches, and tags but with different names, you can tell TkRev about it by setting variables in tkrev_def.tcl: set cvscfg(svn_trunkdir) "elephants" set cvscfg(svn_branchdir) "dogs" set cvscfg(svn_tagdir) "ducklings" The branch browser depends on the convention of having a trunk, branches, and tags structure to draw the diagram. These variables may give you a little more flexibility.

GIT

cvscfg(gitdetail)

Set to true or false. If it's false (off) an individual Git log call to each file will be suppressed to save time. You won't see the hashtag or committer in that case.

cvscfg(gitmaxhist)

For the branch visualizer. Tells how far back into the history to go. Default is 250 commits.

cvscfg(picklist_items)

Maximum number of visited directories and repositories to save in the picklist history

Log browser

cvscfg(colourA), cvscfg(colourB)

Hilight colours for revision-log boxes

cvscfg(tagdepth)

Number of tags you want to see for each revision on the branching diagram before it says "more..." and offers a pop-up to show the rest

cvscfg(toomany_tags)

Maximum number of tags in a Subversion repository to process and display

cvscfg(tagcolour,tagstring)

Colors for marking tags. For example: set cvscfg(tagcolour,tkcvs_r6) Purple

Module browser

cvscfg(aliasfolder)

In the CVS module browser, if true this will cause the alias modules to be grouped in one folder. Cleans up clutter if there are a lot of aliases.

User preferences

cvscfg(allfiles)

Set this to false to see normal files only in the directory browser. Set it to true to see all files including hidden files.

cvscfg(auto_status)

Set the default for automatic status-refresh of a version-controlled directory. Automatic updates are done when a directory is entered and after some operations.

cvscfg(auto_tag)

Whether to tag the merged-from revision when using TkRev to merge different revisions of files by default. A dialog still lets you change your mind, regardless of the default.

cvscfg(confirm_prompt)

Ask for confirmation before performing an operation(true or false)

cvscfg(dateformat)

Format for the date string shown in the "Date" column, for example "%Y/%m/%d %H:%M"

cvscfg(cvslock)

Set to true to turn on the ability to use cvs-admin locking from the GUI.

cvscfg(econtrol)

Set this to true to turn on the ability to use CVS Edit and Unedit, if your site is configured to allow the feature.

cvscfg(editor)

Preferred default editor

cvscfg(editors)

String pairs giving the editor-command and string-match-pattern, for deciding which editor to use

cvscfg(editorargs)

Command-line arguments to send to the default editing program.

cvscfg(mergetoformat), cvscfg(mergefromformat)

Format for mergeto- and mergefrom- tags. The _BRANCH_ part must be left as-is, but you can change the prefix and the date format, for example "mergeto_BRANCH_%d%b%y". The date format must be the same for both. CVS rule: a tag must not contain the characters `$,.:;@'

cvscfg(recurse)

Whether reports are recursive (true or false)

cvscfg(savelines)

How many lines to keep in the trace window

cvscfg(status_filter)

Filter out unknown files (status "?") from CVS Check and CVS Update reports.

cvscfg(use_cvseditor)

Let CVS invoke an editor for commit log messages rather than having tkrev use its own input box. By doing this, your site's commit template (rcsinfo) can be used.

File filters

cvscfg(show_file_filter)

Pattern for which files to list. Empty string is equivalent to the entire directory (minus hidden files)

cvscfg(ignore_file_filter)

Pattern used in the workdir filter for files to be ignored

cvscfg(clean_these)

Pattern to be used for cleaning a directory (removing unwanted files)

System

cvscfg(print_cmd)

System command used for printing. lpr, enscript -Ghr, etc)

cvscfg(shell)

What you want to happen when you ask for a shell

cvscfg(terminal)

Command prefix to use to run something in a terminal window

Portability

cvscfg(aster)

File mask for all files (* for Unix, *.* for windows)

cvscfg(null)

The null device. /dev/null for Unix, nul for windows

cvscfg(tkdiff)

How to start tkdiff. Example sh /usr/local/bin/tkdiff

cvscfg(tmpdir)

Directory in which to do behind-the-scenes checkouts. Usually /tmp or /var/tmp)

Debugging

cvscfg(log_classes)

Types of debug output in the trace window: C=commands, E=command stderr, S=command stdout, T=Function entry/exit, D=Debugging, F=File creation/deletion

cvscfg(logging)

Logging (debugging) on or off } if {$manpage ne ""} { puts $manpage ".SH FILES" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_configuration_files proc man_environment_variables {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { If you use CVS, you can set the CVSROOT environment variable to point to the location of your default CVS repository. The Module Browser will look for SVNROOT and GITROOT as well, although those have no meaning to SVN or Git respectively. If you like to set some color preferences in .Xdefaults or .Xresources, these can be used: tkrev*background: gray80 tkrev*foreground: black tkrev*Menu.background: gray65 tkrev*Menu.foreground: white tkrev*Button.background: gray75 tkrev*Button.foreground: black tkrev*Canvas.background: gray90 tkrev*Canvas.foreground: black tkrev*Text.background: gray90 tkrev*Text.foreground: black tkrev*Text.selectBackground: slateblue tkrev*Text.selectForeground: white tkrev*Menu.font: {Serif 12} tkrev*Button.font: {Serif 11} tkrev*Label.font: {Cantarell 10} tkrev*List.font: {Cantarell 10} tkrev*Text.font: {DejaVu Sans Mono 10} } if {$manpage ne ""} { puts $manpage ".SH ENVIRONMENT" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_environment_variables proc man_user_defined_menu {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body_1 { It is possible to extend the TkRev menu by inserting additional commands into the .tkrev or tkrev_def.tcl files. These extensions appear on an extra menu to the right of the TkRev Options menu. To create new menu entries on the user-defined menu, set the following variables:

cvsmenu(command)

Setting a variable with this name to a value like "commandname" causes the CVS command "cvs commandname" to be run when this menu option is selected. For example, the following line: set cvsmenu(update_A) "update -A" Causes a new menu option titled "update_A" to be added to the user defined menu that will run the command "cvs update -A" on the selected files when it is activated. (This example command, for versions of CVS later than 1.3, will force an update to the head version of a file, ignoring any sticky tags or versions attached to the file).

usermenu(command)

Setting a variable with this name to a value like "commandname" causes the command "commandname" to be run when this menu option is selected. For example, the following line: set usermenu(view) "cat" Causes a new menu option titled "view" to be added to the User defined menu that will run the command "cat" on the selected files when it is activated. } set help_body_2 { Any user-defined commands will be passed a list of file names corresponding to the files selected on the directory listing on the main menu as arguments. The output of the user defined commands will be displayed in a window when the command is finished. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body_1 $manpage put_text $help_body_2 $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body_1 post_text $wn $help_body_2 } } # End man_user_defined_menu proc man_cvs_modules_file {wn title {manpage {}} } { gen_log:log T "ENTER ($wn $title)" set help_body { If you haven't put anything in your CVSROOT/modules file, please do so. See the "Administrative Files" section of the CVS manual. Then, you can add comments which TkRev can use to title the modules and to display them in a tree structure. The simplest use of TkRev's "#D" directive is to display a meaningful title for the module: #D softproj Software Development Projects softproj softproj A fancier use is to organize the modules into a tree which will mimic their directory nesting in the repository when they appear in the module browser. For example, suppose we have a directory called "chocolate" which is organized like this: chocolate/ truffle/ cocoa3/ biter/ sniffer/ snuffler/ To display its hierarchy, as well as make the deepest directories more accessible by giving them module names, we could put this in the modules file: #D chocolate Top Chocolate #D chocolate/truffle Cocoa Level 2 #D chocolate/truffle/cocoa3 Cocoa Level 3 #D sniffer Chocolate Sniffer sniffer chocolate/truffle/cocoa3/sniffer #D snuff Chocolate Snuffler snuff chocolate/truffle/cocoa3/snuffler #D biter Chocolate Biter biter chocolate/truffle/cocoa3/biter When you are installing TkRev, you may like to add these additional lines to the modules file (remember to check out the modules module from the repository, and then commit it again when you have finished the edits). These extension lines commence with a "#" character, so CVS interprets them as comments. They can be safely left in the file whether you are using TkRev or not. "#M" is equivalent to "#D". The two had different functions in previous versions of TkRev, but now both are parsed the same way. } if {$manpage ne ""} { puts $manpage ".SH $title" put_text $help_body $manpage } else { clear_text $wn post_text $wn "

$title

\n" post_text $wn $help_body } } # End man_cvs_modules tkrev_9.6.1/tkrev/menubar.tcl0000664000175000017500000004513015015446517016557 0ustar dorothyrdorothyr# The menus for the top menubar(s) # First, set up the more or less universal ones that we want # on all toplevels proc menubar_menus {topwin} { global cvscfg global colorglb global cvsmenu global usermenu global execmenu global bookmarks global git_log_opt global ingit gen_log:log T "ENTER" set startdir "[pwd]" if {[winfo exists $topwin.menubar]} { destroy $topwin.menubar } menu $topwin.menubar $topwin.menubar add cascade -label "TkRev" -menu [menu $topwin.menubar.about] $topwin.menubar.about configure about_menus $topwin.menubar.about $topwin.menubar add cascade -label "File" -menu [menu $topwin.menubar.file] -underline 0 $topwin.menubar.file configure if {$topwin eq ".workdir"} { $topwin.menubar add cascade -label "Options" -menu [menu $topwin.menubar.options] -underline 0 $topwin.menubar.options configure } # Add the git tools menu to all main windows. It will be hidden if not needed. git_tools_menu $topwin if {$topwin eq ".workdir" || $topwin eq ".modbrowse"} { $topwin.menubar add cascade -label "Go" -menu [menu $topwin.menubar.goto] -underline 0 $topwin.menubar.goto configure $topwin.menubar.goto add command -label "Go Home" \ -command {change_dir $cvscfg(home)} $topwin.menubar.goto add command -label "Add Bookmark" \ -command add_bookmark $topwin.menubar.goto add command -label "Delete Bookmark" \ -command delete_bookmark_dialog $topwin.menubar.goto add separator foreach mark [lsort [array names bookmarks]] { # Backward compatibility. Value used to be a placeholder, is now a revsystem type if {$bookmarks($mark) == "t"} {set bookmarks($mark) ""} $topwin.menubar.goto add command -label "$mark $bookmarks($mark)" \ -command "change_dir \"$mark\"" } } # Have to do this after the apple menu $topwin configure -menu $topwin.menubar $topwin.menubar.file add command -label "Shell" -underline 0 \ -command { exec::new $cvscfg(shell) } $topwin.menubar.file add separator $topwin.menubar.file add command -label Exit -underline 1 \ -command { exit_cleanup 1 } } # The Working Directory menubar proc workdir_menus {topwin} { global cvscfg global colorglb global cvsmenu global usermenu global execmenu global bookmarks global git_log_opt gen_log:log T "ENTER" # File menu $topwin.menubar.file insert 1 command -label "Browse Modules" -underline 0 \ -command modbrowse_run #$topwin.menubar.file add separator $topwin.menubar.file insert 1 command -label "Cleanup Directory" -underline 4 \ -command workdir_cleanup $topwin.menubar.file insert 1 command -label "Make New Directory" -underline 0 \ -command { file_input_and_do "New Directory" workdir_newdir} $topwin.menubar.file insert 1 command -label "Print Selected File" -underline 0 \ -command { workdir_print_file [workdir_list_files ] } $topwin.menubar.file insert 1 command -label "Open Selection" -underline 0 \ -command { workdir_edit_file [workdir_list_files] } set filemenu_idx [$topwin.menubar index "File"] menu $topwin.menubar.reports $topwin.menubar insert [expr {$filemenu_idx + 1}] cascade -label "Reports" \ -menu $topwin.menubar.reports -underline 2 # CVS - create it now, but place it later menu $topwin.menubar.cvs $topwin.menubar.cvs add command -label "Update" -underline 0 \ -command { \ cvs_update {BASE} {Normal} {Remove} {recurse} {prune} {No} { } [workdir_list_files] } $topwin.menubar.cvs add command -label "Update with Options" -underline 13 \ -command cvs_update_options $topwin.menubar.cvs add command -label "Commit/Checkin" -underline 5 \ -command cvs_commit_dialog $topwin.menubar.cvs add command -label "Revert" -underline 3 \ -command cvs_revert $topwin.menubar.cvs add command -label "Add Files" -underline 0 \ -command { add_dialog [workdir_list_files] } $topwin.menubar.cvs add command -label "Add Recursively" \ -command { addir_dialog [workdir_list_files] } $topwin.menubar.cvs add command -label "Remove Files" -underline 0 \ -command { subtract_dialog [workdir_list_files] } $topwin.menubar.cvs add command -label "Remove Recursively" \ -command { subtractdir_dialog [workdir_list_files] } $topwin.menubar.cvs add command -label "Tag" -underline 0 \ -command { tag_dialog } $topwin.menubar.cvs add command -label "Branch" -underline 0 \ -command { branch_dialog } $topwin.menubar.cvs add command -label "Join (Merge) Directory" \ -underline 0 -command { cvs_directory_merge } $topwin.menubar.cvs add separator $topwin.menubar.cvs add command -label "Release" \ -command { release_dialog [workdir_list_files] } # SVN - create it now, but place it later menu $topwin.menubar.svn $topwin.menubar.svn add command -label "Update" -underline 0 \ -command {svn_update [workdir_list_files]} $topwin.menubar.svn add command -label "Resolve (Un-mark Conflict)" \ -command {svn_resolve [workdir_list_files]} $topwin.menubar.svn add command -label "Commit/Checkin" -underline 0 \ -command svn_commit_dialog $topwin.menubar.svn add command -label "Revert" -underline 3 \ -command svn_revert $topwin.menubar.svn add command -label "Add Files" -underline 0 \ -command { add_dialog [workdir_list_files] } $topwin.menubar.svn add command -label "Remove Files" -underline 0 \ -command { subtract_dialog [workdir_list_files] } $topwin.menubar.svn add command -label "Tag" -underline 0 \ -command { tag_dialog } $topwin.menubar.svn add command -label "Branch" -underline 0 \ -command { branch_dialog } # RCS - create it now, but place it later menu $topwin.menubar.rcs $topwin.menubar.rcs add command -label "Checkout" -underline 6 \ -command { rcs_checkout [workdir_list_files] } $topwin.menubar.rcs add command -label "Checkin" -underline 6 \ -command { rcs_commit_dialog [workdir_list_files] } $topwin.menubar.rcs add command -label "Revert" -underline 3 \ -command rcs_revert # GIT - create it now, but place it later menu $topwin.menubar.git $topwin.menubar.git add command -label "Checkout/Update" -underline 6 \ -command {git_checkout [workdir_list_files]} $topwin.menubar.git add command -label "Update with Options" -underline 13 \ -command { git_update_options } $topwin.menubar.git add command -label "Commit/Checkin" -underline 5 \ -command git_commit_dialog $topwin.menubar.git add command -label "Revert/Reset" -underline 3 \ -command git_reset $topwin.menubar.git add command -label "Add Files" -underline 0 \ -command { add_dialog [workdir_list_files] } $topwin.menubar.git add command -label "Remove Files" -underline 0 \ -command { subtract_dialog [workdir_list_files] } $topwin.menubar.git add command -label "Tag" -underline 0 \ -command { tag_dialog } $topwin.menubar.git add command -label "Branch" -underline 0 \ -command { branch_dialog } # Import menu for plain directories menu $topwin.menubar.import $topwin.menubar.import add command -label "Import CWD into SVN" \ -command { svn_import_run } $topwin.menubar.import add command -label "Import CWD into CVS" \ -command { cvs_import_setup } $topwin.menubar.import add command -label "Import CWD into an Existing CVS Module" \ -command { cvs_subimport_setup} # Status and log $topwin.menubar.reports add command -label "Check Directory" -underline 0 $topwin.menubar.reports add cascade -label "Status" -underline 0 \ -menu $topwin.menubar.reports.status_detail menu $topwin.menubar.reports.status_detail menu $topwin.menubar.reports.log_detail $topwin.menubar.reports.status_detail add command -label "Terse" $topwin.menubar.reports.status_detail add command -label "Summary" $topwin.menubar.reports.status_detail add command -label "Verbose" $topwin.menubar.reports add cascade -label "Log" -underline 0 \ -menu $topwin.menubar.reports.log_detail $topwin.menubar.reports.log_detail add command -label "Latest" $topwin.menubar.reports.log_detail add command -label "Summary" $topwin.menubar.reports.log_detail add command -label "Verbose" $topwin.menubar.reports add command -label "Info" -underline 0 $topwin.menubar.reports add separator $topwin.menubar.reports add checkbutton -label "Report Unknown Files" \ -variable cvscfg(status_filter) -onvalue false -offvalue true $topwin.menubar.reports add checkbutton -label "Report Recursively" \ -variable cvscfg(recurse) -onvalue true -offvalue false $topwin.menubar.options add checkbutton -label "Show hidden files" \ -variable cvscfg(allfiles) -onvalue true -offvalue false \ -command setup_dir $topwin.menubar.options add checkbutton -label "Automatic directory status" \ -variable cvscfg(auto_status) -onvalue true -offvalue false $topwin.menubar.options add checkbutton -label "Confirmation Dialogs" \ -variable cvscfg(confirm_prompt) -onvalue true -offvalue false $topwin.menubar.options add separator $topwin.menubar.options add checkbutton -label "Status Column" \ -variable cvscfg(showstatcol) -onvalue true -offvalue false \ -command "DirCanvas:displaycolumns $topwin.main.tree" $topwin.menubar.options add checkbutton -label "Date Column" \ -variable cvscfg(showdatecol) -onvalue true -offvalue false \ -command "DirCanvas:displaycolumns $topwin.main.tree" $topwin.menubar.options add checkbutton -label "Revision Column" \ -variable cvscfg(showwrevcol) -onvalue true -offvalue false \ -command "DirCanvas:displaycolumns $topwin.main.tree" $topwin.menubar.options add checkbutton -label "Author Column" \ -variable cvscfg(showeditcol) -onvalue true -offvalue false \ -command "DirCanvas:displaycolumns $topwin.main.tree" $topwin.menubar.options add separator $topwin.menubar.options add checkbutton -label "Git Detailed Status" \ -variable cvscfg(gitdetail) -onvalue true -offvalue false \ -command { setup_dir } # User-defined commands if { [info exists cvsmenu] || \ [info exists usermenu] || \ [info exists execmenu]} { .workdir.menubar add cascade -label "User Defined" -menu [menu .workdir.menubar.user] -underline 0 .workdir.menubar.user configure gen_log:log T "Adding user defined menu" if {[info exists cvsmenu]} { foreach item [array names cvsmenu] { $topwin.menubar.user add command -label $item \ -command "eval cvs_usercmd $cvsmenu($item) \[workdir_list_files\]" } } if {[info exists usermenu]} { foreach item [array names usermenu] { $topwin.menubar.user add command -label $item \ -command "eval cvs_catchcmd $usermenu($item) \[workdir_list_files\]" } } if {[info exists execmenu]} { foreach item [array names execmenu] { $topwin.menubar.user add command -label $item \ -command "eval cvs_execcmd $execmenu($item) \[workdir_list_files\]" } } } $topwin.menubar.options add separator $topwin.menubar.options add checkbutton -label "Tracing On/Off" \ -variable cvscfg(logging) -onvalue true -offvalue false \ -command log_toggle $topwin.menubar.options add command -label "Save Options" -underline 0 \ -command save_options gen_log:log T "LEAVE" } # Actions and preferences for Git proc git_branch_menu {topwin files} { global cvscfg global colorglb global git_log_opt git_tools_menu $topwin $topwin.menubar.gittools add cascade -label "Git log options" -menu [menu $topwin.menubar.gittools.logopts] $topwin.menubar.gittools configure set all_gitlog_opts [list "--first-parent" "--full-history" "--sparse" "--no-merges"] foreach o $all_gitlog_opts { if {$o in $cvscfg(gitlog_opts)} { set git_log_opt($o) 1 } else { set git_log_opt($o) 0 } } foreach opt $all_gitlog_opts { $topwin.menubar.gittools.logopts add checkbutton -label $opt \ -variable git_log_opt($opt) -onvalue 1 -offvalue 0 \ -command { global cvscfg global git_log_opt gen_log:log D "cvscfg(gitlog_opts) $cvscfg(gitlog_opts)" set cvscfg(gitlog_opts) "" foreach go [array names git_log_opt] { if {$git_log_opt($go)} { append cvscfg(gitlog_opts) "$go " } } gen_log:log D "cvscfg(gitlog_opts) $cvscfg(gitlog_opts)" } } $topwin.menubar.gittools add cascade -label "Branches groups" -menu [menu $topwin.menubar.gittools.branches] $topwin.menubar.gittools.branches configure $topwin.menubar.gittools.branches add radiobutton -label " File-specific" \ -variable cvscfg(gitbranchgroups) -value "F" $topwin.menubar.gittools.branches add radiobutton -label " All Local" \ -variable cvscfg(gitbranchgroups) -value "FL" $topwin.menubar.gittools.branches add radiobutton -label " Local + Remote" \ -variable cvscfg(gitbranchgroups) -value "FLR" } # The Help menu proc help_menu {topwin} { global colorglb gen_log:log T "ENTER ($topwin)" # Help menu $topwin.menubar add cascade -label "Help" -menu $topwin.menubar.help -underline 0 menu $topwin.menubar.help $topwin.menubar.help add command -label "Help on TkRev" -command "table_of_contents $topwin" } # The Module Browser menubars proc modbrowse_menus {topwin} { global cvscfg global colorglb global cvs global logclass # File menu $topwin.menubar.file insert 1 command -label "Browse Working Directory" -underline 0 \ -command workdir_setup menu $topwin.menubar.cvs $topwin.menubar.cvs add command -label "CVS Checkout" \ -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module} $topwin.menubar.cvs add command -label "CVS Export" \ -command { dialog_cvs_export $cvscfg(cvsroot) $modbrowse_module} $topwin.menubar.cvs add command -label "Tag Module" -underline 0 \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "tag" } $topwin.menubar.cvs add command -label "Branch Tag Module" -underline 0 \ -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "branch" } $topwin.menubar.cvs add command -label "Make Patch File" -underline 0 \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 0 } $topwin.menubar.cvs add command -label "View Patch Summary" -underline 0 \ -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 1 } $topwin.menubar.cvs add separator $topwin.menubar.cvs add command -label "Vendor Merge" -underline 0 \ -command {merge_run $modbrowse_module} $topwin.menubar.cvs add separator $topwin.menubar.cvs add command -label "Show My Checkouts" -underline 0 \ -command {cvs_history me ""} $topwin.menubar.cvs add command -label "Show Checkouts of Selected Module" -underline 0 \ -command {cvs_history all $modbrowse_module} $topwin.menubar.cvs add command -label "Show All Checkouts" -underline 0 \ -command {cvs_history all ""} menu $topwin.menubar.svn $topwin.menubar.svn add command -label "SVN Checkout" \ -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path checkout} $topwin.menubar.svn add command -label "SVN Export" \ -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path export} $topwin.menubar.svn add command -label "Tag Module" -underline 0 \ -command { dialog_svn_tag $cvscfg(svnroot) $modbrowse_path "tags" } $topwin.menubar.svn add command -label "Branch Module" -underline 0 \ -command { dialog_svn_tag $cvscfg(svnroot) $modbrowse_path "branches" } $topwin.menubar.svn add command -label "Make Patch File" -underline 0 \ -command { dialog_svn_patch $cvscfg(svnroot) $modbrowse_path $selB_path 0 } $topwin.menubar.svn add command -label "View Patch Summary" -underline 0 \ -command { dialog_svn_patch $cvscfg(svnroot) $modbrowse_path $selB_path 1 } menu $topwin.menubar.git $topwin.menubar.git add command -label "Git Clone" \ -command { dialog_git_clone $cvscfg(gitroot) $modbrowse_path } menu $topwin.menubar.options $topwin.menubar.options add checkbutton -label "Group Aliases in a Folder (CVS)" \ -variable cvscfg(aliasfolder) -onvalue true -offvalue false \ -command { $topwin.treeframe.pw delete [$topwin.treeframe.pw children {}] cvs_modbrowse_tree [lsort [array names modval]] "/" } $topwin.menubar.options add separator $topwin.menubar.options add checkbutton -label "Tracing On/Off" \ -variable cvscfg(logging) -onvalue true -offvalue false \ -command log_toggle } proc about_menus {aboutmenu} { $aboutmenu add command -label "About TkRev" \ -command aboutbox $aboutmenu add command -label "About CVS SVN RCS GIT" \ -command {help_cvs_version 1} $aboutmenu add command -label "About Wish" \ -command {wish_version} $aboutmenu add separator $aboutmenu add command -label "Preferences" \ -command {prefdialog} $aboutmenu add command -label Exit -underline 1 \ -command { exit_cleanup 1 } } proc git_tools_menu {topwin} { global colorglb if {[winfo exists $topwin.menubar.gittools]} { return } $topwin.menubar add cascade -label "Git Tools" -menu [menu $topwin.menubar.gittools] $topwin.menubar.gittools configure $topwin.menubar.gittools add command -label "gitk" -state disabled $topwin.menubar.gittools add command -label "git-gui" -state disabled set ok_gitk 1 set ok_gitgui 1 if {[auto_execok gitk] eq ""} { set ok_gitk 0 } if {[auto_execok git-gui] eq ""} { set ok_gitgui 0 } switch -glob $topwin { ".workdir" { if {$ok_gitk} { $topwin.menubar.gittools entryconfigure "gitk" -state normal \ -command { cvs_execcmd gitk --all [workdir_list_files] } } if {$ok_gitgui} { $topwin.menubar.gittools entryconfigure "git-gui" -state normal \ -command { cvs_execcmd git-gui --all [workdir_list_files] } } } ".branch_diagram*" { regexp {(\d*)$} $topwin all my_idx if {$ok_gitk} { $topwin.menubar.gittools entryconfigure "gitk" -state normal \ -command "cvs_execcmd gitk --all [set ::branch_diagram::$my_idx\::filename]" } if {$ok_gitgui} { $topwin.menubar.gittools entryconfigure "git-gui" -state normal \ -command "cvs_execcmd git-gui --all [set ::branch_diagram::$my_idx\::filename]" } } ".annotate*" { regexp {(\d*)$} $topwin all my_idx if {$ok_gitk} { $topwin.menubar.gittools entryconfigure "gitk" -state normal \ -command "cvs_execcmd gitk --all [set ::annotate::$my_idx\::file]" } if {$ok_gitgui} { $topwin.menubar.gittools entryconfigure "git-gui" -state normal \ -command "cvs_execcmd git-gui --all [set ::annotate::$my_idx\::file]" } } } } tkrev_9.6.1/tkrev/svn.tcl0000664000175000017500000021130615033645673015740 0ustar dorothyrdorothyr # Find SVN URL and where we are in path proc read_svn_dir {dirname} { global cvscfg global cvsglb global current_tagname global module_dir global cmd gen_log:log T "ENTER ($dirname)" set cvsglb(vcs) svn # svn info gets the URL # Have to do eval exec because we need the error output set cvscfg(url) "" set cvscfg(svnroot) "" set cvsglb(relpath) "" set module_dir "" set command "svn info" gen_log:log C "$command" set ret [catch {exec {*}$command} output] if {$ret} { cvsfail $output return 0 } gen_log:log S $output foreach infoline [split $output "\n"] { if {[string match "URL*" $infoline]} { set cvscfg(url) [lrange $infoline 1 end] gen_log:log D "URL: $cvscfg(url)" } elseif {[string match "Relative URL*" $infoline]} { set relpath [string range $infoline 16 end] gen_log:log D "Relative Path: $relpath" } elseif {[string match "Repository Root*" $infoline]} { set cvscfg(svnroot) [lrange $infoline 2 end] gen_log:log D "Repository Root: $cvscfg(svnroot)" } } if {$cvscfg(url) == ""} { cvsfail "Can't get the SVN URL" return 0 } if {$cvscfg(svnroot) == ""} { cvsfail "Can't get the Repository Root" return 0 } if {$relpath == ""} { cvsfail "Can't get the Relative path" return 0 } set type "" foreach s [list $cvscfg(svn_trunkdir) $cvscfg(svn_branchdir) $cvscfg(svn_tagdir)] { if {[regexp "/$s/" $cvscfg(url)] || [regexp "/$s" $cvscfg(url)]} { set spl [split $cvscfg(url) "/"] set root "" set relp "" set current_tagname "" set state P for {set j 0} {$j < [llength $spl]} {incr j} { set word [lindex $spl $j] switch -- $state { P { if {$word eq $cvscfg(svn_trunkdir)} { gen_log:log D "Matched $word for trunk" set type "trunk" set current_tagname $word set state E } elseif { $word eq $cvscfg(svn_branchdir)} { gen_log:log D "Matched $word for branches" set type "branches" set state W } elseif { $word eq $cvscfg(svn_tagdir)} { gen_log:log D "Matched $word for tags" set type "tags" set state W } else { append root "$word/" #gen_log:log D "No match for $word" } } W { set current_tagname $word set state E } E { lappend relp "$word" } default {} } } set cvscfg(svnroot) [string trimright $root "/"] #set cvsglb(root) $cvscfg(svnroot) gen_log:log D "SVN URL: $cvscfg(url)" gen_log:log D "svnroot: $cvscfg(svnroot)" set cvsglb(relpath) [join $relp {/}] gen_log:log D "relpath: $cvsglb(relpath)" regsub -all {%20} $cvsglb(relpath) { } module_dir gen_log:log D "tagname: $current_tagname" } } regsub -all {%20} $cvsglb(relpath) { } module_dir gen_log:log D "Module Dir: $module_dir" gen_log:log D "Local Relative path: $cvsglb(relpath)" gen_log:log D "Current Tagname: $current_tagname" if {$type == ""} { gen_log:log F "Nonconforming repository" puts "No conforming $cvscfg(svn_trunkdir)/$cvscfg(svn_branchdir)/$cvscfg(svn_tagdir) structure detected. I won't be able to detect any branches or tags." set cvsglb(svnconform) 0 gen_log:log T "LEAVE (-1)" return -1 } set cvsglb(svnconform) 1 gen_log:log T "LEAVE (0)" return 1 } proc svn_lock {do args} { global cvscfg set filelist [join $args] if {$filelist == ""} { cvsfail "Please select one or more files!" .workdir return } switch -- $do { lock { set commandline "svn lock"} unlock { set commandline "svn unlock"} } foreach f $filelist { append commandline " \"$f\"" } set cmd [exec::new "$commandline"] if {$cvscfg(auto_status)} { $cmd\::wait setup_dir } } # Get stuff for main workdir browser proc svn_workdir_status {} { global cvscfg global cmd global Filelist gen_log:log T "ENTER" # One command gets all the status information set cmd(svn_status) [exec::new "svn status -uvN --xml"] set xmloutput [$cmd(svn_status)\::output] set entrylist [regexp -all -inline {} $xmloutput] if {[info exists cmd(svn_status)]} { $cmd(svn_status)\::destroy catch {unset cmd(svn_status)} } # do very simple xml parsing foreach entry $entrylist { set filename "" set cauthor "" set lockstatus "" set wrev "" set crev "" set movedto "" set movedfrom "" regexp {} $entry tmp filename regexp {} $entry wcstatusent if { [ regexp {} $entry repstatusent ] } { regexp {]*)>} $repstatusent tmp repstatusheader regexp {item=\"(\w+)\"} $repstatusheader tmp repstatus if { [ regexp {.*} $repstatusent replock ] } { set lockstatus "locked" regexp {(.*?)} $replock tmp locker regexp {(.*?)} $replock tmp lockdate regsub {T.*$} $lockdate lockdate #gen_log:log D "LOCK $locker $lockdate" set file_locker($filename) "$locker@$lockdate" } } else { set repstatus "" } regexp {(.*)} $wcstatusent tmp cauthor regexp {(.*)} $wcstatusent tmp cdate regexp {]*)>} $wcstatusent tmp wcstatusheader regexp {item=\"(\w+)\"} $wcstatusheader tmp wcstatus regexp {moved-to=\"([^\"]*?)\"} $wcstatusheader tmp movedto regexp {moved-from=\"([^\"]*?)\"} $wcstatusheader tmp movedfrom regexp {revision=\"(\w+)\"} $wcstatusheader tmp wrev # FIXME?: an item can have item="normal" but props="modified" # In a short status, that's the same as ' M' 'C' for conflicted is also possible # After a merge, "." has that status. "svn diff" shows "Modified:svn:mergeinfo" # We aren't using that info though we could get it this way: regexp {props=\"(\w+)\"} $wcstatusheader tmp props # It may be relevant to merging, ie. to show that we have done a merge but not # committed it. if { [ regexp {.*} $wcstatusent wclock ] } { set lockstatus "havelock" } # wcstatus="added|normal|deleted|missing|unversioned|modified|none|obstructed # repstatus="modified|none" # movedto|movedfrom="filename" set status "" set displaymod "" set fret [catch {file type $filename} ft] if { [file exists $filename] && ($ft == "link")} { set displaymod " " } if {$ft == "directory"} { set displaymod " " } set mayhavelock false switch -exact -- $wcstatus { "normal" { if { $repstatus == "modified"} { append displaymod "Out-of-date" } else { if {$props eq "modified"} { append displaymod "Property Modified" } else { append displaymod "Up-to-date" } set mayhavelock true } } "missing" { append displaymod "Missing" } "modified" { if { $repstatus == "modified"} { append displaymod "Needs Merge" } else { append displaymod "Modified" set mayhavelock true } } "added" { append displaymod "Added" } "deleted" { append displaymod "Removed" } "unversioned" { append displaymod "Not managed by SVN" } "conflicted" { append displaymod "Conflict" } "obstructed" { append displaymod "Obstructed" } L { append displaymod "Locked" } S { append displaymod "Switched to Branch" } "none" { append displaymod "Missing/Needs Update" } ~ { append displaymod "Dir/File Mismatch" } } if {$movedfrom ne ""} { append displaymod ", moved from $movedfrom" } if {$movedto ne ""} { append displaymod ", moved to $movedto" } #in some cases there might be locks: check now if { $mayhavelock } { switch -exact -- $lockstatus { "" { } "havelock" { append displaymod "/HaveLock" } "locked" { append displaymod "/Locked" } } } if {$wcstatus ne "unversioned"} { set Filelist($filename:wrev) $wrev set Filelist($filename:status) $displaymod set Filelist($filename:stickytag) "$wrev $crev" if {$wrev != "" && $crev != ""} { set Filelist($filename:stickytag) "$wrev (committed:$crev)" } # The date is in a weird format, like "2019-09-28T05:49:03.648859Z" #gen_log:log D "DATE: \"$cdate\"" if {! [info exists cdate]} { set cdate "" } regsub {.[\d]*Z$} $cdate {} chopdate #gen_log:log D " $chopdate" if {! [catch {set newdate [clock scan "$chopdate" -format "%Y-%m-%dT%H:%M:%S"]}] } { set Filelist($filename:date) [clock format $newdate -format $cvscfg(dateformat)] } set Filelist($filename:option) "" set Filelist($filename:editors) "$cauthor" if {[info exists file_locker($filename)]} { regsub {T.*$} $file_locker($filename) {} file_locker($filename) append Filelist($filename:editors) " lock:$file_locker($filename)" } } } gen_log:log T "LEAVE" } # does svn add from workdir browser proc svn_add {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { set mess "This will add all new files" } else { set mess "This will add these files:\n\n" foreach file $filelist { append mess " $file\n" } } if {$filelist == ""} { set filelist [glob -nocomplain $cvscfg(aster) .??*] } set command "svn add" foreach f $filelist { append command " \"$f\"" } set addcmd [exec::new "$command"] auto_setup_dir $addcmd gen_log:log T "LEAVE" } # does svn remove from workdir browser proc svn_remove_file {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] set command "svn remove --force --keep-local" foreach f $filelist { append command " \"$f\"" } set command [exec::new "$command"] auto_setup_dir $command gen_log:log T "LEAVE" } # does a status report on the files in the current directory. Called from # "Status" in the Reports menu. Uses the recurse and status_filter settings. proc svn_status {detail args} { global cvscfg gen_log:log T "ENTER ($args)" busy_start .workdir.main set filelist [join $args] set flags "" set title "SVN Status ($detail)" set command "svn status" if {$cvscfg(status_filter)} { append flags " -q" } if {! $cvscfg(recurse)} { append flags " --depth=files" } switch -- $detail { summary { append flags " -u" } verbose { append flags " -v" } } append command " $flags" foreach f $filelist { append command " \"$f\"" } set check_cmd [viewer::new "$title"] $check_cmd\::do "$command" 0 status_colortags busy_done .workdir.main gen_log:log T "LEAVE" } # called from the "Check Directory" button in the workdir and the Reports menu proc svn_check {} { global cvscfg gen_log:log T "ENTER ()" busy_start .workdir.main set title "SVN Directory Check" set flags "" if {$cvscfg(recurse)} { append title " (recursive)" } else { append flags " --depth=files" append title " (toplevel)" } set command "svn status $flags" set check_cmd [viewer::new "$title"] $check_cmd\::do "$command" 0 status_colortags busy_done .workdir.main gen_log:log T "LEAVE" } # svn update - called from workdir browser proc svn_update {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { append mess "\nThis will download from" append mess " the repository to your local" append mess " filespace ** ALL ** files which" append mess " have changed in it." } else { append mess "\nThis will download from" append mess " the repository to your local" append mess " filespace these files which" append mess " have changed:\n" } foreach file $filelist { append mess "\n\t$file" } append mess "\n\nAre you sure?" set command "svn update" if {[cvsconfirm $mess .workdir] == "ok"} { foreach file $filelist { append command " \"$file\"" } } else { return; } set co_cmd [viewer::new "SVN Update"] $co_cmd\::do "$command" 0 status_colortags auto_setup_dir $co_cmd gen_log:log T "LEAVE" } # Called from "update with options" dialog of workdir browser proc svn_opt_update {} { global cvscfg global cvsglb global module_dir switch -exact -- $cvsglb(tagmode_selection) { "Keep" { set command "svn update" } "Trunk" { set command "svn switch --ignore-ancestry ^/$cvscfg(svn_trunkdir)/$module_dir" } "Branch" { set command "svn switch --ignore-ancestry ^/$cvscfg(svn_branchdir)/$cvsglb(branchname)/$module_dir" } "Tag" { set command "svn switch --ignore-ancestry ^/$cvscfg(svn_tagdir)/$cvsglb(tagname)/$module_dir" } "Revision" { # Let them get away with saying r3 instead of 3 set rev [string trimleft $cvsglb(revnumber) {r}] # FIXME: This doesn't work if you're not on the trunk set command "svn switch --ignore-ancestry ^/trunk/$module_dir -r $rev" } } set upd_cmd [viewer::new "SVN Update/Switch"] $upd_cmd\::do "$command" 0 status_colortags auto_setup_dir $upd_cmd } # dialog for svn commit - called from workdir browser proc svn_commit_dialog {} { global cvsglb global cvscfg global colorglb # If marked files, commit these. If no marked files, then # commit any files selected via listbox selection mechanism. # The cvsglb(commit_list) list remembers the list of files # to be committed. set cvsglb(commit_list) [workdir_list_files] # If we want to use an external editor, just do it if {$cvscfg(use_cvseditor)} { svn_commit "" "" $cvsglb(commit_list) return } if {[winfo exists .commit]} { destroy .commit } toplevel .commit #grab set .commit frame .commit.top -borderwidth 8 frame .commit.down -relief groove -borderwidth 2 pack .commit.top -side top -fill x pack .commit.down -side bottom -fill x frame .commit.comment pack .commit.comment -side top -fill both -expand 1 label .commit.comment.lcomment -text "Your log message" -anchor w button .commit.comment.history -text "Log History" \ -command history_browser text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ -bg $colorglb(textbg) -fg $colorglb(textfg) -exportselection 1 \ -wrap word -borderwidth 2 -setgrid yes # Explain what it means to "commit" files message .commit.message -justify left -aspect 800 \ -text "This will commit changes from your \ local, working directory into the repository, recursively." pack .commit.message -in .commit.top -padx 2 -pady 5 button .commit.ok -text "OK" \ -command { #grab release .commit wm withdraw .commit set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] svn_commit $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.apply -text "Apply" \ -command { set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] svn_commit $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.clear -text "ClearAll" \ -command { set version "" .commit.comment.tcomment delete 1.0 end } button .commit.quit \ -command { #grab release .commit wm withdraw .commit } .commit.ok configure -text "OK" .commit.quit configure -text "Close" grid columnconf .commit.comment 1 -weight 1 grid rowconf .commit.comment 1 -weight 1 grid .commit.comment.lcomment -column 0 -row 0 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew grid .commit.comment.history -column 0 -row 1 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Fill in the most recent commit message .commit.comment.tcomment insert end $cvsglb(commit_comment) wm title .commit "Commit Changes" wm minsize .commit 1 1 gen_log:log T "LEAVE" } # svn commit - called from commit dialog proc svn_commit {comment args} { global cvscfg gen_log:log T "ENTER ($comment $args)" set filelist [join $args] set commit_output "" if {$filelist == ""} { set mess "This will commit your changes to ** ALL ** files in" append mess " and under this directory." } else { foreach file $filelist { append commit_output "\n$file" } set mess "This will commit your changes to:$commit_output" } append mess "\n\nAre you sure?" set commit_output "" if {[cvsconfirm $mess .workdir] != "ok"} { return 1 } if {$cvscfg(use_cvseditor)} { # Starts text editor of your choice to enter the log message. update idletasks set command "$cvscfg(terminal) svn commit" foreach f $filelist { append command " \"$f\"" } gen_log:log C "$command" set ret [catch {exec {*}$command} view_this] if {$ret} { cvsfail $view_this .workdir gen_log:log T "LEAVE ERROR ($view_this)" return } } else { if {$comment == ""} { cvsfail "You must enter a comment!" .commit return 1 } set v [viewer::new "SVN Commit"] regsub -all "\"" $comment "\\\"" comment set command "svn commit -m \"$comment\"" foreach f $filelist { append command " \"$f\"" } $v\::do "$command" 1 $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # Called from workdir browser popup proc svn_rename_ask {file} { gen_log:log T "ENTER ($file)" if {$file eq ""} { cvsfail "Rename:\nPlease select a file !" .workdir return } # Send it to the dialog to ask for the filename file_input_and_do "SVN Rename" "svn_rename \"$file\"" gen_log:log T "LEAVE" } # The callback for svn_rename_ask and file_input_and_do proc svn_rename {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] set oldname [lindex $args 0] set newname [lindex $args 1] set v [viewer::new "SVN rename"] set command "svn rename \"$oldname\" \"$newname\"" $v\::do "$command" if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # Called from workdir browser annotate button proc svn_annotate {revision args} { gen_log:log T "ENTER ($revision $args)" set filelist [join $args] if {$revision != ""} { set revflag "-$revision" } else { set revflag "" } if {$filelist == ""} { cvsfail "Annotate:\nPlease select one or more files !" .workdir gen_log:log T "LEAVE (Unselected files)" return } foreach file $filelist { annotate::new $revflag "$file" "svn" } gen_log:log T "LEAVE" } # Called from branch browser annotate button proc svn_annotate_r {revision filepath} { gen_log:log T "ENTER ($revision $filepath)" if {$revision != ""} { # We were given a revision set revflag "-$revision" } else { set revflag "" } annotate::new $revflag "$filepath" "svn_r" gen_log:log T "LEAVE" } # Shows which files changed in a commit # called from the branch browser proc svn_ddiff { {rev1 {}} {rev2 {}} } { gen_log:log T "ENTER (\"$rev1\" \"$rev2\")" set command "svn diff --summarize" set args "" if {$rev1 != {} && $rev2 != {} } { set args " -r $rev1:$rev2" } elseif {$rev1 != {} } { set args "-c -r$rev1" } elseif {$rev2 != {} } { set args "-c -r$rev2" } set title "SVN diff $args" set v_show [viewer::new "$title"] $v_show\::width 120 $v_show\::do "$command $args" 1 $v_show\::wait gen_log:log T "LEAVE" } # This creates a patch file between two revisions of a module. If the # second revision is null, it creates a patch to the head revision. # If both are null the top two revisions of the file are diffed. proc svn_patch { pathA pathB revA dateA revB dateB outmode outfile } { global tcl_version gen_log:log T "ENTER ($pathA $pathB \"$revA\" \"$dateA\" \"$revB\" \"$dateB\" $outmode $outfile)" lassign {{} {}} rev1 rev2 if {$revA != {}} { set rev1 $revA } elseif {$dateA != {}} { set rev1 "\{\"$dateA\"\}" } if {$revB != {}} { set rev2 "$revB" } elseif {$dateA != {}} { set rev2 "\{\"$dateB\"\}" } set pathA [safe_url $pathA] set pathB [safe_url $pathB] set args "" set command "svn diff" if {$pathA != {} && $pathB != {}} { set args "$pathA $pathB" if {$rev1 != {} && $rev2 != {}} { set args "$pathA@$rev1 $pathB@$rev2" } } elseif {$rev1 != {} && $rev2 != {}} { set args "$pathA -r $rev1:$rev2" } elseif {$rev1 != {}} { set args "$pathA -c -r$rev1" } elseif {$rev2 != {}} { set args "$pathA -c -r$rev2" } if {$outmode == 0} { set v [viewer::new "SVN Diff $args"] $v\::do "$command $args" 0 patch_colortags } else { set e [exec::new "$command"] set patch [$e\::output] gen_log:log F "OPEN $outfile" if {[catch {set fo [open $outfile w]}]} { cvsfail "Cannot open $outfile for writing" .modbrowse return } if {$tcl_version >= 9.0} {chan configure $fo -profile tcl8} puts $fo $patch close $fo $e\::destroy gen_log:log F "CLOSE $outfile" } gen_log:log T "LEAVE" return } # Called from the module browser proc svn_delete {root path} { gen_log:log T "ENTER ($root $path)" set mess "Really delete $path from the SVN repository?" if {[cvsconfirm $mess .modbrowse] != "ok"} { return } set url [safe_url $root/$path] set v [viewer::new "SVN delete"] set command "svn delete -m\"Removed\\ using\\ TkRev\" \"$url\"" $v\::do "$command" modbrowse_run gen_log:log T "LEAVE" } # This is the callback for the folder-opener in ModTree proc svn_jit_listdir {} { global cvscfg gen_log:log T "ENTER" gen_log:log D "svnroot: $cvscfg(svnroot)" set tv .modbrowse.treeframe.pw busy_start $tv set opendir [$tv selection] # It might be a string like {/trunk/Dir 2} set opendir [join $opendir] gen_log:log D "selection: $opendir" set dir [string trimleft $opendir / ] set command "svn list -v \"$cvscfg(svnroot)/$dir\"" set cmd(svnlist) [exec::new "$command"] if {[info exists cmd(svnlist)]} { set contents [split [$cmd(svnlist)\::output] "\n"] $cmd(svnlist)\::destroy catch {unset cmd(svnlist)} } set dirs "" set fils "" foreach logline $contents { if {$logline == "" } continue gen_log:log D "$logline" if {[string match {*/} $logline]} { set item [lrange $logline 5 end] set item [string trimright $item "/"] if {$item ne "."} { lappend dirs "$item" set info($item) [lrange $logline 2 4] } } else { set item [lrange $logline 6 end] lappend fils "$item" set info($item) [lrange $logline 3 5] } } # Remove the placeholder if {[$tv exists "/$dir/placeholder"]} { gen_log:log D "$tv delete /$dir/placeholder" $tv delete \"/$dir/placeholder\" } foreach f $fils { gen_log:log D "$tv insert /$dir end -id /$dir/$f -image paper -values [list $f $info($f)]" $tv insert "/$dir" end -id "/$dir/$f" -image paper -values [list "$f" "$info($f)"] } foreach d $dirs { svn_jit_dircmd "$dir" $d "$info($d)" } busy_done $tv gen_log:log T "LEAVE" } proc svn_jit_dircmd { parent dir info} { global cvsglb global Tree gen_log:log T "ENTER (\"$parent\" \"$dir\" \"$info\")" set tv .modbrowse.treeframe.pw set lbl "[file tail $dir]/" if {$parent ne {}} { set parent "/$parent" } # To avoid having to look ahead and build the whole tree at once, we put # a "marker" item in non-empty directories so it will look non-empty # and be openable gen_log:log D "$tv insert $parent end -id $parent/$dir -image dir -values {$lbl $info}" $tv insert "$parent" end -id "$parent/$dir" -image dir -values [list "$lbl" "$info"] # Placeholder so that folder is openable gen_log:log D "$tv insert $parent/$dir end -id $parent/$dir/placeholder -values {placeholder \"\"}" $tv insert "$parent/$dir" end -id "$parent/$dir/placeholder" -values [list "placeholder" ""] set depth [llength [file split "$parent/$dir"]] set col0_width [expr {$depth * $cvsglb(mod_iconwidth)}] $tv column #0 -width $col0_width #gen_log:log T "LEAVE" } # called from module browser - list branches & tags proc parse_svnmodules {svnroot} { gen_log:log T "ENTER ($svnroot)" set tv .modbrowse.treeframe.pw set command "svn list -v $svnroot" set cmd(svnlist) [exec::new "$command"] if {[info exists cmd(svnlist)]} { set contents [$cmd(svnlist)\::output] $cmd(svnlist)\::destroy catch {unset cmd(svnlist)} } set dirs "" set fils "" foreach logline [split $contents "\n"] { if {$logline == "" } continue gen_log:log D "$logline" if {[string match {*/} $logline]} { set item [lrange $logline 5 end] set item [string trimright $item "/"] if {$item ne "."} { lappend dirs $item set info($item) [lrange $logline 2 4] } } else { set item [lrange $logline 6 end] lappend fils $item set info($item) [lrange $logline 3 5] } } foreach f $fils { gen_log:log D "$tv insert {} end -id $f -image Fileview -values [list $f $info($f)]" $tv insert {} end -id $f -image paper -values [list "$f" "$info($f)"] } foreach d $dirs { svn_jit_dircmd {} $d "$info($d)" } gen_log:log T "LEAVE" } # Called when a directory in the module browser is closed proc svn_closedir {} { set tv .modbrowse.treeframe.pw set closedir [$tv selection] # It might be a list like {/trunk/Dir 2} set closedir [join $closedir] gen_log:log D "selection: $closedir" # Clear the contents set contents [$tv children $closedir] gen_log:log D "$tv delete $contents" $tv delete $contents # Put the placeholder back gen_log:log D "$tv insert $closedir end -id $closedir/placeholder -text placeholder" $tv insert "$closedir" end -id "$closedir/placeholder" -text placeholder } # called from workdir Reports menu. Uses recurse setting proc svn_log {detail args} { gen_log:log T "ENTER ($detail $args)" busy_start .workdir.main set filelist [join $args] # svn log is always recursive if {[llength $filelist] == 0} { set filelist {.} } if {[llength $filelist] > 1} { set title "SVN Log ($detail)" } else { set title "SVN Log $filelist ($detail)" } switch -- $detail { latest { set flags "-r COMMITTED -g -v" } summary { set flags "-q" } verbose { # this is the default with no options. Lists the revisions. set flags "-g" } } set command "svn log $flags" set v [viewer::new "$title"] foreach file $filelist { $v\::log "$file\n" invert $v\::do "$command \"$file\"" 0 rcslog_colortags $v\::wait } busy_done .workdir.main gen_log:log T "LEAVE" } # Called from the annotation and branch browsers # Shows the file log up to a commit proc svn_log_rev {revision filename} { gen_log:log T "ENTER ($revision $filename)" set title "SVN Log ($revision) $filename" set v [viewer::new "$title"] set command "svn log -$revision:1 \"$filename\"" $v\::do "$command" 0 rcslog_colortags gen_log:log T "LEAVE" } # Called from the annotation and branch browsers # Shows the diffs of a revision against the previous one proc svn_difflog_rev {revision filename} { gen_log:log T "ENTER ($revision $filename)" set title "SVN Log -diff ($revision) $filename" set v [viewer::new "$title"] set command "svn log --diff -$revision \"$filename\"" $v\::do "$command" 0 patch_colortags gen_log:log T "LEAVE" } # Called from the annotation and branch browsers # Shows the changed files for a commit proc svn_show_rev {revision filename} { gen_log:log T "ENTER ($revision $filename)" set command "svn log -g -v " if {$revision == {}} { set command "$command \"$filename\"" set v [viewer::new "SVN log $filename"] } else { set command "$command -$revision \"$filename\"" set v [viewer::new "SVN Log ($revision) $filename"] } $v\::do "$command" 0 rcslog_colortags gen_log:log T "LEAVE" } # Called from popup in workdir browser. Only ever gets one file, # but the svn info command can take multiple proc svn_info {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] set urllist "" set command "svn info " foreach file $filelist { append command "\"$file\"" } set logcmd [viewer::new "SVN Info"] $logcmd\::do "$command" gen_log:log T "LEAVE" } # From workdir browser proc svn_reconcile_conflict {args} { global cvscfg gen_log:log T "ENTER ($args)" if {[llength $args] != 1} { cvsfail "Please select one file." return } set filelist [join $args] # See if it's really a conflict file foreach file $filelist { gen_log:log F "OPEN $file" set f [open $file] if {$tcl_version >= 9.0} {chan configure $f -profile tcl8} set match 0 while { [eof $f] == 0 } { gets $f line if { [string match "<<<<<<< *" $line] } { set match 1 break } } gen_log:log F "CLOSE $file" close $f if { $match != 1 } { cvsfail "$file does not appear to have a conflict." .workdir continue } # We don't want to tie up the whole UI with tkdiff, but if we don't wait, # we don't know if we can mark it resolved. The context popup for a # conflict file in SVN has a "resolve" pick which calls svn_resolve. That # function checks whether there are still conflict markers in the file and # won't let you resolve it if so. set tkdiff_command "$cvscfg(tkdiff) -conflict -o \"$file\" \"$file\"" gen_log:log C "$tkdiff_command" set ret [catch {exec {*}$tkdiff_command &} view_this] } gen_log:log T "LEAVE" } proc svn_resolve {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] # See if it still has a conflict foreach file $filelist { gen_log:log F "OPEN $file" set f [open $file] set match 0 while { [eof $f] == 0 } { gets $f line if { [string match "<<<<<<< *" $line] } { set match 1 break } } gen_log:log F "CLOSE $file" close $f if {$match} { set mess "$file still contains \"<<<<<<< \" - \nUnmark anyway?" if {[cvsalwaysconfirm $mess .workdir] != "ok"} { continue } } gen_log:log D "Marking $file as resolved" set command [exec::new "svn resolved $file"] } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc svn_revert {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] set command "svn revert" foreach f $filelist { append command " \"$f\"" } if {$filelist == ""} { append command "-R ." } gen_log:log D "Reverting $filelist" set command [exec::new "$command"] auto_setup_dir $command gen_log:log T "LEAVE" } # svn tag or branch - called from tag and branch dialogs proc svn_tag {tagname b_or_t updflag comment args} { global cvscfg global cvsglb gen_log:log T "ENTER ($tagname $b_or_t $updflag comment $args)" if {$tagname == ""} { cvsfail "You must enter a tag name!" .workdir return 1 } set filelist [join $args] gen_log:log D "relpath: $cvsglb(relpath) filelist \"$filelist\"" if {$b_or_t == "tag"} { set pathelem "$cvscfg(svn_tagdir)" set typearg "tags" } if {$b_or_t == "branch"} { set pathelem "$cvscfg(svn_branchdir)" set typearg "branches" } set v [viewer::new "SVN Copy $tagname"] set to_url "$cvscfg(svnroot)/$pathelem/$tagname/$cvsglb(relpath)" # When delivered scriptically, there can't be any spaces in the comments. This is a # known thing with Subversion. So we escape them. regsub -all { } $comment {\\ } comment if { $filelist == "" } { set command "svn copy -m\"$comment\" \"$cvscfg(url)\" \"$to_url\"" $v\::log "$command" $v\::do "$command" } else { foreach f $filelist { set from_path [safe_url $cvscfg(url)/$f] set to_path [svn_pathforcopy $tagname $typearg] if {[file isdirectory $f]} { set command "svn copy -m\"$comment\" $from_path $to_path" } else { set command "svn copy --parents -m\"$comment\" \"$from_path\" \"$to_path/$f\"" } $v\::log "$command" $v\::do "$command" } } if {$updflag == "yes"} { # update so we're on the branch set to_path [svn_pathforcopy $tagname $typearg] set command "svn switch $to_path" $v\::log "$command" $v\::do "$command" 0 status_colortags $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # makes a tag or branch. Called from the workdir, module or branch # browser proc svn_rcopy {from_path b_or_t newtag {from {}}} { gen_log:log T "ENTER ($from_path $b_or_t $newtag)" if {[string match {bran*} $b_or_t]} { set comment "branch\\ rcopy\\ by\\ TkRev" } else { set comment "tag\\ rcopy\\ by\\ TkRev" } set v [viewer::new "SVN Copy $newtag"] set to_path [svn_pathforcopy $newtag $b_or_t] set from_path [string trimright $from_path "/"] # Copy the selected path if { $from != {} } { set command "svn copy -$from -m\"$comment\" [safe_url $from_path] $to_path" } else { set command "svn copy -m\"$comment\" [safe_url $from_path] $to_path" } $v\::do "$command" $v\::wait gen_log:log T "LEAVE" } # If a file to be copied isn't at the top level, we need to construct the # destination path. It's no longer necessary to do svn mkdir, since svn copy # has a --parent option. proc svn_pathforcopy {tagname b_or_t} { global cvscfg global cvsglb gen_log:log T "ENTER (\"$tagname\" \"$b_or_t\")" # Can't use file join or it will mess up the URL set to_path [safe_url "$cvscfg(svnroot)/$b_or_t/$tagname"] # We may need to construct a path to copy the file to set cum_path "" set pathelements [file split $cvsglb(relpath)] set depth [llength $pathelements] for {set i 0} {$i < $depth} {incr i} { set cum_path [file join $cum_path [lindex $pathelements $i]] gen_log:log D " $i $cum_path" } if {$cum_path != ""} { set to_path "$to_path/$cum_path" } gen_log:log T "LEAVE (\"$to_path\")" return $to_path } # join (merge) a chosen revision of local file to the current revision. proc svn_merge {parent frompath since currentpath frombranch args} { global cvscfg gen_log:log T "ENTER( \"$frompath\" \"$since\" \"$currentpath\" \"$frombranch\" $args)" set mergetags [assemble_mergetags $frombranch] set curr_tag [lindex $mergetags 0] set fromtag [lindex $mergetags 1] set totag [lindex $mergetags 2] regsub {^.*@} $frompath {r} from if {$since == {}} { set mess "Merge revision $from\n" } else { set mess "Merge the changes between revision\n $since and $from" append mess " (if $since > $from the changes are removed)\n" } append mess " to the current revision ($curr_tag)" if {[cvsalwaysconfirm $mess $parent] != "ok"} { return } # Do the update here, and defer the tagging until later #set commandline "svn merge --accept postpone \"$currentpath\" \"$frompath\"" set commandline "svn merge \"$currentpath\" \"$frompath\"" set v [viewer::new "SVN Merge"] $v\::do "$commandline" 1 status_colortags $v\::wait if {[winfo exists .workdir]} { if {$cvscfg(auto_status)} { setup_dir } } else { workdir_setup } dialog_merge_notice svn $from $frombranch $fromtag $totag $args gen_log:log T "LEAVE" } proc svn_merge_tag_seq {from frombranch totag fromtag args} { global cvscfg global cvsglb gen_log:log T "ENTER (\"$from\" \"$totag\" \"$fromtag\" $args)" set filelist [join $args] # It's muy importante to make sure everything is OK at this point set commandline "svn status -uq $filelist" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] set logmode [expr {$ret ? {E} : {D}}] view_output::new "SVN Check" $view_this gen_log:log $logmode $view_this if {$ret} { set mess "SVN Check shows errors which would prevent a successful\ commit. Please resolve them before continuing." if {[cvsalwaysconfirm $mess .workdir] != "ok"} { return } } set command "svn commit -m -m \"Merge from $from\" " foreach f $filelist { append command " \"$f\"" } # Do the commit set v [viewer::new "SVN Commit a Merge"] $v\::log "$command\n" $v\::do "$command" 1 $v\::wait # Tag if desired (no means not a branch) if {$cvscfg(auto_tag) && $fromtag != ""} { if {$frombranch == "trunk"} { set from_path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$cvsglb(relpath)" } else { set from_path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$frombranch/$cvsglb(relpath)" } set from_path [string trimright $from_path "/"] # tag the current (mergedto) branch svn_tag $fromtag "tag" no "tag\ after\ merge\ by\ TkRev" $args # Tag the mergedfrom branch foreach f $filelist { if {$f == "."} { svn_rcopy [safe_url $from_path] "tags" $totag $from } else { svn_rcopy [safe_url $from_path/$f] "tags" $totag/$f $from } } } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # SVN Checkout or Export. Called from Repository Browser proc svn_checkout {url path rev target cmd} { global incvs insvn inrcs ingit gen_log:log T "ENTER ($url $path $rev $target $cmd)" set command "svn $cmd" if {$rev != {} } { # Let them get away with saying r3 instead of 3 set rev [string trimleft $rev {r}] append command " -r$rev" } set dir [pwd] if {[file pathtype $target] eq "absolute"} { set tgt $target } else { set tgt "$dir/$target" } set mess "This will $cmd\n\ $url/$path\n\ to directory\n\ $tgt\n\ Are you sure?" if {[cvsconfirm $mess .modbrowse] == "ok"} { set path [safe_url $path] append command " $url/$path" if {$target != {} } { append command " $target" } set v [viewer::new "SVN $cmd"] $v\::do "$command" $v\::wait } gen_log:log T "LEAVE" } # SVN cat or ls. Called from module browser proc svn_filecat {root path title} { gen_log:log T "ENTER ($root $path $title)" set url [safe_url $root/$path] # Should do cat if it's a file and ls if it's a path if {[string match {*/} $title]} { set command "svn ls \"$url\"" set wintitle "SVN ls" } else { set command "svn cat \"$url\"" set wintitle "SVN cat" } set v [viewer::new "$wintitle $url"] $v\::do "$command" } # SVN log. Called from module browser proc svn_filelog {root path title} { gen_log:log T "ENTER ($root $path $title)" set command "svn log -g -v " set url [safe_url $root/$path] append command "\"$url\"" set wintitle "SVN Log" set v [viewer::new "$wintitle $url"] $v\::do "$command" } # This views a specific revision of a file in the repository. # For files checked out in the current sandbox. proc svn_fileview {revision filename kind} { gen_log:log T "ENTER ($revision $filename $kind)" set command "cat" if {$kind == "directory"} { set command "ls" } if {$revision == {}} { set command "svn $command \"$filename\"" set v [viewer::new "$filename"] } else { set command "svn $command -$revision \"$filename\"" set v [viewer::new "$filename Revision $revision"] } $v\::do "$command" gen_log:log T "LEAVE" } # Sends directory "." to the directory-merge tool proc svn_directory_merge {} { global cvsglb gen_log:log T "ENTER" gen_log:log D "Relative Path: $cvsglb(relpath)" ::svn_branchlog::new $cvsglb(relpath) . 1 gen_log:log T "LEAVE" } # Sends files to the SVN branch browser one at a time proc svn_branches {files} { global cvsglb gen_log:log T "ENTER ($files)" set filelist [join $files] gen_log:log D "Relative Path: $cvsglb(relpath)" if {$files == {}} { ::svn_branchlog::new $cvsglb(relpath) . } else { foreach file $files { ::svn_branchlog::new $cvsglb(relpath) $file } } gen_log:log T "LEAVE" } proc safe_url { url } { # Replacement is done in an ordered manner, so the key appearing # first in the list will be checked first, and so on. The string is # only iterated over once. set url [string map { "%20" "%20" "%25" "%25" "%26" "%26" "%" "%25" "&" "%26" " " "%20" } $url] return $url } namespace eval ::svn_branchlog { variable instance 0 proc new {relpath filename {directory_merge {0}} } { variable instance set my_idx $instance incr instance namespace eval $my_idx { set my_idx [uplevel {concat $my_idx}] set filename [uplevel {concat $filename}] set relpath [uplevel {concat $relpath}] set directory_merge [uplevel {concat $directory_merge}] global logcfg variable cmd_log variable lc variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable tags variable revbranches variable branchrevs variable logstate gen_log:log T "ENTER [namespace current]" if {$directory_merge} { set newlc [branch_diagram::new . "SVN,loc" [namespace current]] } else { set newlc [branch_diagram::new $filename "SVN,loc" [namespace current]] } set ln [lindex $newlc 0] set lc [lindex $newlc 1] # Implementation of Perl-like "grep {/re/} in_list" proc grep_filter { re in_list } { set res "" foreach x $in_list { if {[regexp $re $x]} { lappend res $x } } return $res } proc abortLog { } { global cvscfg variable cmd_log variable lc catch {$cmd_log\::abort} busy_done $lc pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal } proc reloadLog { } { global cvscfg global cvsglb global logcfg global module_dir variable filename variable cmd_log variable lc variable ln variable revwho variable revdate variable revtime variable revcomment variable revkind variable revpath variable revtags variable revbtags variable revmergefrom variable branchrevs variable allrevs variable revbranches variable logstate variable relpath variable filename gen_log:log T "ENTER" catch { $lc.canvas delete all } catch { unset revwho } catch { unset revdate } catch { unset revtime } catch { unset revcomment } catch { unset revtags } catch { unset revbtags } catch { unset revmergefrom } catch { unset branchrevs } catch { unset revbranches } catch { unset revkind } catch { unset revpath } set branchlist "" pack forget $lc.close pack $lc.stop -in $lc.down.closefm -side right $lc.stop configure -state normal busy_start $lc # Can't use file join or it will mess up the URL set safe_filename [safe_url $filename] set path "$cvscfg(url)/$safe_filename" $ln\::ConfigureButtons $filename # Find out where to put the working revision icon (if anywhere) set current_revnum [set $ln\::current_revnum] set current_revnum r$current_revnum if { $relpath == {} } { set path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$safe_filename" } else { set path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$relpath/$safe_filename" } if {! $cvsglb(svnconform)} { puts "Nonconforming trunk/branches/tags structure." puts "Can't find $path" set path "$cvscfg(svnroot)/$safe_filename" } # We need to go to the repository to find the highest revision. Doing # info on local files may not have it. Let's start with what we've got # though in case it fails. set highest_revision [string trimleft $current_revnum "r"] set command "svn info $path" gen_log:log C "$command" set ret [catch {exec {*}$command} output] if {$ret} { gen_log:log D "This file $path must not be in the trunk" ## cvsfail $output } foreach infoline [split $output "\n"] { if {[string match "Revision*" $infoline]} { set highest_revision [lrange $infoline 1 end] gen_log:log D "Highest revision: $highest_revision" } } # The trunk gen_log:log D "================ Getting TRUNK ================" set branchrevs(trunk) "" # There's nothing especially privileged about the trunk except that one # branch must not stop-on-copy. Maybe the file was added on a branch, # or maybe it isn't on the trunk anymore but it once was. We'll have # to use a range from r1 that case, to find it set range "${highest_revision}:1" set command "svn log -g -r $range $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy set trunk_lines [split $log_output "\n"] set rootrev [parse_svnlog $trunk_lines trunk] gen_log:log D "BASE/ROOT: $rootrev" # FiXME: if the file was merged onto the trunk, the oldest rev doesn't belong. # It's listed in stop-on-copy though # We do a stop-on-copy too, to see where the trunk started, since the # file may have been merged in from a branch set command "svn log -g -q --stop-on-copy $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy if {$log_output == ""} { gen_log:log D "trunk is EMPTY" } set loglines [split $log_output "\n"] parse_q $loglines trunk set rt [lindex $allrevs(trunk) end] gen_log:log D "trunk: BASE $rt" set branchroot(trunk) $rt if {$rt ne $rootrev} { set drawing_root $rt lappend branchlist $rt set branchrevs($rt) $allrevs(trunk) } else { set drawing_root $rootrev set branchrevs($rootrev) $branchrevs(trunk) } lappend revbtags($drawing_root) "trunk" if {$cvscfg(svn_trunkdir) ne "trunk"} { lappend revbtags($drawing_root) $cvscfg(svn_trunkdir) } set revpath($drawing_root) $path set revkind($drawing_root) "root" gen_log:log D "chose DRAWING ROOT $revpath($drawing_root)" # See if the current revision is on the trunk set curr 0 set brevs $branchrevs($drawing_root) set tip [lindex $brevs 0] set revpath($tip) $path set revkind($tip) "revision" if {$tip == $current_revnum} { # If current is at end of trunk do this. set branchrevs($drawing_root) [linsert $branchrevs($drawing_root) 0 {current}] set curr 1 } # We checked the tip, now check the rest while we assign revkind etc set brevs [lrange $brevs 1 end-1] foreach r $brevs { if {($curr == 0) && ($r == $current_revnum)} { # We need to make a new artificial branch off of $r lappend revbranches($r) {current} } gen_log:log D " $r $revdate($r) ($revcomment($r))" set revkind($r) "revision" set revpath($r) $path } # We may have added a "current" branch. We have to set all its # stuff or we'll get errors foreach {revwho(current) revdate(current) revtime(current) revlines(current) revcomment(current) branchrevs(current) revbtags(current)}\ {{} {} {} {} {} {} {}} \ { break } # if root is not empty added it to the branchlist if { $rootrev ne "" } { lappend branchlist $rootrev } # Prepare to draw something on the canvas so user knows we're working set cnv_y 20 set yspc 15 set cnv_h [winfo height $lc.canvas] set cnv_w [winfo width $lc.canvas] # subtract scrollbars etc incr cnv_h -20 incr cnv_w -20 # This is necessary to reset the view after clearing the canvas $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_h] set cnv_x [expr {$cnv_w / 2 - 8}] # Branches if {$logcfg(show_branches)} { # Get a list of the branches from the repository # Draw something on the canvas so the user knows we're working gen_log:log D "================ Getting BRANCHES ================" $lc.canvas create text $cnv_x $cnv_y -text "Getting BRANCHES" \ -tags {temporary} -fill black incr cnv_y $yspc set command "svn list $cvscfg(svnroot)/$cvscfg(svn_branchdir)" set cmd_log [exec::new $command {} 0 {} 1] set branches [$cmd_log\::output] $cmd_log\::destroy # There can be files such as "README" here that aren't branches # so we look for a trailing slash set branches [grep_filter {/$} $branches] catch {unset branchstart} for {set branchindex 0} {$branchindex < [llength $branches]} {incr branchindex} { set branch [lindex $branches $branchindex] set branch [string trimright $branch "/"] gen_log:log D "========= $branch ==========" # Draw something on the canvas so the user knows we're working $lc.canvas create text $cnv_x $cnv_y -text $branch \ -tags {temporary} -fill $cvscfg(colourB) $lc.canvas configure -scrollregion [list 0 0 $cnv_w $cnv_h] $lc.canvas yview moveto 1 incr cnv_y $yspc update # Can't use file join or it will mess up the URL if { $relpath == {} } { set path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$branch/$safe_filename" } else { set path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$branch/$relpath/$safe_filename" } # append branch start if available (used for deleted branches) if {[info exists branchstart($branch)]} { append path "@" $branchstart($branch) gen_log:log D "path += @$branchstart($branch)" } # Collect the branch revisions with stop-on-copy set command "svn log -g --stop-on-copy $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy if {$log_output == ""} { continue } set loglines [split $log_output "\n"] # find base of branch set rb [parse_svnlog $loglines $branch] # If the branch was not created by copy we have to correct the base if {$rb == $rootrev} { gen_log:log D "$branch was not created by copy" set command "svn log -q --stop-on-copy $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy if {$log_output == ""} { continue } set loglines [split $log_output "\n"] set line [lindex [lreverse $loglines] 2] gen_log:log D "line = $line" set splitline [split $line "|"] set rb [string trim [lindex $splitline 0]] } gen_log:log D "$branch: BASE $rb" set branchroot($branch) $rb # See if the current revision is on this branch, for "you are here" set curr 0 set brevs $branchrevs($branch) set tip [lindex $brevs 0] set revpath($tip) $path set revkind($tip) "revision" set brevs [lreplace $brevs 0 0] if {$tip == $current_revnum} { # If current is at end of the branch do this. set branchrevs($branch) [linsert $branchrevs($branch) 0 {current}] set curr 1 } foreach r $brevs { if {$r == $current_revnum} { # We need to make a new artificial branch off of $r lappend revbranches($r) {current} } gen_log:log D " $r $revdate($r) ($revcomment($r))" set revkind($r) "revision" set revpath($r) $path } # Don't overwrite revkind if it's been set, ie. if it's trunk if {! [info exists branchrevs($rb)]} { set branchrevs($rb) $branchrevs($branch) } if {! [info exists revkind($rb)]} { set revkind($rb) "branch" } # build a list of all branches so we can make sure each branch is on # a revbranch list so there will be a full set of branches on diagram lappend branchlist $rb lappend revbtags($rb) $branch if {! [info exists revkind($rb)]} { set revkind($rb) "branch" } if {! [info exists revpath($rb)]} { set revpath($rb) $path } set command "svn log -q -g $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] $cmd_log\::destroy if {$log_output == ""} { cvsfail "$command returned no output" return } set loglines [split $log_output "\n"] parse_q $loglines $branch # Deduce the parent of the branch by finding the last member of the # long list that's not in the stop-on-copy list set search_list [lreverse $allrevs($branch)] set idx [lsearch $search_list $rb] set bp [lindex $search_list $idx-1] # Skip tag revisions because they are not supported further down # Add deleted branches if we base on them # Do svn info on the parent to see which branch it belongs to. That branch # may have been deleted! set i 0 while {$i < 100 && $bp >= 0} { set command "svn info -r $bp $path" set cmd_info [exec::new $command {} 0 {} 1] set info_output [$cmd_info\::output] $cmd_info\::destroy if {$info_output == ""} { gen_log:log D "$command returned no output" break } set url [lrange [lindex [grep_filter {^URL:} [split $info_output "\n"]] 0] 1 end] # Do we base on an unknown branch? if {[regexp {/branches/} $url]} { regexp {/branches/([^/]*)} $url dummy b if {[lsearch -exact $branches $b/] < 0} { gen_log:log D "could not find parent branch $b, will add with start $bp" lappend branches $b/ set branchstart($b) $bp } } if {![regexp {/tags/} $url]} { break } # This is a tag, use previous revision gen_log:log D "$bp is a tag, using previous revision" incr idx -1 set bp [lindex $search_list $idx-1] incr i 1 } if {$bp < 0} { gen_log:log D "$branch is EMPTY" continue } gen_log:log D " PARENT for $branch: $bp" set revparent($rb) $bp lappend revbranches($bp) $rb gen_log:log D "===== finished $branch ======" } ;# Finished branches } # In Subversion, it takes a long time to gather the tags, so we draw the # branches and keep going # sort the list in rev number order set brlist [lsort -unique -dictionary $branchlist] gen_log:log D "BRANCHES $brlist" gen_log:log D "OLDEST ROOT $rootrev" gen_log:log D "DRAWING ROOT $drawing_root" if {! [info exists revbtags($rootrev)]} { gen_log:log D " revbtags($rootrev) is MISSING! Restoring original root" #Oops, I guess stop-on-copy quit on a tag instead of a branch. set revkind($rootrev) "root" set revkind($drawing_root) "revision" set revbtags($rootrev) "trunk" #set revpath($rootrev) $path set branchrevs($rootrev) $branchrevs(trunk) if {"current" in $branchrevs($drawing_root)} { set branchrevs($rootrev) [linsert $branchrevs($rootrev) 0 {current}] } catch {unset branchrevs($drawing_root)} catch {unset revbtags($drawing_root)} set btag $revbtags($rootrev) set drawing_root $rootrev } # This is mostly just a checkup set branchlist "" foreach br $brlist { if {[info exists revbtags($br)]} { set btag $revbtags($br) } else { continue } gen_log:log D "$br $btag" if {! [info exists branchroot($btag)]} { gen_log:log D " base of $br is MISSING" } if {[info exists revparent($br)]} { gen_log:log D " parent of $br is $revparent($br)" } else { gen_log:log D " parent of $br is MISSING" } } set branchlist $brlist gen_log:log D "branches $branchlist" pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal set branchrevs(current) "" # In SVN, sort_it_all_out is mostly a report [namespace current]::svn_sort_it_all_out set new_x [$ln\::DrawTree now] # We chose a branch other than the oldest one for this file, as the root. # Let's draw the branch that has the oldest rev for this file, too. if {$rootrev ne $drawing_root} { set sidetree_x [expr {$new_x + 2}] gen_log:log D "Adding UNROOTED branch: $rootrev" set new_x [$ln\::DrawSideTree $sidetree_x 0 $rootrev] } # Tags # Get a list of the tags from the repository if {$logcfg(show_tags)} { gen_log:log D "================ Getting TAGS ================" busy_start $lc gen_log:log D "RELPATH $relpath" gen_log:log D "MODULE DIR $module_dir" gen_log:log D "FILENAME $filename" gen_log:log D "SAFE FILENAME $safe_filename" # Search doesn't work if filename is "." if { $relpath == {} } { set command "svn list $relpath $cvscfg(svnroot)/$cvscfg(svn_tagdir)" } elseif {$safe_filename eq "."} { set command "svn list -R --search \"$module_dir\" $cvscfg(svnroot)/$cvscfg(svn_tagdir)" } else { set command "svn list -R --search \"$filename\" $cvscfg(svnroot)/$cvscfg(svn_tagdir)" } set cmd_log [exec::new $command {} 0 {} 1] set listlines [$cmd_log\::output] if {[info exists cmd_log)]} { $cmd_log\::destroy } set tags "" # We don't have to search the tag list, just trim the path if { $relpath == {} || $filename eq "."} { gen_log:log D "Trimming tag list" foreach tagline [split $listlines "\n"] { if {![llength $tagline]} {continue} set t [lindex [file split $tagline] 0] lappend tags $t } } else { # svn list --search doesn't allow paths, so we have to filter its output set srchstr "$module_dir/$filename" gen_log:log D "searching list output for $srchstr" foreach tagline [split $listlines "\n"] { if { [regsub "/*/$srchstr" $tagline {} t ] } { lappend tags $t } } } gen_log:log D "TAGS: $tags" set n_tags [llength $tags] gen_log:log D "Getting max $cvscfg(toomany_tags) of $n_tags tags" if {$n_tags > $cvscfg(toomany_tags)} { set tags [lrange $tags [expr {$n_tags - $cvscfg(toomany_tags)}] end] } foreach tag $tags { gen_log:log D "$tag" # Let user know we're workingl so the user knows we're working # Can't use file join or it will mess up the URL gen_log:log D "TAGS: RELPATH \"$relpath\"" if { $relpath == {} } { set path "$cvscfg(svnroot)/$cvscfg(svn_tagdir)/$tag/$safe_filename" } else { set path "$cvscfg(svnroot)/$cvscfg(svn_tagdir)/$tag/$relpath/$safe_filename" } # The tag is a revision, and the revision it tags is below it somewhere # Do log with limit and find the first revision which is not also a tag set command "svn log -q -g --limit 10 $path" set cmd_log [exec::new $command {} 0 {} 1] set log_output [$cmd_log\::output] if {[info exists cmd_log)]} { $cmd_log\::destroy } if {$log_output == ""} { continue } set loglines [split $log_output "\n"] parse_q $loglines $tag set rb [lindex $allrevs($tag) 0] set revkind($rb) "tag" # Do svn info on each revision listed under the tag until we # find one that ISN'T a tag. That's because the same revision can # have more than one tag, and we don't want to assign this tag to # another one on the same revision foreach r [lrange $allrevs($tag) 1 end] { if {! [info exists revkind($r)]} { set revkind($r) "revision" set revpath($r) $path } set command "svn info -r $r $path" set cmd_info [exec::new $command {} 0 {} 1] set info_output [$cmd_info\::output] $cmd_info\::destroy if {$info_output == ""} { gen_log:log D "$command returned no output" break } set found [grep_filter {^URL:.*/tags/} [split $info_output "\n"]] if {$found == ""} { lappend revtags($r) $tag gen_log:log D " $r is not a tag: revtags($r) $revtags($r)" break } } catch {unset allrevs($tag)} update idletasks } # In SVN, sort_it_all_out is mostly a report [namespace current]::svn_sort_it_all_out # Redraw $ln\::DrawTree now # We chose a branch other than the oldest one for this file, as the root. # Let's draw the branch that has the oldest rev for this file, too. if {$rootrev ne $drawing_root} { gen_log:log D "Adding UNROOTED branch: $rootrev" $ln\::DrawSideTree 40 0 $rootrev } } busy_done $lc gen_log:log T "LEAVE" return } # Parses a --stop-on-copy log, getting information for each revision proc parse_svnlog {lines r} { variable revwho variable revdate variable revtime variable revcomment variable branchrevs variable revmergefrom gen_log:log T "ENTER (<...> $r)" set revnum "" set i 0 set l [llength $lines] # in svn_log output, line zero is a separator and can be ignored while {$i < $l} { if { $i > 0 } { incr i -1 } set last [lindex $lines $i] incr i 1 set line [lindex $lines $i] #gen_log:log D "$i of $l: $line" if { [ regexp {^[-]+$} $last ] && [ regexp {^r[0-9]+ \| .*line[s]?$} $line] } { # ^ The last line was dashes and this one starts with a revnum if {[expr {$l - $i}] <= 1} {break} # ^ we came to the last line! # else deal with the line. We know it's formatted like this: # r4 | dorothyr | 2018-08-18 18:45:36 -0700 (Sat, 18 Aug 2018) | 1 line set line [lindex $lines $i] set splitline [split $line "|"] set revnum [string trim [lindex $splitline 0]] set revwho($revnum) [string trim [lindex $splitline 1]] set date_and_time [string trim [lindex $splitline 2]] set revdate($revnum) [lindex $date_and_time 0] set revtime($revnum) [lindex $date_and_time 1] set notelen [lindex [string trim [lindex $splitline 3]] 0] # See if there's merge info incr i 1 set line [lindex $lines $i] if { [string match "Merged via:*" $line] } { set splitline [split $line " "] set mergedvia [string trim [lindex $splitline end]] lappend revmergefrom($mergedvia) $revnum incr i 1 } else { lappend branchrevs($r) $revnum } incr i 1 set revcomment($revnum) "" set c 0 while {$c < $notelen} { append revcomment($revnum) "[lindex $lines [expr {$c + $i}]]\n" incr c } set revcomment($revnum) [string trimright $revcomment($revnum)] #gen_log:log D "revcomment($revnum) $revcomment($revnum)" } incr i } # Correct the revision list, svn may miss some merged via lines, resulting in # non consecutive revisions set revs "" set last 0 foreach rev [lreverse $branchrevs($r)] { set actual [string range $rev 1 end] if {$actual > $last} { lappend revs $rev set last $actual } else { gen_log:log D "skipping $rev because of wrong order" } } set branchrevs($r) [lreverse $revs] gen_log:log T "LEAVE \"$revnum\"" # Return the base revnum of the branch return $revnum } # Parses a summary (-q) log to find what revisions are on it proc parse_q {lines r} { variable allrevs set allrevs($r) "" foreach line $lines { if {[regexp {^r} $line]} { gen_log:log D "$line" set splitline [split $line "|"] set revnum [string trim [lindex $splitline 0]] lappend allrevs($r) $revnum } } } proc svn_sort_it_all_out {} { global cvscfg global current_tagname variable filename variable lc variable ln variable revwho variable revdate variable revtime variable revcomment variable revkind variable revpath variable revtags variable revbtags variable branchrevs variable revbranches variable revmergefrom variable logstate variable revnum variable rootbranch variable revbranch gen_log:log T "ENTER" # Sort the revision and branch lists and remove duplicates foreach r [lsort -dictionary [array names revkind]] { gen_log:log D "revkind($r) $revkind($r)" } #foreach r [lsort -dictionary [array names revpath]] { #gen_log:log D "revpath($r) $revpath($r)" #} gen_log:log D "" foreach a [lsort -dictionary [array names branchrevs]] { gen_log:log D "branchrevs($a) $branchrevs($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revbranches]] { # sort the rev branches so they will be displayed in increasing order set revbranches($a) [lsort -dictionary $revbranches($a)] gen_log:log D "revbranches($a) $revbranches($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revbtags]] { gen_log:log D "revbtags($a) $revbtags($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revtags]] { gen_log:log D "revtags($a) $revtags($a)" } gen_log:log D "" foreach a [lsort -dictionary [array names revmergefrom]] { # Only take the highest rev of the messsy list that you might have here set revmergefrom($a) [lindex [lsort -dictionary $revmergefrom($a)] end] gen_log:log D "revmergefrom($a) $revmergefrom($a)" } # We only needed these to place the you-are-here box. catch {unset rootbranch revbranch} gen_log:log T "LEAVE" } [namespace current]::reloadLog return [namespace current] } } } tkrev_9.6.1/tkrev/workdir.tcl0000664000175000017500000016360715034126547016620 0ustar dorothyrdorothyr # Tcl Library for TkRev # # # Current working directory display. Handles all of the functions # concerned with navigating about the current directory on the main # window. # proc workdir_setup {} { global cwd global module_dir global cvscfg global cvsglb global colorglb global current_tagname global logclass global tcl_platform global incvs insvn inrcs ingit gen_log:log T "ENTER" set cwd [pwd] set pid [pid] if {[winfo exists .workdir]} { wm deiconify .workdir raise .workdir return } # Make a new toplevel and unmap . so that the working directory browser # the module browser are not in a parent-child relation toplevel .workdir wm title .workdir "TkRev Working Directory" wm iconname .workdir "TkRev Working Directory" wm iconphoto .workdir -default AppIcon wm minsize .workdir 430 300 wm protocol .workdir WM_DELETE_WINDOW { .workdir.close invoke } wm withdraw . if {[info exists cvscfg(workgeom)]} { wm geometry .workdir $cvscfg(workgeom) } menubar_menus .workdir workdir_menus .workdir help_menu .workdir # # Top section - where we are, where the module is # frame .workdir.top -relief groove -borderwidth 2 pack .workdir.top -side top -fill x ttk::combobox .workdir.top.tcwd -textvariable cwd .workdir.top.tcwd configure -values $cvsglb(directory) bind .workdir.top.tcwd {set cwd [validate_dirpath %W $cwd]} bind .workdir.top.tcwd ".workdir.top.tcwd configure -foreground $colorglb(textfg)" bind .workdir.top.tcwd { if {[change_dir "$cwd"]} {%W configure -foreground black} } bind .workdir.top.tcwd <> { if {[change_dir "$cwd"]} {%W configure -foreground black} } button .workdir.top.updir_btn -image updir \ -command {change_dir ..} label .workdir.top.lmodule -text "Path" label .workdir.top.tmodule -textvariable module_dir -anchor w -relief groove -bd 2 label .workdir.top.ltagname -text "Tag" label .workdir.top.ttagname -textvariable current_tagname \ -anchor w -relief groove -bd 2 # Make the Repository Browser button prominent button .workdir.top.bmodbrowse -image Modules -command modbrowse_run label .workdir.top.lcvsroot -text "CVSROOT" label .workdir.top.tcvsroot -textvariable cvscfg(cvsroot) \ -anchor w -relief groove -bd 2 grid columnconf .workdir.top 1 -weight 1 grid rowconf .workdir.top 3 -weight 1 grid .workdir.top.updir_btn -column 0 -row 0 -sticky s grid .workdir.top.tcwd -column 1 -row 0 -columnspan 2 \ -sticky sew -padx 4 -pady 1 grid .workdir.top.lmodule -column 0 -row 1 -sticky nw grid .workdir.top.tmodule -column 1 -row 1 -columnspan 2\ -padx 4 -pady 1 -sticky new grid .workdir.top.bmodbrowse -column 2 -row 2 -rowspan 2 -sticky w grid .workdir.top.ltagname -column 0 -row 2 -sticky nw grid .workdir.top.ttagname -column 1 -row 2 -padx 4 -pady 1 -sticky new grid .workdir.top.lcvsroot -column 0 -row 3 -sticky nw grid .workdir.top.tcvsroot -column 1 -row 3 -padx 4 -sticky new # Pack the bottom before the middle so it doesnt disappear if # the window is resized smaller frame .workdir.bottom frame .workdir.bottom.filters -relief raised pack .workdir.bottom -side bottom -fill x pack .workdir.bottom.filters -side top -fill x label .workdir.bottom.filters.showlbl -text "Show:" -anchor w entry .workdir.bottom.filters.showentry -width 12 \ -textvariable cvscfg(show_file_filter) label .workdir.bottom.filters.hidelbl -text " Hide:" -anchor w entry .workdir.bottom.filters.hideentry -width 12 \ -textvariable cvscfg(ignore_file_filter) label .workdir.bottom.filters.space -text " " button .workdir.bottom.filters.cleanbutton -text "Clean:" \ -pady 0 -highlightthickness 0 \ -command workdir_cleanup entry .workdir.bottom.filters.cleanentry -width 12 \ -textvariable cvscfg(clean_these) label .workdir.bottom.filters.vcshidelbl -text " \[vcs\]ignore" entry .workdir.bottom.filters.vcshideentry -width 12 -state readonly \ -textvariable cvsglb(vcs_hidden_files) bind .workdir.bottom.filters.showentry {setup_dir} bind .workdir.bottom.filters.hideentry {setup_dir} bind .workdir.bottom.filters.cleanentry {workdir_cleanup} pack .workdir.bottom.filters.showlbl -side left pack .workdir.bottom.filters.showentry -side left pack .workdir.bottom.filters.hidelbl -side left pack .workdir.bottom.filters.hideentry -side left pack .workdir.bottom.filters.space -side left pack .workdir.bottom.filters.cleanbutton -side left -ipadx 2 -ipady 0 pack .workdir.bottom.filters.cleanentry -side left pack .workdir.bottom.filters.vcshidelbl -side left pack .workdir.bottom.filters.vcshideentry -side left frame .workdir.bottom.buttons -relief groove -bd 2 frame .workdir.bottom.buttons.funcs -relief groove -bd 2 frame .workdir.bottom.buttons.dirfuncs -relief groove -bd 2 frame .workdir.bottom.buttons.cvsfuncs -relief groove -bd 2 frame .workdir.bottom.buttons.oddfuncs -relief flat -bd 2 frame .workdir.bottom.buttons.closefm pack .workdir.bottom.buttons -side top -fill x -expand yes pack .workdir.bottom.buttons.closefm -side right -expand yes pack .workdir.bottom.buttons.funcs -side left -expand yes -anchor w pack .workdir.bottom.buttons.dirfuncs -side left -expand yes -anchor w pack .workdir.bottom.buttons.cvsfuncs -side left -expand yes -anchor w pack .workdir.bottom.buttons.oddfuncs -side left -expand yes -anchor w # # Action buttons along the bottom of the screen. # button .workdir.bottom.buttons.funcs.bedit_files -image Fileedit \ -command { workdir_edit_file [workdir_list_files] } button .workdir.bottom.buttons.funcs.bview_files -image Fileview \ -command { workdir_view_file [workdir_list_files] } button .workdir.bottom.buttons.funcs.bdelete_file -image Delete \ -command { workdir_delete_file [workdir_list_files] } button .workdir.bottom.buttons.funcs.bmkdir -image Dir_new \ -command { file_input_and_do "New Directory" workdir_newdir} button .workdir.bottom.buttons.dirfuncs.brefresh -image Refresh \ -command { setup_dir } button .workdir.bottom.buttons.dirfuncs.bcheckdir -image Check \ -command { cvs_check } button .workdir.bottom.buttons.dirfuncs.patchdiff -image Patches button .workdir.bottom.buttons.cvsfuncs.blogfile -image Branches \ -command { cvs_branches [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bannotate -image Annotate \ -command { cvs_annotate $current_tagname [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bfilelog -image Log \ -command { cvs_log verbose [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bdiff -image Diff \ -command { comparediff [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bconflict -image Conflict \ -command { cvs_reconcile_conflict [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.btag -image Tag \ -command { tag_dialog } button .workdir.bottom.buttons.cvsfuncs.bbranchtag -image Branchtag \ -command { branch_dialog } button .workdir.bottom.buttons.cvsfuncs.badd_files -image Add \ -command { add_dialog [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bremove -image Remove \ -command { subtract_dialog [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bcheckin -image Checkin \ -command cvs_commit_dialog button .workdir.bottom.buttons.cvsfuncs.bupdate -image Checkout button .workdir.bottom.buttons.cvsfuncs.bupdateopts -image CheckoutOpts \ -command { cvs_update_options } button .workdir.bottom.buttons.cvsfuncs.brevert -image Revert \ -command { cvs_revert [workdir_list_files] } button .workdir.bottom.buttons.cvsfuncs.bjoin -image DirBranches \ -image DirBranches -command cvs_joincanvas button .workdir.bottom.buttons.oddfuncs.bcvsedit_files -image Edit \ -command { edit_dialog [workdir_list_files] } button .workdir.bottom.buttons.oddfuncs.bunedit_files -image Unedit \ -command { unedit_dialog [workdir_list_files] } button .workdir.bottom.buttons.oddfuncs.block -image Lock button .workdir.bottom.buttons.oddfuncs.bunlock -image UnLock button .workdir.bottom.buttons.oddfuncs.bpush -image Checkin \ -command { git_push } button .workdir.bottom.buttons.oddfuncs.bfetch -image Checkout \ -command { git_fetch } button .workdir.close -text "Close" \ -command { global cvscfg set cvscfg(workgeom) [wm geometry .workdir] destroy .workdir exit_cleanup 0 } # These buttons work in any directory grid .workdir.bottom.buttons.funcs.bdelete_file -column 0 -row 0 -ipadx 4 grid .workdir.bottom.buttons.funcs.bedit_files -column 1 -row 0 -ipadx 4 grid .workdir.bottom.buttons.funcs.bmkdir -column 0 -row 1 -ipadx 4 grid .workdir.bottom.buttons.funcs.bview_files -column 1 -row 1 -ipadx 4 # Directory functions grid rowconf .workdir.bottom.buttons.dirfuncs 0 -weight 1 grid .workdir.bottom.buttons.dirfuncs.brefresh -column 0 -row 0 -ipadx 4 -ipady 4 grid .workdir.bottom.buttons.dirfuncs.bcheckdir -column 1 -row 0 -ipadx 4 -ipady 4 grid .workdir.bottom.buttons.dirfuncs.patchdiff -column 2 -row 0 -ipadx 4 -ipady 4 # Revcontrol functions grid .workdir.bottom.buttons.cvsfuncs.blogfile -column 0 -row 0 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.bjoin -column 0 -row 1 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.bdiff -column 1 -row 0 -ipadx 2 grid .workdir.bottom.buttons.cvsfuncs.bconflict -column 1 -row 1 -ipadx 2 grid .workdir.bottom.buttons.cvsfuncs.bfilelog -column 2 -row 0 grid .workdir.bottom.buttons.cvsfuncs.bannotate -column 2 -row 1 grid .workdir.bottom.buttons.cvsfuncs.bupdate -column 3 -row 0 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.bcheckin -column 3 -row 1 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.bupdateopts -column 4 -row 0 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.brevert -column 4 -row 1 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.badd_files -column 5 -row 0 grid .workdir.bottom.buttons.cvsfuncs.bremove -column 5 -row 1 grid .workdir.bottom.buttons.cvsfuncs.btag -column 6 -row 0 -ipadx 4 grid .workdir.bottom.buttons.cvsfuncs.bbranchtag -column 6 -row 1 -ipadx 4 pack .workdir.close -in .workdir.bottom.buttons.closefm \ -side right -fill both -expand yes set_tooltips .workdir.top.updir_btn \ {"Go up (..)"} set_tooltips .workdir.bottom.buttons.funcs.bedit_files \ {"Edit the selected files"} set_tooltips .workdir.bottom.buttons.funcs.bview_files \ {"View the selected files"} set_tooltips .workdir.bottom.buttons.funcs.bdelete_file \ {"Delete the selected files from the current directory"} set_tooltips .workdir.bottom.buttons.funcs.bmkdir \ {"Make a new directory"} set_tooltips .workdir.bottom.buttons.dirfuncs.brefresh \ {"Re-read the current directory"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bjoin \ {"Directory Branch Diagram and Merge Tool"} set_tooltips .workdir.bottom.buttons.dirfuncs.bcheckdir \ {"Check the status of the directory"} set_tooltips .workdir.bottom.buttons.dirfuncs.patchdiff \ {"Show diffs in the changed files"} set_tooltips .workdir.bottom.buttons.cvsfuncs.blogfile \ {"Graphical Branch Diagram of the selected files"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bfilelog \ {"Revision log of the selected files"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bannotate \ {"Revision where each line was modified (annotate/blame)"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bdiff \ {"Side-by-side comparison of files to the committed version"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bconflict \ {"Merge Conflicts using TkDiff"} set_tooltips .workdir.bottom.buttons.cvsfuncs.btag \ {"Tag the selected files"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bbranchtag \ {"Branch the selected files"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bupdateopts \ {"Update with options (-A, -r, -f, -d, -kb)"} set_tooltips .workdir.bottom.buttons.oddfuncs.block \ {"Lock the selected files"} set_tooltips .workdir.bottom.buttons.oddfuncs.bunlock \ {"Unlock the selected files"} set_tooltips .workdir.bottom.buttons.oddfuncs.bcvsedit_files \ {"Set the Edit flag on the selected files"} set_tooltips .workdir.bottom.buttons.oddfuncs.bunedit_files \ {"Unset the Edit flag on the selected files"} set_tooltips .workdir.bottom.buttons.oddfuncs.bpush \ {"Push to origin"} set_tooltips .workdir.bottom.buttons.oddfuncs.bfetch \ {"Fetch from origin"} set_tooltips .workdir.top.bmodbrowse \ {"Open the Repository Browser"} set_tooltips .workdir.close \ {"Close the Working Directory Browser"} frame .workdir.main pack .workdir.main -side bottom -fill both -expand 1 -fill both update idletasks if {! [winfo ismapped .workdir]} { wm deiconify .workdir } setup_dir gen_log:log T "LEAVE" } # Returns a list of the selected file names. This is where the arg-list comes # from for most of the UI buttons and menus. proc workdir_list_files {} { global DirList global cvsglb set wt .workdir.main.tree set cvsglb(current_selection) "" set DirList($wt:selection) "" set selected_items [$wt selection] foreach s $selected_items { set f [$wt set $s filecol] lappend DirList($wt:selection) "$f" } set cvsglb(current_selection) $DirList($wt:selection) gen_log:log T "LEAVE -- ($cvsglb(current_selection))" return $cvsglb(current_selection) } proc workdir_edit_command {file} { global cvscfg gen_log:log T "ENTER ($file)" if {[info exists cvscfg(editors)]} { foreach {editor pattern} $cvscfg(editors) { if {[string match $pattern $file]} { return "$editor \"$file\"" } } } return "$cvscfg(editor) \"$file\"" } proc workdir_newdir {file} { global cvscfg gen_log:log T "ENTER ($file)" if [catch {file mkdir $file} err] { cvsfail "$err" .workdir return } gen_log:log F "mkdir $file" if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc workdir_edit_file {args} { global cwd global tcl_version gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { file_input_and_do "Edit File" workdir_edit_file return } gen_log:log D "$filelist" foreach file $filelist { if {[file isdirectory $file]} { change_dir "$file" return } if {![file exists "$file"]} { cvsfail "$file does not exist" .workdir return } if {![file isfile "$file"]} { cvsfail "$file is not a plain file" .workdir return } regsub -all {\$} $file {\$} file set commandline [workdir_edit_command $file] set editcmd [exec::new $commandline] } gen_log:log T "LEAVE" } proc workdir_view_file {args} { global cwd global tcl_version gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some files to view first!" .workdir return } gen_log:log D "$filelist" foreach file $filelist { set filelog "" set line "" if {![file exists $file]} { cvsfail "$file does not exist" .workdir return } if {![file isfile $file]} { cvsfail "$file is not a plain file" .workdir return } gen_log:log F "OPEN $file" set f [open $file] if {$tcl_version >= 9.0} {chan configure $f -profile tcl8} while { [eof $f] == 0 } { set ret [catch {chan gets $f line} err] if {$ret} { gen_log:log E $err catch {close $f} cvsfail $err return } else { append filelog $line append filelog "\n" } } catch {chan close $f} view_output::new "$file" $filelog } gen_log:log T "LEAVE" } # Let the user mark directories they visit often proc add_bookmark { } { global incvs inrcs insvn ingit global bookmarks gen_log:log T "ENTER" set dir [pwd] regsub -all {\$} $dir {\$} dir gen_log:log D "directory $dir" foreach mark [array names bookmarks] { gen_log:log D " $mark \"$bookmarks($mark)\"" } if {[info exists bookmarks($dir)]} { .workdir.menubar.goto delete "$dir $bookmarks($dir)" } set rtype "" if {$inrcs} { set rtype "(RCS)" } elseif {$incvs} { set rtype "(CVS)" } elseif {$insvn} { set rtype "(SVN)" } elseif {$ingit} { set rtype "(GIT)" } set bookmarks($dir) $rtype .workdir.menubar.goto add command -label "$dir $rtype" \ -command "change_dir \"$dir\"" gen_log:log T "LEAVE" } # A listbox to choose a bookmark to delete proc delete_bookmark_dialog { } { global cvsglb global colorglb global bookmarks gen_log:log T "ENTER" set maxlbl 0 foreach mark [array names bookmarks] { gen_log:log D " $mark $bookmarks($mark)" set len [string length "$mark $bookmarks($mark)"] if {$len > $maxlbl} { set maxlbl $len } } set wname .workdir.bookmarkedit toplevel $wname grab set $wname wm title $wname "Delete Bookmarks" listbox $wname.lbx -selectmode multiple \ -font $colorglb(listboxfont) -width $maxlbl pack $wname.lbx -ipadx 10 -ipady 10 -expand y -fill both foreach mark [lsort [array names bookmarks]] { $wname.lbx insert end "$mark $bookmarks($mark)" } frame $wname.buttons pack $wname.buttons -side top -fill x button $wname.delete -text "Delete" \ -command "delete_bookmark $wname" button $wname.close -text "Done" \ -command " grab release $wname destroy $wname exit_cleanup 0" pack $wname.delete $wname.close -in $wname.buttons \ -side right -ipadx 2 -ipady 2 -padx 4 -pady 4 \ -expand y gen_log:log T "LEAVE" } # Do the actual deletion of the bookmark proc delete_bookmark {w} { global bookmarks gen_log:log T "ENTER ($w)" set items [$w.lbx curselection] foreach item $items { set itemstring [$w.lbx get $item] #set dir [join [lrange $itemstring 0 end-1]] regsub {\s+$} $itemstring {} dir regsub {\s+\([A-Z][A-Z][A-Z]\)$} $dir {} dir gen_log:log D "$item \"$itemstring\"" gen_log:log D " directory \"$dir\"" unset bookmarks($dir) $w.lbx delete $item .workdir.menubar.goto delete $itemstring } gen_log:log T "LEAVE" } proc auto_setup_dir {command} { global cvscfg if {$cvscfg(auto_status)} { $command\::wait setup_dir } else { after 0 "$command\::wait; $command\::destroy" } } proc setup_dir { } { # # Call this when entering a directory. It puts all of the file names # in the listbox, and reads the directory. # global cwd global env global module_dir global incvs insvn inrcs ingit global cvscfg global cvsglb global current_tagname gen_log:log T "ENTER" set savyview 0 if { ! [winfo exists .workdir.main] } { workdir_setup return } else { if {[winfo exists .workdir.main.filecol.list]} { set savyview [lindex [.workdir.main.filecol.list yview] 0] } DirCanvas:deltree .workdir.main.tree } set module_dir "" set current_tagname "" set cvsglb(vcs_hidden_files) "" lassign [vcs_detect [pwd]] incvs insvn inrcs ingit gen_log:log D "incvs=$incvs inrcs=$inrcs insvn=$insvn ingit=$ingit" .workdir.top.bmodbrowse configure -image Modules .workdir.top.lmodule configure -text "Path" .workdir.top.ltagname configure -text "Branch/Tag" .workdir.top.lcvsroot configure -text "Repository" .workdir.top.tcvsroot configure -textvariable cvscfg(cvsroot) set cvsglb(root) $cvscfg(cvsroot) set cvsglb(vcs) cvs # Start without revision-control menu gen_log:log D "CONFIGURE VCS MENUS" foreach label {"RCS" "CVS" "SVN" "GIT" "Git Tools" "Import"} { if {! [catch {set vcsmenu_idx [.workdir.menubar index "$label"]}]} { .workdir.menubar delete $vcsmenu_idx } } set filemenu_idx [.workdir.menubar index "File"] # Disable report menu items .workdir.menubar.reports entryconfigure "Check Directory" -state disabled .workdir.menubar.reports entryconfigure "Status" -state disabled .workdir.menubar.reports entryconfigure "Log" -state disabled .workdir.menubar.reports entryconfigure "Info" -state disabled # Start with the revision-control buttons disabled .workdir.bottom.filters.vcshidelbl configure -text "VCS hidden:" .workdir.bottom.buttons.dirfuncs.bcheckdir configure -state disabled .workdir.bottom.buttons.dirfuncs.patchdiff configure -state disabled foreach widget [grid slaves .workdir.bottom.buttons.cvsfuncs ] { $widget configure -state disabled } foreach widget [grid slaves .workdir.bottom.buttons.cvsfuncs ] { $widget configure -state disabled } .workdir.bottom.buttons.oddfuncs configure -relief flat -bd 2 foreach widget [grid slaves .workdir.bottom.buttons.oddfuncs ] { #$widget configure -state disabled grid forget $widget } # Default for these, only Git is different .workdir.bottom.buttons.cvsfuncs.bcheckin configure -state disabled \ -image Checkin .workdir.bottom.buttons.cvsfuncs.bupdate configure -state disabled \ -image Checkout set_tooltips .workdir.bottom.buttons.cvsfuncs.bjoin \ {"Directory Branch Diagram and Merge Tool"} set_tooltips .workdir.bottom.buttons.cvsfuncs.badd_files \ {"Add the selected files to the repository"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bremove \ {"Remove the selected files from the repository"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bcheckin \ {"Check in (commit) the selected files to the repository"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bupdate \ {"Update (checkout, patch) the selected files from the repository"} set_tooltips .workdir.bottom.buttons.cvsfuncs.brevert \ {"Revert the selected files, discarding local edits"} # Now enable them depending on where we are if {$inrcs} { # Top gen_log:log D "CONFIGURE RCS MENUS" .workdir.menubar insert [expr {$filemenu_idx + 1}] cascade -label "RCS" \ -menu .workdir.menubar.rcs .workdir.top.bmodbrowse configure -image Modules -command modbrowse_run .workdir.top.lcvsroot configure -text "RCS Path" .workdir.top.tcvsroot configure -textvariable cvscfg(rcsdir) set cvsglb(root) $cvscfg(rcsdir) set cvsglb(vcs) rcs # Buttons .workdir.bottom.buttons.funcs.bview_files configure \ -command { workdir_view_file [workdir_list_files] } .workdir.bottom.buttons.dirfuncs.bcheckdir configure -state normal \ -command { rcs_check } .workdir.bottom.buttons.cvsfuncs.bdiff configure -state normal .workdir.bottom.buttons.cvsfuncs.blogfile configure -state normal \ -command { rcs_branches [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bfilelog configure -state normal \ -command { rcs_log "verbose" [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bupdate configure -state normal \ -command { rcs_checkout [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bcheckin configure -state normal \ -command { rcs_commit_dialog [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.brevert configure -state normal \ -command { rcs_revert [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.btag configure -state normal .workdir.bottom.buttons.oddfuncs configure -relief groove -bd 2 grid .workdir.bottom.buttons.oddfuncs.block -column 0 -row 0 grid .workdir.bottom.buttons.oddfuncs.bunlock -column 0 -row 1 .workdir.bottom.buttons.oddfuncs.block configure -state normal \ -command { rcs_lock lock [workdir_list_files] } .workdir.bottom.buttons.oddfuncs.bunlock configure -state normal \ -command { rcs_lock unlock [workdir_list_files] } # Reports menu for RCS # Check Directory (log & rdiff) .workdir.menubar.reports entryconfigure "Check Directory" -state normal \ -command { rcs_check } .workdir.menubar.reports entryconfigure "Status" -state disabled # Log (rlog) .workdir.menubar.reports entryconfigure "Log" -state normal .workdir.menubar.reports.log_detail entryconfigure "Latest" \ -command { rcs_log "latest" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Summary" \ -command { rcs_log "summary" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Verbose" \ -command { rcs_log "verbose" [workdir_list_files] } .workdir.menubar.reports entryconfigure "Info" -state disabled # Options for reports .workdir.menubar.reports entryconfigure "Report Unknown Files" -state disabled .workdir.menubar.reports entryconfigure "Report Recursively" -state disabled } elseif {$insvn} { # Top gen_log:log D "CONFIGURE SVN MENUS" .workdir.menubar insert [expr {$filemenu_idx + 1}] cascade -label "SVN" \ -menu .workdir.menubar.svn .workdir.top.bmodbrowse configure -image Modules_svn -command modbrowse_run .workdir.top.lmodule configure -text "Path" .workdir.top.ltagname configure -text "Tag" .workdir.top.lcvsroot configure -text "SVN URL" .workdir.top.tcvsroot configure -textvariable cvscfg(url) set cvsglb(root) $cvscfg(url) set cvsglb(vcs) svn # Buttons .workdir.bottom.buttons.funcs.bview_files configure \ -command { workdir_view_file [workdir_list_files] } .workdir.bottom.buttons.dirfuncs.bcheckdir configure -state normal \ -command { svn_check } .workdir.bottom.buttons.dirfuncs.patchdiff configure -state normal \ -command { svn_patch $cvscfg(url) {} {} {} {} {} 0 {} } .workdir.bottom.buttons.cvsfuncs.bjoin configure -state normal \ -image DirBranches -command { svn_branches . } .workdir.bottom.buttons.cvsfuncs.bdiff configure -state normal .workdir.bottom.buttons.cvsfuncs.blogfile configure -state normal \ -command { svn_branches [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bfilelog configure -state normal \ -command { svn_log "verbose" [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bannotate configure -state normal \ -command { svn_annotate rBASE [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bconflict configure -state normal \ -command { foreach f [workdir_list_files] {svn_reconcile_conflict \"$f\"} } .workdir.bottom.buttons.cvsfuncs.badd_files configure -state normal .workdir.bottom.buttons.cvsfuncs.bremove configure -state normal .workdir.bottom.buttons.cvsfuncs.bupdate configure -state normal \ -command { svn_update [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bupdateopts configure -state normal \ -command { svn_update_options } .workdir.bottom.buttons.cvsfuncs.bcheckin configure -state normal \ -command svn_commit_dialog .workdir.bottom.buttons.cvsfuncs.brevert configure -state normal \ -command { svn_revert [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.btag configure -state normal .workdir.bottom.buttons.cvsfuncs.bbranchtag configure -state normal .workdir.bottom.buttons.oddfuncs configure -relief groove -bd 2 grid .workdir.bottom.buttons.oddfuncs.block -column 0 -row 0 grid .workdir.bottom.buttons.oddfuncs.bunlock -column 0 -row 1 .workdir.bottom.buttons.oddfuncs.block configure -state normal \ -command { svn_lock lock [workdir_list_files] } .workdir.bottom.buttons.oddfuncs.bunlock configure -state normal \ -command { svn_lock unlock [workdir_list_files] } # Reports menu for SVN # Check Directory (svn status) .workdir.menubar.reports entryconfigure "Check Directory" -state normal \ -command { svn_check } # Status (svn status ) .workdir.menubar.reports entryconfigure "Status" -state normal .workdir.menubar.reports.status_detail entryconfigure "Terse" \ -command { svn_status "terse" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Summary" \ -command { svn_status "summary" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Verbose" \ -command { svn_status "verbose" [workdir_list_files] } # Log (svn log) .workdir.menubar.reports entryconfigure "Log" -state normal .workdir.menubar.reports.log_detail entryconfigure "Latest" \ -command { svn_log "latest" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Summary" \ -command { svn_log "summary" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Verbose" \ -command { svn_log "verbose" [workdir_list_files] } # General info (svn info) .workdir.menubar.reports entryconfigure "Info" -state normal \ -command { svn_info [workdir_list_files] } # Options for reports .workdir.menubar.reports entryconfigure "Report Unknown Files" -state normal .workdir.menubar.reports entryconfigure "Report Recursively" -state normal } elseif {$incvs} { # Top gen_log:log D "CONFIGURE CVS MENUS" .workdir.menubar insert [expr {$filemenu_idx + 1}] cascade -label "CVS" \ -menu .workdir.menubar.cvs .workdir.top.bmodbrowse configure -image Modules_cvs -command modbrowse_run .workdir.top.lmodule configure -text "Module" .workdir.top.ltagname configure -text "Tag" .workdir.top.lcvsroot configure -text "CVSROOT" .workdir.top.tcvsroot configure -textvariable cvscfg(cvsroot) set cvsglb(root) $cvscfg(cvsroot) set cvsglb(vcs) cvs # Buttons .workdir.bottom.buttons.funcs.bview_files configure \ -command { workdir_view_file [workdir_list_files] } .workdir.bottom.buttons.dirfuncs.bcheckdir configure -state normal \ -command { cvs_check } .workdir.bottom.buttons.dirfuncs.patchdiff configure -state normal \ -command { cvs_diff } .workdir.bottom.buttons.cvsfuncs.bjoin configure -state normal \ -image DirBranches -command cvs_joincanvas .workdir.bottom.buttons.cvsfuncs.bdiff configure -state normal .workdir.bottom.buttons.cvsfuncs.bconflict configure -state normal \ -command { cvs_reconcile_conflict [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bfilelog configure -state normal \ -command { cvs_log "verbose" [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bannotate configure -state normal \ -command { cvs_annotate $current_tagname [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.badd_files configure -state normal .workdir.bottom.buttons.cvsfuncs.bremove configure -state normal .workdir.bottom.buttons.cvsfuncs.bupdate configure -state normal \ -command { \ cvs_update {BASE} {Normal} {Remove} {recurse} {prune} {No} { } [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bupdateopts configure -state normal \ -command { cvs_update_options } .workdir.bottom.buttons.cvsfuncs.bcheckin configure -state normal \ -command cvs_commit_dialog .workdir.bottom.buttons.cvsfuncs.brevert configure -state normal \ -command {cvs_revert [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.btag configure -state normal .workdir.bottom.buttons.cvsfuncs.bbranchtag configure -state normal .workdir.bottom.buttons.cvsfuncs.blogfile configure -state normal \ -command { cvs_branches [workdir_list_files] } .workdir.bottom.buttons.oddfuncs configure -relief groove -bd 2 grid .workdir.bottom.buttons.oddfuncs.block -column 0 -row 0 grid .workdir.bottom.buttons.oddfuncs.bunlock -column 0 -row 1 grid .workdir.bottom.buttons.oddfuncs.bcvsedit_files -column 1 -row 0 grid .workdir.bottom.buttons.oddfuncs.bunedit_files -column 1 -row 1 if {$cvscfg(econtrol)} { .workdir.bottom.buttons.oddfuncs.bcvsedit_files configure -state normal .workdir.bottom.buttons.oddfuncs.bunedit_files configure -state normal } else { .workdir.bottom.buttons.oddfuncs.bcvsedit_files configure -state disabled .workdir.bottom.buttons.oddfuncs.bunedit_files configure -state disabled } if {$cvscfg(cvslock)} { .workdir.bottom.buttons.oddfuncs.block configure -state normal \ -command { cvs_lock lock [workdir_list_files] } .workdir.bottom.buttons.oddfuncs.bunlock configure -state normal \ -command { cvs_lock unlock [workdir_list_files] } } else { .workdir.bottom.buttons.oddfuncs.block configure -state disabled .workdir.bottom.buttons.oddfuncs.bunlock configure -state disabled } # Reports menu for CVS # Check Directory (cvs -n -q update) .workdir.menubar.reports entryconfigure "Check Directory" -state normal \ -command { cvs_check } # Status (cvs -Q status) .workdir.menubar.reports entryconfigure "Status" -state normal .workdir.menubar.reports.status_detail entryconfigure "Terse" \ -command { cvs_status "terse" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Summary" \ -command { cvs_status "summary" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Verbose" \ -command { cvs_status "verbose" [workdir_list_files] } # Log (cvs log) .workdir.menubar.reports entryconfigure "Log" -state normal .workdir.menubar.reports.log_detail entryconfigure "Latest" \ -command { cvs_log "latest" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Summary" \ -command { cvs_log "summary" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Verbose" \ -command { cvs_log "verbose" [workdir_list_files] } .workdir.menubar.reports entryconfigure "Info" -state disabled # Options for reports .workdir.menubar.reports entryconfigure "Report Unknown Files" -state normal .workdir.menubar.reports entryconfigure "Report Recursively" -state normal } elseif {$ingit} { # Top gen_log:log D "CONFIGURE GIT MENUS" .workdir.menubar insert [expr {$filemenu_idx + 1}] cascade -label "GIT" \ -menu .workdir.menubar.git .workdir.menubar insert [expr {$filemenu_idx + 4}] cascade -label "Git Tools" \ -menu .workdir.menubar.gittools .workdir.top.bmodbrowse configure -image Modules_git -command modbrowse_run .workdir.top.lmodule configure -text "path" .workdir.top.ltagname configure -text "branch" .workdir.top.lcvsroot configure -text "$cvscfg(origin)" .workdir.top.tcvsroot configure -textvariable cvscfg(url) set cvsglb(root) $cvscfg(url) set cvsglb(vcs) git # Buttons .workdir.bottom.buttons.funcs.bview_files configure \ -command { workdir_view_file [workdir_list_files] } .workdir.bottom.buttons.dirfuncs.bcheckdir configure -state normal \ -command { git_check } .workdir.bottom.buttons.dirfuncs.patchdiff configure -state normal \ -command { git_patch "" } .workdir.bottom.buttons.cvsfuncs.bdiff configure -state normal .workdir.bottom.buttons.cvsfuncs.bconflict configure -state normal \ -command { foreach f [workdir_list_files] {git_reconcile_conflict \"$f\"} } .workdir.bottom.buttons.cvsfuncs.blogfile configure -state normal \ -command { git_branches [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bjoin configure -state normal \ -image BranchNo -command { git_fast_diagram [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bfilelog configure -state normal \ -command { git_log "verbose" [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bannotate configure -state normal \ -command { git_annotate $current_tagname [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bcheckin configure -state normal \ -image GitCheckin -command { git_commit_dialog } .workdir.bottom.buttons.cvsfuncs.brevert configure -state normal \ -command { git_reset [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bupdate configure -state normal \ -image GitCheckout -command { git_checkout [workdir_list_files] } .workdir.bottom.buttons.cvsfuncs.bupdateopts configure -state normal \ -command { git_update_options } .workdir.bottom.buttons.cvsfuncs.badd_files configure -state normal .workdir.bottom.buttons.cvsfuncs.bremove configure -state normal .workdir.bottom.buttons.cvsfuncs.btag configure -state normal .workdir.bottom.buttons.cvsfuncs.bbranchtag configure -state normal .workdir.bottom.buttons.oddfuncs configure -relief groove -bd 2 grid .workdir.bottom.buttons.oddfuncs.bpush -column 0 -row 0 grid .workdir.bottom.buttons.oddfuncs.bfetch -column 0 -row 1 .workdir.bottom.buttons.oddfuncs.block configure -state normal \ -command { rcs_lock lock [workdir_list_files] } .workdir.bottom.buttons.oddfuncs.bunlock configure -state normal \ -command { rcs_lock unlock [workdir_list_files] } set_tooltips .workdir.bottom.buttons.cvsfuncs.bjoin \ {"Fast log diagram"} set_tooltips .workdir.bottom.buttons.cvsfuncs.badd_files \ {"Add the selected files to the staging area"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bremove \ {"Remove the selected files from the staging area"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bcheckin \ {"Check in (commit) the selected files to the staging area"} set_tooltips .workdir.bottom.buttons.cvsfuncs.bupdate \ {"Update (checkout, patch) the selected files from the staging area"} set_tooltips .workdir.bottom.buttons.cvsfuncs.brevert \ {"Reset, discarding local edits"} # Reports menu for GIT # Check Directory (git status --short) .workdir.menubar.reports entryconfigure "Check Directory" -state normal \ -command { git_check } # Status (git status -v) .workdir.menubar.reports entryconfigure "Status" -state normal .workdir.menubar.reports.status_detail entryconfigure "Terse" \ -command { git_status "terse" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Summary" \ -command { git_status "summary" [workdir_list_files] } .workdir.menubar.reports.status_detail entryconfigure "Verbose" \ -command { git_status "verbose" [workdir_list_files] } # Log (git log) .workdir.menubar.reports entryconfigure "Log" -state normal .workdir.menubar.reports.log_detail entryconfigure "Latest" \ -command { git_log "latest" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Summary" \ -command { git_log "summary" [workdir_list_files] } .workdir.menubar.reports.log_detail entryconfigure "Verbose" \ -command { git_log "verbose" [workdir_list_files] } .workdir.menubar.reports entryconfigure "Info" -state disabled # Options for reports .workdir.menubar.reports entryconfigure "Report Unknown Files" -state normal .workdir.menubar.reports entryconfigure "Report Recursively" -state disabled } else { .workdir.menubar insert [expr {$filemenu_idx + 1}] cascade -label "Import" \ -menu .workdir.menubar.import } picklist_used directory "[pwd]" # Have to do this to display the new value in the list .workdir.top.tcwd configure -values $cvsglb(directory) DirCanvas:create .workdir.main pack .workdir.main.pw -side bottom -fill both -expand yes set cvsglb(current_selection) "" # Check for VCS-specific ignore filters if {$incvs} { .workdir.bottom.filters.vcshidelbl configure -text " .cvsignore" if { [ file exists ".cvsignore" ] } { set fileId [ open ".cvsignore" "r" ] while { [ eof $fileId ] == 0 } { gets $fileId line append cvsglb(vcs_hidden_files) " $line" } close $fileId } } elseif {$insvn} { .workdir.bottom.filters.vcshidelbl configure -text " svn:ignore" # Have to do eval exec because we need the error output set command "svn propget svn:ignore ." gen_log:log C "$command" set ret [catch {exec {*}$command} output] if {$ret} { # We don't need to see it output "Property not found" if {![string match {svn: warn*} $output]} { gen_log:log E "$output" } } else { gen_log:log S "$output" foreach infoline [split $output "\n"] { append cvsglb(vcs_hidden_files) " $infoline" } } } elseif {$ingit} { .workdir.bottom.filters.vcshidelbl configure -text " .gitignore" if { [ file exists ".gitignore" ] } { set fileId [ open ".gitignore" "r" ] while { [ eof $fileId ] == 0 } { gets $fileId line append cvsglb(vcs_hidden_files) " $line" } close $fileId } } set filelist [ getFiles ] directory_list $filelist # Update, otherwise it won't be mapped before we restore the scroll position update gen_log:log T "LEAVE" } proc directory_list { filenames } { global module_dir global incvs inrcs insvn ingit global cvs global cwd global cvscfg global cvsglb global cmd global Filelist gen_log:log T "ENTER ($filenames)" if {[info exists Filelist]} { unset Filelist } busy_start .workdir.main set cwd [pwd] set my_cwd $cwd # If we have commands running they were for a different directory # and won't be needed now. (i.e. this is a recursive invocation # triggered by a button click) if {[info exists cmd(cvs_status)]} { catch {$cmd(cvs_status)\::abort} catch {unset cmd(cvs_status)} } if {[info exists cmd(cvs_editors)]} { catch {$cmd(cvs_editors)\::abort} catch {unset cmd(cvs_editors)} } # Select from those files only the ones we want (e.g., no CVS dirs) foreach i $filenames { if { $i == "." || $i == ".."} { gen_log:log D "SKIPPING $i" continue } # can be file, directory, characterSpecial, blockSpecial, # fifo, link, or socket set fret [catch {file type $i} ft] if {$ft eq "directory"} { if {[isCmDirectory $i]} { # Read the bookkeeping files but don't list the directory if {$i == "CVS" || $i == ".svn" || $i == "RCS" || $i == ".git"} { continue } } if {[file exists [file join $i "CVS"]]} { set Filelist($i:status) "" } elseif {[file exists [file join $i ".svn"]]} { set Filelist($i:status) "" } elseif {[file exists [file join $i ".git"]]} { set Filelist($i:status) "" } elseif {[file exists [file join $i "RCS"]]} { set Filelist($i:status) "" } else { set Filelist($i:status) "" } } else { if {$i == ".git"} {continue} if {$incvs} { set Filelist($i:status) "Not managed by CVS" } else { set Filelist($i:status) "<$ft>" } } #set Filelist($i:wrev) "" set Filelist($i:stickytag) "" set Filelist($i:option) "" # Prepending ./ to the filename prevents tilde expansion catch {set Filelist($i:date) \ [clock format [file mtime ./$i] -format $cvscfg(dateformat)]} } # Now we send the files to the VCS for its status gen_log:log D "incvs=$incvs insvn=$insvn inrcs=$inrcs ingit=$ingit" if {$incvs} { .workdir.main.tree heading wrevcol -text "Revision" .workdir.main.tree heading editcol -text "Author" cvs_workdir_status } if {$inrcs} { .workdir.main.tree heading wrevcol -text "Revision" .workdir.main.tree heading editcol -text "Locked by" rcs_workdir_status } elseif {$insvn} { .workdir.main.tree heading wrevcol -text "Revision" .workdir.main.tree heading editcol -text "Author" svn_workdir_status } elseif {$ingit} { .workdir.main.tree heading wrevcol -text "Commit ID" .workdir.main.tree heading editcol -text "Committer" # We need the filenames in git for ignore_file_filter git_workdir_status $filenames } gen_log:log D "Sending all files to the canvas" set n_show [llength [array names Filelist]] if {$n_show == 0} { cvsalwaysconfirm "Empty directory or no matching files" .workdir } foreach i [array names Filelist *:status] { regsub {:status$} $i "" j # If it's locally removed or missing, it may not have # gotten a date especially on a remote client. if {! [info exists Filelist($j:date)]} { set Filelist($j:date) "" } DirCanvas:newitem .workdir.main "$j" } DirCanvas:bindings .workdir.main set col [lindex $cvscfg(sort_pref) 0] set sense [lindex $cvscfg(sort_pref) 1] DirCanvas:sort_by_col .workdir.main.tree $col $sense busy_done .workdir.main gen_log:log T "LEAVE" } proc workdir_cleanup {} { global cvscfg gen_log:log T "ENTER" set rmitem "" set list [ split $cvscfg(clean_these) " " ] foreach pattern $list { gen_log:log D "pattern $pattern" if { $pattern != "" } { set items [lsort [glob -nocomplain $pattern]] gen_log:log D "$items" if {[llength $items] != 0} { append rmitem " [concat $items]" } } } if {$rmitem != ""} { if { [ are_you_sure "You are about to delete:\n" $rmitem] == 1 } { gen_log:log F "DELETE $rmitem" eval file delete -force -- $rmitem } } else { gen_log:log F "No files to delete" cvsok "Nothing matched $cvscfg(clean_these)" .workdir return } setup_dir gen_log:log T "LEAVE" } proc workdir_delete_file {args} { gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some files to delete first!" .workdir return } if { [ are_you_sure "This will delete these files from your local, working directory:\n" $filelist ] == 1 } { gen_log:log F "DELETE $filelist" eval file delete -force -- $filelist setup_dir } gen_log:log T "LEAVE" } proc are_you_sure {mess args} { # # General posting message # global cvscfg gen_log:log T "ENTER ($mess $args)" set filelist [join $args] if {$cvscfg(confirm_prompt)} { append mess "\n" set indent " " foreach item $filelist { if { $item != {} } { append mess " $indent" append mess " $item\n" } } append mess "\nAre you sure?" if {[cvsconfirm $mess .workdir] != "ok"} { gen_log:log T "LEAVE 0" return 0 } } gen_log:log T "LEAVE 1" return 1 } proc workdir_print_file {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some files to print first!" .workdir return } set mess "This will print these files:\n\n" foreach file $filelist { append mess " $file\n" } append mess "\nUsing $cvscfg(print_cmd)\n" append mess "\nAre you sure?" if {[cvsconfirm $mess .workdir] == "ok"} { set final_result "" foreach file $filelist { set commandline [concat $cvscfg(print_cmd) \"$file\"] exec::new $commandline } } gen_log:log T "LEAVE" } # Is directory in CVS? proc incvs_detect { dir } { gen_log:log T "ENTER ($dir)" set cvsrootfile [file join $dir CVS Root] gen_log:log C "isfile $cvsrootfile" if {[file isfile $cvsrootfile]} { set cvs_detected [ read_cvs_dir [file join $dir CVS]] } else { set cvs_detected 0 } gen_log:log T "LEAVE ($cvs_detected)" return $cvs_detected } # Is directory in SVN? proc insvn_detect { dir } { gen_log:log T "ENTER ($dir)" gen_log:log C "svn info" set svnret [catch {exec {*}svn info} svnout] if {! $svnret} { gen_log:log S $svnout set svn_detected [ read_svn_dir $dir ] } else { set svn_detected 0 } gen_log:log T "LEAVE ($svn_detected)" return $svn_detected } # Is directory in Git? proc ingit_detect { dir } { gen_log:log T "ENTER ($dir)" gen_log:log C "git rev-parse --is-inside-work-tree" set gitret [catch {exec {*}git rev-parse --is-inside-work-tree} gitout] if {! $gitret} { # revparse may return "false" gen_log:log S "gitout $gitout" if {$gitout} { set git_detected 1 find_git_remote $dir } } else { set git_detected 0 } gen_log:log T "LEAVE ($git_detected)" return $git_detected } proc inrcs_detect { dir } { global cvscfg gen_log:log T "ENTER ($dir)" set rcsdir [file join $dir RCS] gen_log:log C "searching for local RCS files" if {[file isdirectory $rcsdir]} { gen_log:log C "isdirectory $rcsdir" set cvscfg(rcsdir) $rcsdir set rcs_detected 1 } elseif {[llength [glob -nocomplain -directory $dir *,v]] > 0} { gen_log:log C "*,v files exist" set rcs_detected 1 set cvscfg(rcsdir) $dir } else { set cvscfg(rcsdir) "" set rcs_detected 0 } if {$rcs_detected} { # Make sure we have rcs, and bag this (silently) if we don't set command "rcs --version" gen_log:log C "$command" set ret [catch {exec {*}$command} raw_rcs_log] gen_log:log S "$raw_rcs_log" if {$ret} { if {[string match {rcs*} $raw_rcs_log]} { # An old version of RCS, but it's here set rcs_detected 1 } else { set rcs_detected 0 } } } gen_log:log T "LEAVE ($rcs_detected)" return $rcs_detected } # Detect which version control system the directory is in, proc vcs_detect { dir } { global cvsglb global incvs insvn inrcs ingit gen_log:log T "ENTER ($dir)" gen_log:log D "cvsglb(vcspref) $cvsglb(vcspref)" lassign {0 0 0 0} incvs insvn inrcs ingit foreach vcs $cvsglb(vcspref) { set procname [join "in $vcs _detect" ""] set reply [$procname $dir] set in$vcs $reply if {$reply} { break } gen_log:log D "$vcs in$vcs $reply" } gen_log:log T "LEAVE ($incvs $insvn $inrcs $ingit)" return [list $incvs $insvn $inrcs $ingit] } proc isCmDirectory { file } { #gen_log:log T "ENTER ($file)" switch -- $file { "CVS" - "RCS" - ".svn" - ".git" - "SCCS" { set value 1 } default { set value 0 } } #gen_log:log T "LEAVE ($value)" return $value } # Get the files in the current working directory. Use the file_filter # values. Add hidden files if desired by the user. Sort them to match # the ordering that will be returned by cvs commands (this matches the # default ls ordering.). proc getFiles { } { global cvscfg global cvsglb gen_log:log T "ENTER" set filelist "" # make sure the file filter is at least set to "*". if { $cvscfg(show_file_filter) == "" } { set cvscfg(show_file_filter) "*" } # get the initial file list, including dotfiles if requested, filtered by show_file_filter if {$cvscfg(allfiles)} { # get hidden as well foreach item $cvscfg(show_file_filter) { gen_log:log T "glob -nocomplain .$item $item" set filelist [ concat [ glob -nocomplain .$item $item ] $filelist ] } } else { foreach item $cvscfg(show_file_filter) { gen_log:log T "glob -nocomplain $item" set filelist [ concat [ glob -nocomplain $item ] $filelist ] } } #gen_log:log D "filelist ($filelist)" # ignore files if requested by ingore_file_filter set ignore_file_filter [concat $cvscfg(ignore_file_filter) $cvsglb(vcs_hidden_files)] if { $ignore_file_filter != "" } { foreach item $ignore_file_filter { # for each pattern if { $item != "*" } { # if not "*" set idx [lsearch $filelist $item] while { [set idx [lsearch $filelist $item]] != -1 } { # for each occurence, delete catch { set filelist [ lreplace $filelist $idx $idx ] } } } } } # If filename starts with ~ make it ./~ # Doing string match instead of regsub because it's faster set newlist "" foreach item $filelist { if {[string match {~*} $item]} { lappend newlist "./$item" } else { lappend newlist "$item" } } set filelist $newlist # make sure "." is always in the list for 'cd' purposes if { "." ni $filelist} { set filelist [ concat "." $filelist ] } # make sure ".." is always in the list for 'cd' purposes if { ".." ni $filelist} { set filelist [ concat ".." $filelist ] } # sort it set filelist [ lsort $filelist ] # if this directory is under CVS and CVS is not in the list, add it. Its # presence is needed for later processing if { ( [ file exists "CVS" ] ) && ("CVS" ni $filelist) } { #puts "********* added CVS" catch { set filelist [ concat "CVS" $filelist ] } } gen_log:log T "return ($filelist)" return $filelist } proc log_toggle { } { global cvscfg if {$cvscfg(logging)} { gen_log:init } else { gen_log:quit } } proc exit_cleanup { force } { global cvscfg # Count the number of toplevels that are currently interacting # with the user (i.e. exist and are not withdrawn) set wlist "" foreach w [winfo children .] { if {[wm state $w] != {withdrawn}} { lappend wlist $w } } if {$force == 0 && [llength $wlist] != 0 \ && $wlist != {.trace} && $wlist != {.bgerrorTrace}} { return } # If toplevel windows exist ask them to close gracefully if possible foreach w $wlist { # Except .trace! if {$w != {.trace}} { catch {$w.close invoke} } else { # Invoking trace's close turns off logging. We don't want that, # but we do want to save its geometry. if {[winfo exists .trace]} { set cvscfg(tracgeom) [wm geometry .trace] } } } save_options set pid [pid] gen_log:log F "DELETE $cvscfg(tmpdir)/cvstmpdir.$pid" catch {file delete -force [file join $cvscfg(tmpdir) cvstmpdir.$pid]} exit } proc save_options { } { # # Save the options which are configurable from the GUI # global cvscfg global logcfg global bookmarks gen_log:log T "ENTER" # There are two kinds of options we can set set BOOLopts { allfiles auto_status confirm_prompt gitdetail \ match_desktop showstatcol showdatecol showwrevcol showeditcol auto_tag \ status_filter recurse large_icons logging blame_linenums use_cvseditor } set STRGopts { show_file_filter ignore_file_filter clean_these editor preftab \ gitblame_since gitbranchgroups gitlog_opts gitlog_since \ gitmaxbranch gitmaxhist gitbranchregex \ printer log_classes lastdir sort_pref editor editorargs \ workgeom modgeom loggeom shell tkdiff toomany_tags tracgeom blamegeom \ svn_trunkdir svn_branchdir svn_tagdir vcspref } # Plus the branch_diagram options set LOGopts [concat [array names logcfg show_*] scale] # remove obsolete settings if {[info exists cvscfg(editorargs)] } { if {$cvscfg(editorargs) != ""} { set cvscfg(editor) [concat $cvscfg(editor) $cvscfg(editorargs)] } unset cvscfg(editorargs) } if {[info exists cvscfg(gitsince)] } { unset cvscfg(gitsince) } # Save the list so we can keep track of what we've done set BOOLset $BOOLopts set STRGset $STRGopts set LOGset $LOGopts set optfile [file join $cvscfg(home) .tkrev] set bakfile [file join $cvscfg(home) .tkrev.bak] # Save the old .tkrev file gen_log:log F "MOVE $optfile $bakfile" catch {file rename -force $optfile $bakfile} gen_log:log F "OPEN $optfile" if {[catch {set fo [open $optfile w]}]} { cvsfail "Cannot open $optfile for writing" .workdir return } gen_log:log F "OPEN $bakfile" if {! [catch {set fi [open $bakfile r]}]} { while { [eof $fi] == 0 } { gets $fi line set match 0 if {[regexp {^#} $line]} { # Don't try to scan comments. #gen_log:log D "PASSING \"$line\"" puts $fo "$line" continue } elseif {[string match "*set *bookmarks*" $line]} { # Discard old bookmarks continue } else { foreach opt $BOOLopts { if {! [info exists cvscfg($opt)]} { continue } if {[string match "*set *cvscfg($opt)*" $line]} { # Print it and remove it from the list gen_log:log D "REPLACING $line w/ set cvscfg($opt) $cvscfg($opt)" puts $fo "set cvscfg($opt) $cvscfg($opt)" set idx [lsearch $BOOLset $opt] set BOOLset [lreplace $BOOLset $idx $idx] set match 1 break } } foreach opt $STRGopts { if {! [info exists cvscfg($opt)]} { continue } if {[string match "*set *cvscfg($opt)*" $line]} { # Print it and remove it from the list gen_log:log D "REPLACING $line w/ set cvscfg($opt) $cvscfg($opt)" puts $fo "set cvscfg($opt) \{$cvscfg($opt)\}" set idx [lsearch $STRGset $opt] set STRGset [lreplace $STRGset $idx $idx] set match 1 break } } if {[string match "*set *cvscfg(editorargs)*" $line]} { # editorargs is no longer necessary continue } foreach opt $LOGopts { if {! [info exists logcfg($opt)]} { continue } if {[string match "*set *logcfg($opt)*" $line]} { # Print it and remove it from the list gen_log:log D "REPLACING \"$line\" w/ set logcfg($opt) \"$logcfg($opt)\"" puts $fo "set logcfg($opt) \"$logcfg($opt)\"" set idx [lsearch $LOGset $opt] set LOGset [lreplace $LOGset $idx $idx] set match 1 break } } if {$match == 0} { # We didn't do a replacement gen_log:log D "PASSING \"$line\"" # If we don't check this, we get an extra blank line every time # we save the file. Messy. if {[eof $fi] == 1} { break } puts $fo "$line" } } } foreach mark [lsort [array names bookmarks]] { gen_log:log D "Adding bookmark \"$mark\"" puts $fo "set \"bookmarks($mark)\" \"$bookmarks($mark)\"" } close $fi } # Print what's left over foreach opt $BOOLset { if {! [info exists cvscfg($opt)]} { continue } gen_log:log D "ADDING cvscfg($opt) $cvscfg($opt)" puts $fo "set cvscfg($opt) $cvscfg($opt)" } foreach opt $STRGset { if {! [info exists cvscfg($opt)]} { continue } gen_log:log D "ADDING cvscfg($opt) \"$cvscfg($opt)\"" puts $fo "set cvscfg($opt) \"$cvscfg($opt)\"" } foreach opt $LOGset { if {! [info exists logcfg($opt)]} { continue } gen_log:log D "ADDING logcfg($opt) \"$logcfg($opt)\"" puts $fo "set logcfg($opt) \"$logcfg($opt)\"" } close $fo picklist_save gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/style_params.tcl0000664000175000017500000012406315034120611017615 0ustar dorothyrdorothyrproc colors:open_cde_resourcefile { file } { global start_log set ans "" set ret [catch {open $file r} ans] if {$ret == 0} { lappend start_log " Opening $file" return $ans } else { lappend start_log "Error opening file: ($ans)" lappend start_log "Error: $ans" return "" } } proc colors:read_cde_palette { palf } { global start_log global colorglb global theme_system lappend start_log "Looking for $theme_system palette $palf" if {[file readable $palf]} { lappend "Opening palette $palf" if {![catch {open $palf r} fh]} { chan gets $fh activetitle ;# active window borders; Colorset 2 chan gets $fh inactivetitle ;# inactive window borders and default fg/bg/sh/hi, menus; Colorset 5 chan gets $fh wkspc1 ;# Colorset 40,41 chan gets $fh textbg ;# text entry and list widgets; Colorset 20 chan gets $fh guibg ;#(*.background) - panels, default for tk under cde; Colorset 21 chan gets $fh menubg ;# transient windows, says NsCDE. Almost the same as guibg; Colorset 22,44,45 chan gets $fh wkspc4 ;# Colorset 46,47 chan gets $fh iconbg ;#control panel bg too; not used by NsCDE catch {chan close $fh} } } else { lappend start_log "Failed to open file $palf" return 0 } lappend start_log "CoLoR_guibg: $guibg" lappend start_log "CoLoR_textbg: $textbg" lappend start_log "CoLoR_menubg: $menubg" lappend start_log "CoLoR_iconbg: $iconbg" lappend start_log "CoLoR_activetitle: $activetitle" lappend start_log "CoLoR_inactivetitle: $inactivetitle" lappend start_log "CoLoR_wkspc1: $wkspc1" lappend start_log "CoLoR_wkspc4: $wkspc4" if {[info exists activetitle]} { set hlbg $activetitle } elseif {[info exists wkspc4]} { set hlbg $wkspc4 } else { set hlbg "#b24d7a" } lassign [colors:shades $colorglb(bg)] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow # In NsCDE, we get bg, fg, textbg, and textfg from the local configfile. # In plain CDE, we set it to what we got from the palette. if {$theme_system eq "CDE"} { set colorglb(textbg) $textbg } set colorglb(menubg) $menubg set colorglb(hlbg) $hlbg # CDE, in both implementations, is unreliable at specifying contrasting # foreground set colorglb(fg) [colors:contrast $colorglb(bg)] set colorglb(menufg) [colors:contrast $menubg] set colorglb(textfg) [colors:contrast $textbg] set colorglb(hlfg) [colors:contrast $hlbg] set colorglb(canvfg) [colors:contrast $colorglb(shadow)] set colorglb(treefg) $colorglb(canvfg) return 1 } proc colors:get_cde_params { } { global cvscfg global colorglb global start_log global theme_system global env # NsCDE looks like CDE, but it's really mostly FVWM. The current palette and # colorsets are listed in FVWM_USERDIR/Colorset.fvwmgen (usualy # ~/.NsCDE/Colorset.fvwmgen) The palettes are in /usr/share/NsCDE/palettes # but env(NSCDE_PALETTE) gets reset. Maybe it's best to get the colors from # there too? if {[info exists env(XDG_CURRENT_DESKTOP)] && $env(XDG_CURRENT_DESKTOP) eq "NsCDE"} { set configfile "$env(FVWM_USERDIR)/Colorset.fvwmgen" set theme_system "NsCDE" lappend start_log "Look for $configfile" if {[file readable $configfile]} { lappend start_log "Opening $configfile" if {![catch {open $configfile r} fh]} { while {[chan gets $fh ln] != -1} { if {[string match {SetEnv NSCDE_PALETTE *} $ln]} { set palf [lindex $ln 2] set palette [file join / usr share NsCDE palettes $palf.dp] lappend start_log "Using palette $palf" } elseif {[string match {Colorset 20*} $ln]} { set textfg [string trimright [lindex $ln 3] ","] set textbg [string trimright [lindex $ln 5] ","] } elseif {[string match {Colorset 21*} $ln]} { set fg [string trimright [lindex $ln 3] ","] set bg [string trimright [lindex $ln 5] ","] } } catch {chan close $fh} set colorglb(bg) $bg set colorglb(fg) $fg set colorglb(textbg) $textbg set colorglb(textfg) $textfg set colorglb(treefg) $fg set colorglb(canvfg) $fg lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow lappend start_log "CoLoR_bg: $bg" lappend start_log "CoLoR_fg: $fg" lappend start_log "CoLoR_textbg: $textbg" lappend start_log "CoLoR_textfg: $textfg" } } else { lappend start_log "Failed to read $configfile" return 0 } if {[string length $palf]} { colors:read_cde_palette $palette } set guifont TkDefaultFont #set guifont {{Serif} 10} set txtfont TkFixedFont set listfont TkDefaultFont set menufont {{DejaVu Serif} 10} set btnfont {{DejaVu Serif} 10} set dlgfont TkHeadingFont set colorglb(guifont) $guifont set colorglb(btnfont) $guifont set colorglb(textfont) $txtfont set colorglb(menufont) $menufont set colorglb(btnfont) $btnfont set colorglb(dialogfont) $dlgfont set colorglb(listboxfont) $guifont return 1 } else { if {! [info exists env(DTUSERSESSION)] } { lappend start_log "DTUSERSESSION not set. Not in CDE" return 0 } set theme_system "CDE" set guifont TkDefaultFont set listfont TkFixedFont set txtfont TkFixedFont set menufont "Serif" set btnfont "Serif" set dlgfont TkHeadingFont set colorglb(guifont) $guifont set colorglb(textfont) $txtfont set colorglb(menufont) $menufont set colorglb(btnfont) $btnfont set colorglb(dialogfont) $dlgfont set colorglb(listboxfont) $listfont # Nothing really tells us this, but tk gets it set bg [option get . background background] lappend start_log "CoLoR_bg: $bg" # CDE lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow set colorglb(bg) $bg # Tk gets a foreground, but it's usually wrong. Use its default though. set fg [option get . foreground foreground] set colorglb(fg) $fg # If we can find the user's dt.resources file, we can find out the # palette and background/foreground colors set fh "" set palette "" set cur_rsrc [file join $cvscfg(home) .dt/sessions/current/dt.resources] set hom_rsrc [file join $cvscfg(home) .dt/sessions/home/dt.resources] if {[file readable $cur_rsrc] && [file readable $hom_rsrc]} { # Both exist. Use whichever is newer if {[file mtime $cur_rsrc] > [file mtime $hom_rsrc]} { lappend start_log " $cur_rsrc is newer" set fh [colors:open_cde_resourcefile $cur_rsrc] if {$fh == ""} { set fh [colors:open_cde_resourcefile $hom_rsrc] } } else { lappend start_log " $hom_rsrc is newer" set fh [colors:open_cde_resourcefile $hom_rsrc] if {$fh == ""} { set fh [colors:open_cde_resourcefile $cur_rsrc] } } } elseif {[file readable $cur_rsrc]} { # Otherwise try current first set fh [colors:open_cde_resourcefile $cur_rsrc] if {$fh == ""} { set fh [colors:open_cde_resourcefile $hom_rsrc] } } elseif {[file readable $hom_rsrc]} { set fh [colors:open_cde_resourcefile $hom_rsrc] } if {[string length $fh]} { set palf "" while {[chan gets $fh ln] != -1} { regexp {^\*background:[ \t]*(.*)$} $ln nil bg regexp {^\*foreground:[ \t]*(.*)$} $ln nil fg regexp {^\*0\*ColorPalette:[ \t]*(.*)$} $ln nil palette regexp {^Window.Color.Background:[ \t]*(.*)$} $ln nil bg regexp {^Window.Color.Foreground:[ \t]*(.*)$} $ln nil fg } catch {chan close $fh} lappend start_log "CoLoR_bg: $bg" lappend start_log "CoLoR_fg: $fg" # # If the *0*ColorPalette setting was found above, try to find the # indicated file in ~/.dt, $DTHOME, or /usr/dt. # if {[string length $palette]} { foreach dtdir {/usr/dt /etc/dt [file join $cvscfg(home) .dt]} { # This uses the last palette that we find if {[file readable [file join $dtdir palettes $palette]]} { set palf [file join $dtdir palettes $palette] } } if {[string length $palf]} { colors:read_cde_palette $palf } } } else { lappend start_log "Neither [file join $cvscfg(home) .dt/sessions/current/dt.resources] nor" lappend start_log " [file join $cvscfg(home) .dt/sessions/home/dt.resources] was readable" lappend start_log " Falling back to plain X11" return 0 } # Relief like CDE menu option add *Menu.borderWidth 1 # This makes it look like the native CDE checkbox option add *Checkbutton.offRelief sunken return 1 } } proc colors:get_gtk_theme { } { global cvscfg global colorglb global env global start_log lappend start_log "Looking for a GTK theme" switch -glob $env(XDG_CURRENT_DESKTOP) { {*GNOME} - {*XFCE} { set ret [catch {exec {*}gsettings get org.gnome.desktop.interface gtk-theme} theme] set ret [catch {exec {*}gsettings get org.gnome.desktop.interface font-name} menufont] } {*MATE} { set ret [catch {exec {*}gsettings get org.mate.interface gtk-theme} theme] } {*COSMIC} { set ret [catch {exec {*}gsettings get org.gnome.desktop.interface gtk-theme} theme] } {*KDE} { # This doesn't have the current color scheme but start with it set ret [catch {exec {*}gsettings get org.gnome.desktop.interface gtk-theme} theme] # font comes back in a bad format set ret [catch {exec {*}gsettings get org.gnome.desktop.interface font-name} menufont] } } if {[info exists theme]} { set theme [string trim $theme "'"] lappend start_log "THEME $theme" # Look for the theme file ~/.themes/$theme or /usr/share/themes/$theme set localthemedir [file join $cvscfg(home) .themes $theme] set systhemedir [file join / usr share themes $theme] lappend start_log " Look for $localthemedir" lappend start_log " Look for $systhemedir" if {[file isdirectory $localthemedir]} { set themedir $localthemedir } elseif {[file isdirectory $systhemedir]} { set themedir $systhemedir } # $theme/$QT_QPA_PLATFORMTHEME/gtkrc gtk-color-scheme lines if { [info exists themedir] } { lappend start_log " Found directory $themedir" # older gtk2 themes use gtkrc lappend start_log " Look for $themedir/gtk-2.0/gtkrc" if {[file readable $themedir/gtk-2.0/gtkrc]} { lappend start_log " Found $themedir/gtk-2.0/gtkrc" set theme_rc "$themedir/gtk-2.0/gtkrc" lappend start_log " Opening $theme_rc" set gtkcolorscheme "" if {![catch {open $theme_rc r} th]} { while {[chan gets $th ln] != -1} { if {[string match "gtk?color?scheme*" $ln]} { # grab what's inside the quotes regexp {\"(.*?)\"} $ln all inside # remove spaces if present regsub -all { } $inside {} ln regsub -all {\\n} $ln {^} ln append ln "^" append gtkcolorscheme $ln } } catch {chan close $th} } else { lappend start_log " Open file failed" } if {[info exists gtkcolorscheme]} { regsub -all {\\n} $gtkcolorscheme {^} gtkcolorscheme foreach entry [split $gtkcolorscheme "^"] { set entry [string trimright $entry] set fields [split $entry {:}] set cname [lindex $fields 0] set cval [lindex $fields 1] lappend start_log "CoLoR_$cname: $cval" switch -exact -- $cname { # Fill in the variables, though some may be overridden {bg_color} {set bg $cval} {fg_color} {set fg $cval} {base_color} {set textbg $cval} {text_color} {set textfg $cval} {selected_bg_color} {set hlbg $cval} {selected_fg_color} {set hlfg $cval} {tooltip_bg_color} {set tooltipbg $cval} {tooltip_fg_color} {set tooltipfg $cval} {menu_bg} {set menubg $cval} {menu_fg} {set menufg $cval} {link_color} {set linkfg $cval} } } if {! [info exists bg] || ! [info exists fg]} { lappend start_log " No topelevel fg and bg from gtkrc" # Try to find a gtk3 css file lappend start_log " Look for $themedir/gtk-3.0/gtk-main.css" if {[file readable $themedir/gtk-3.0/gtk-main.css]} { lappend start_log " Found $themedir/gtk-3.0/gtk-main.css" set theme_rc "$themedir/gtk-3.0/gtk-main.css" if { [info exists theme_rc] } { lappend start_log " Opening $theme_rc" if {![catch {open $theme_rc r} th]} { while {[chan gets $th ln] != -1} { if {[string match "@define-color bg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all bg } elseif {[string match "@define-color fg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all fg } elseif {[string match "@define-color base_color *" $ln]} { regexp {.*lor (#\w+);} $ln all textbg } elseif {[string match "@define-color text_color *" $ln]} { regexp {.*lor (#\w+);} $ln all textfg } elseif {[string match "@define-color selected_bg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all hlbg } elseif {[string match "@define-color selected_fg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all hlfg } elseif {[string match "@define-color tooltip_bg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all tooltipbg } elseif {[string match "@define-color tooltip_fg_color *" $ln]} { regexp {.*lor (#\w+);} $ln all tooltipfg } elseif {[string match "@define-color link_color *" $ln]} { regexp {.*lor (#\w+);} $ln all linkfg } } catch {chan close $th} } else { lappend start_log " Open file failed" } } else { lappend start_log " $theme_rc not found" } } if {! [info exists bg] || ! [info exists fg]} { lappend start_log " No topelevel fg and bg from gtk-main.css" return 0 } } set colorglb(bg) $bg set colorglb(fg) $fg # GTK lassign [colors:shades $colorglb(bg)] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow } # KDE is still GTK, but the current colors are in a different file if {[string match "*KDE" $env(XDG_CURRENT_DESKTOP)]} { # ~/.config/kdeglobals contains the current colors set kdeglobal_rc [file join $cvscfg(home) .config kdeglobals] lappend start_log "Look for file $kdeglobal_rc" if {[file readable $kdeglobal_rc]} { lappend start_log " Opening $kdeglobal_rc" if {![catch {open $kdeglobal_rc r} kh]} { while {[chan gets $kh ln] != -1} { if {[string match {\[Colors:Tooltip\]} $ln]} { lappend start_log " Colors:Tooltip" while {[chan gets $kh ln] != -1} { if {$ln eq ""} {break} set fields [split $ln {=}] set f0 [lindex $fields 0] set f1 [lindex $fields 1] switch -exact -- $f0 { {BackgroundNormal} { set tooltipbg [colors:rgb2hex $f1] lappend start_log "CoLoR_BackgroundNormal: $tooltipbg" } {ForegroundNormal} { set tooltipfg [colors:rgb2hex $f1] lappend start_log "CoLoR_ForegroundNormal: $tooltipfg" } } } } elseif {[string match {\[Colors:Window\]} $ln]} { lappend start_log " Colors:Window" while {[chan gets $kh ln] != -1} { if {$ln eq ""} {break} set fields [split $ln {=}] set f0 [lindex $fields 0] set f1 [lindex $fields 1] switch -exact -- $f0 { {BackgroundNormal} { set bg [colors:rgb2hex $f1] lappend start_log "CoLoR_BackgroundNormal: $bg" } {ForegroundNormal} { set fg [colors:rgb2hex $f1] lappend start_log "CoLoR_ForegroundNormal: $fg" } } } } elseif {[string match {\[Colors:View\]} $ln]} { lappend start_log " Colors:View" while {[chan gets $kh ln] != -1} { if {$ln eq ""} {break} set fields [split $ln {=}] set f0 [lindex $fields 0] set f1 [lindex $fields 1] switch -exact -- $f0 { {BackgroundNormal} { set textbg [colors:rgb2hex $f1] lappend start_log "CoLoR_BackgroundNormal: $textbg" } {ForegroundNormal} { set textfg [colors:rgb2hex $f1] lappend start_log "CoLoR_ForegroundNormal: $textfg" } } } } elseif {[string match {\[Colors:Selection\]} $ln]} { lappend start_log " Colors:Selection" while {[chan gets $kh ln] != -1} { if {$ln eq ""} {break} set fields [split $ln {=}] set f0 [lindex $fields 0] set f1 [lindex $fields 1] switch -exact -- $f0 { {BackgroundNormal} { set hlbg [colors:rgb2hex $f1] lappend start_log "CoLoR_BackgroundNormal: $hlbg" } {ForegroundNormal} { set hlfg [colors:rgb2hex $f1] lappend start_log "CoLoR_ForegroundNormal: $hlfg" } } } } elseif {[string match {ColorScheme=*} $ln]} { set fields [split $ln {=}] set kde_scheme [lindex $fields 1] } } catch {chan close $kh} } else { lappend start_log " Open file failed" } if {[info exists kde_scheme ]} { lappend start_log " ColorScheme $kde_scheme" } } # KDE lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow } set colorglb(bg) $bg set colorglb(fg) $fg if {[info exists hlbg]} {set colorglb(hlbg) $hlbg} if {[info exists hlfg]} {set colorglb(hlfg) $hlfg} if {[info exists textbg]} {set colorglb(textbg) $textbg} if {[info exists textfg]} {set colorglb(textfg) $textfg} if {[info exists trough]} {set colorglb(trough) $trough} if {[info exists tooltipbg]} {set colorglb(tooltipbg) $tooltipbg} if {[info exists tooltipfg]} {set colorglb(tooltipfg) $tooltipfg} if {[info exists linkfg]} {set colorglb(linkfg) $linkfg} set colorglb(canvfg) [colors:contrast $colorglb(canvbg)] set colorglb(treefg) $colorglb(canvfg) if {[info exists menufont]} { set colorglb(menufont) [colors:sanitize_fontspec $menufont] lappend start_log "FoNt_interface_font: $colorglb(menufont)" } } } else { lappend start_log " Theme gtkrc not found" return 0 } } else { lappend start_log "Theme not detected" return 0 } # I guess we found something return 1 } proc colors:get_x11_resources { } { global colorglb global start_log lappend start_log "Getting X11 resources" if {[auto_execok xrdb] eq ""} { lappend start_log " No xrdb results" return 0 } set pipe [open "|xrdb -q" r] lappend start_log "READING xrdb" while {[chan gets $pipe ln] > -1} { switch -glob -- $ln { {\*Toplevel.background:*} { set bg [lindex $ln 1] lappend start_log "CoLoR_Toplevel.background: $bg" } {\*Toplevel.foreground:*} { set fg [lindex $ln 1] lappend start_log "CoLoR_Toplevel.foreground: $fg" } {tkrev?background:*} { set bg [lindex $ln 1] lappend start_log "CoLoR_Toplevel.background: $bg" } {tkrev?foreground:*} { set fg [lindex $ln 1] lappend start_log "CoLoR_Toplevel.foreground: $fg" } {tkrev?Text.background:*} { set textbg [lindex $ln 1] lappend start_log "CoLoR_Text.background: $textbg" } {tkrev?Text.foreground:*} { set textfg [lindex $ln 1] lappend start_log "CoLoR_Text.foreground: $textfg" } {tkrev?Text.selectBackground:*} { set hlbg [lindex $ln 1] lappend start_log "CoLoR_Text.selectBackground: $hlbg" } {tkrev?Text.selectForeground:*} { set hlfg [lindex $ln 1] lappend start_log "CoLoR_Text.selectForeground: $hlfg" } {tkrev?Menu.background:*} { set menubg [lindex $ln 1] lappend start_log "CoLoR_Menu.background: $menubg" } {tkrev?Menu.foreground:*} { set menufg [lindex $ln 1] lappend start_log "CoLoR_Menu.foreground: $menufg" } {tkrev?Button.background:*} { set btnbg [lindex $ln 1] lappend start_log "CoLoR_Button.background: $btnbg" } {tkrev?Button.foreground:*} { set btnfg [lindex $ln 1] lappend start_log "CoLoR_Button.foreground: $btnfg" } {tkrev?Canvas.background:*} { set cvbg [lindex $ln 1] lappend start_log "CoLoR_Canvas.Background: $cvbg" } {tkrev?Canvas.foreground:*} { set cvfg [lindex $ln 1] lappend start_log "CoLoR_Canvas.Foreground: $cvfg" } {tkrev?Label.font:*} { set guifont [lindex $ln 1] } {tkrev?Menu.font:*} { set menufont [lindex $ln 1] } {tkrev?Button.font:*} { set btnfont [lindex $ln 1] } {tkrev?List.font:*} { set listboxfont [lindex $ln 1] } {tkrev?Text.font:*} { set textfont [lindex $ln 1] } } } catch {close $pipe} if {! [info exists bg] || ! [info exists fg]} { lappend start_log " xrdb doesn't provide toplevel fg and bg" return 0 } set colorglb(bg) $bg set colorglb(fg) $fg # X11 lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow if {[info exists menubg]} {set colorglb(menubg) $menubg} else {set colorglb(menubg) $bg} if {[info exists menufg]} {set colorglb(menufg) $menufg} else {set colorglb(menufg) $fg} if {[info exists btnbg]} {set colorglb(btnbg) $btnbg} else {set colorglb(btnbg) $bg} if {[info exists btnfg]} {set colorglb(btnfg) $btnfg} else {set colorglb(btnfg) $fg} if {[info exists textbg]} {set colorglb(textbg) $textbg} else {set colorglb(textbg) gray90} if {[info exists textfg]} {set colorglb(textfg) $textfg} else {set colorglb(textfg) black} if {[info exists cvbg]} {set colorglb(canvbg) $cvbg} else {set colorglb(canvbg) $colorglb(lighter)} if {[info exists cvfg]} {set colorglb(canvfg) $cvfg} else {set colorglb(canvfg) black} if {[info exists hlbg]} {set colorglb(hlbg) $hlbg} else {set colorglb(hlbg) "skyblue2"} if {$colorglb(hlbg) eq $bg} {set colorglb(hlbg) "#0092dc"} if {[info exists hlfg]} {set colorglb(hlfg) $hlfg} else {set colorglb(hlfg) "black"} set colorglb(treefg) $colorglb(canvfg) set colorglb(treebg) $colorglb(canvbg) if {[info exists guifont]} { set colorglb(guifont) [colors:sanitize_fontspec $guifont] } if {[info exists menufont]} { set colorglb(menufont) [colors:sanitize_fontspec $menufont] } if {[info exists btnfont]} { set colorglb(btnfont) [colors:sanitize_fontspec $btnfont] } if {[info exists listboxfont]} { set colorglb(listboxfont) [colors:sanitize_fontspec $listboxfont] } if {[info exists textfont]} { set colorglb(textfont) [colors:sanitize_fontspec $textfont] } return 1 } # We picked out the colors from the DE. Now apply them. proc colors:add_options {theme_system} { global colorglb global start_log lappend start_log "Theme system: $theme_system" catch {option add *Menu.font $colorglb(menufont)} catch {option add *Button.font $colorglb(btnfont)} catch {option add *Label.font $colorglb(guifont)} catch {option add *Entry.font $colorglb(guifont)} catch {option add *Text.font $colorglb(textfont)} if {! [info exists colorglb(bg)] } { puts "Variables not set. Something happened." return } if {! [info exists colorglb(menubg)] } { set colorglb(menubg) $colorglb(bg) } if {! [info exists colorglb(menufg)] } { set colorglb(menufg) $colorglb(fg) } if {! [info exists colorglb(btnbg)] } { set colorglb(btnbg) $colorglb(bg) } if {! [info exists colorglb(btnfg)] } { set colorglb(btnfg) $colorglb(fg) } # we really mean default. don't mess anything up. if {$theme_system eq "tk_default"} {return} option add *Background $colorglb(bg) option add *Foreground $colorglb(fg) option add *selectColor $colorglb(hlbg) option add *Menu.Background $colorglb(menubg) option add *Menu.Foreground $colorglb(menufg) option add *Menu.disabledForeground gray option add *Button.Background $colorglb(btnbg) option add *Button.Foreground $colorglb(btnfg) if {[string match {*CDE} $theme_system]} { option add *Button.activeBackground $colorglb(shadow) option add *Button.activeForeground $colorglb(fg) option add *Menu.activeBackground $colorglb(menubg) option add *Menu.activeForeground $colorglb(menufg) option add *Checkbutton.activeBackground $colorglb(bg) option add *Checkbutton.activeForeground $colorglb(fg) } else { option add *Button.activeBackground $colorglb(lighter) option add *Button.activeForeground $colorglb(fg) option add *Menu.activeBackground $colorglb(lighter) option add *Menu.activeForeground $colorglb(fg) # Prevent painted background from obscuring the checkmark option add *Checkbutton.selectColor "" option add *Radiobutton.selectColor "" } # Menu checkmarks option add *Menu.selectColor $colorglb(fg) option add *Canvas.Background $colorglb(canvbg) option add *Canvas.Foreground $colorglb(canvfg) option add *Dialog.Background $colorglb(menubg) option add *Dialog.Foreground $colorglb(menufg) option add *Entry.Background $colorglb(textbg) option add *Entry.Foreground $colorglb(textfg) option add *Entry.readonlyBackground $colorglb(light) option add *Entry.selectBackground $colorglb(hlbg) option add *Entry.selectForeground $colorglb(hlfg) option add *Listbox.background $colorglb(textbg) option add *Listbox.selectBackground $colorglb(hlbg) option add *Listbox.selectForeground $colorglb(hlfg) option add *Text.Background $colorglb(textbg) option add *Text.Foreground $colorglb(textfg) } # Takes hex color and makes some shades proc colors:shades {bg} { global colorglb global start_log set rgb_bg [winfo rgb . $bg] set bg0 [expr [lindex $rgb_bg 0] / 256 ] set bg1 [expr [lindex $rgb_bg 1] / 256 ] set bg2 [expr [lindex $rgb_bg 2] / 256 ] # Approximation of perceived lightness set lightness [expr ( ((2*$bg0) + $bg1 + (3*$bg2)) / 6 )] lappend start_log "$bg lightness $lightness" # shadow set factor .85 set shadow [format #%02x%02x%02x [expr int($factor * $bg0)] \ [expr int($factor * $bg1)] \ [expr int($factor * $bg2)]] set inv0 [expr 255 - $bg0] set inv1 [expr 255 - $bg1] set inv2 [expr 255 - $bg2] # light set factor .15 set add0 [expr int($factor*$inv0)] set add1 [expr int($factor*$inv1)] set add2 [expr int($factor*$inv2)] set light [format #%02x%02x%02x [expr {$bg0 + $add0}] \ [expr {$bg1 + $add1}] \ [expr {$bg2 + $add2}]] # lighter set factor .3 set add0 [expr int($factor*$inv0)] set add1 [expr int($factor*$inv1)] set add2 [expr int($factor*$inv2)] set lighter [format #%02x%02x%02x [expr {$bg0 + $add0}] \ [expr {$bg1 + $add1}] \ [expr {$bg2 + $add2}]] if {$lightness > 90} { # Use a darker color for the treeview and canvas set panel $shadow set thumb $bg } else { # Use the lighter color for the treeview and canvas, and # make the scroll thumb lighter set panel $light set thumb $light } lappend start_log "Computed background shades" lappend start_log "CoLoR_shadow: $shadow" lappend start_log "CoLoR_orig: $bg" #lappend start_log "CoLoR_light: $light" lappend start_log "CoLoR_lighter: $lighter" #lappend start_log "CoLoR_panel: $panel" #lappend start_log "CoLoR_thumb: $thumb" return [list $panel $thumb $lighter $light $shadow] } # If we get a font from gsettings, we have to arrange it in list fields proc colors:sanitize_fontspec {font_in} { set font_inproc [string trim $font_in "'"] regsub -all {,} $font_inproc {} font_inproc set last [lindex $font_inproc end] set begin [lrange $font_inproc 0 end-1] #puts $begin #puts $last if {[string is integer -strict $last]} { set font_out "[list $begin] $last" } else { set font_out [list $font_inproc] } #puts $font_out return $font_out } # Take an rgb color and translate it to hex proc colors:rgb2hex {rgb} { set lst [split $rgb {,}] set r_d [lindex $lst 0] set g_d [lindex $lst 1] set b_d [lindex $lst 2] set hex [format #%02x%02x%02x $r_d $g_d $b_d] return $hex } # Decide if a background needs white or black text for readablity proc colors:contrast {hex} { set ret [catch {set rgb_bg [winfo rgb . $hex]} err] if {$ret} { gen_log:log E "$err" return "" } set bg0 [expr [lindex $rgb_bg 0] / 256 ] set bg1 [expr [lindex $rgb_bg 1] / 256 ] set bg2 [expr [lindex $rgb_bg 2] / 256 ] # Approximation of perceived lightness set lightness [expr ( ((2*$bg0) + $bg1 + (3*$bg2)) / 6 )] # Max lightness is 255. if {$lightness > 160} { set contrast #000000 } else { set contrast #ffffff } #puts "$hex $lightness" return $contrast } # Here's where we decide which decoration scheme to apply proc colors:match_desktop {} { global env global cvscfg global colorglb global start_log global theme_system wm withdraw . # Create some widgets to see what the basic colors are label .testlbl -text "LABEL" set lblbg [lindex [.testlbl cget -background] 0] set lblfg [lindex [.testlbl cget -foreground] 0] destroy .testlbl text .testtxt set colorglb(textbg) [lindex [.testtxt configure -background] 4] set colorglb(textfg) [lindex [.testtxt configure -foreground] 4] destroy .testtxt # Hilight colors. Get the colorful ones. entry .testent set colorglb(hlbg) [lindex [.testent configure -selectbackground] 4] set colorglb(hlfg) [lindex [.testent configure -selectforeground] 4] if {$colorglb(hlfg) eq {} } { # This happens on the Mac set colorglb(hlfg) [lindex [.testent configure -foreground] 4] } destroy .testent # Defaults set colorglb(guifont) TkDefaultFont set colorglb(lblfont) TkDefaultFont set colorglb(listboxfont) TkDefaultFont set colorglb(btnfont) TkDefaultFont set colorglb(menufont) TkMenuFont set colorglb(textfont) TkFixedFont set WSYS [tk windowingsystem] lappend start_log "Windowing system: $WSYS" set theme_system "unknown" if {$WSYS eq "x11"} { # If X11, see if we can sense our environment somehow if {$cvscfg(match_desktop)} { lappend start_log "Trying to find a destop theme" if {[info exists env(XDG_CURRENT_DESKTOP)]} { switch -glob -- $env(XDG_CURRENT_DESKTOP) { {*GNOME} - {*MATE} - {*XFCE} - {*COSMIC} - {*KDE} { if {[colors:get_gtk_theme]} { set theme_system "GTK" } } {CDE} { # CDE may or may not be running under XDG if {[colors:get_cde_params]} { set theme_system "CDE" } # Put the Help menu back on the right #tk::classic::restore menu } {*NsCDE} { # Like CDE. The palettes are in /usr/share/NsCDE/palettes # It's really FVWM. The current palette and colorsets are in FVWM_USERDIR, # usually ~/.NsCDE/Colorset.fvwmgen # also env(NSCDE_PALETTE) # Put the Help menu back on the right #tk::classic::restore menu if {[colors:get_cde_params]} { set theme_system "NsCDE" } } default { lappend start_log "I don't know how to theme XDG_CURRENT_DESKTOP=$env(XDG_CURRENT_DESKTOP)" } } } # It isn't an XDG_CURRENT_DESKTOP thing, but it could still be CDE if {$theme_system eq "unknown"} { if {[colors:get_cde_params]} { set theme_system "CDE" # Put the Help menu back on the right #tk::classic::restore menu } elseif {[colors:get_x11_resources]} { set theme_system "Xresources" lappend start_log "Using Xresources" } } # We aren't asked to match a theme, but we still respect Xdefaults } elseif {[colors:get_x11_resources]} { set theme_system "Xresources" lappend start_log "Using Xresources" } # OK it's really just X11 if {$theme_system eq "unknown"} { set theme_system "tk_default" lappend start_log "Using tk's default GUI background" set bg $lblbg set fg $lblfg set hlbg "#4a6984" ;# skyblue2 set hlfg "#ffffff" set textbg "#ffffff" set textfg "#000000" set colorglb(bg) $bg set colorglb(fg) $fg set colorglb(menubg) $bg set colorglb(menufg) $fg set colorglb(textbg) $textbg set colorglb(textfg) $textfg set colorglb(hlbg) $hlbg set colorglb(hlfg) $hlfg set colorglb(treefg) $fg set colorglb(canvfg) #000000 # No theme system lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(treebg) $panelbg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow } if {! [info exists colorglb(dialogfont)]} { set colorglb(dialogfont) TkHeadingFont } if {! [info exists colorglb(menufont)] } { set colorglb(menufont) TkMenuFont } if {! [info exists colorglb(lblfont)] } { set colorglb(lblfont) TkDefaultFont } if {! [info exists colorglb(btnfont)] } { set colorglb(btnfont) TkDefaultFont } if {! [info exists colorglb(listboxfont)] } { set colorglb(listboxfont) TkDefaultFont } if {! [info exists colorglb(textfont)] } { set colorglb(textfont) TkFixedFont } colors:add_options $theme_system } else { # We might be on MacOS (aqua) or Windows (win32) set bg $lblbg set fg $lblfg set colorglb(bg) $bg set colorglb(fg) $fg set colorglb(menubg) $bg set colorglb(menufg) $fg set colorglb(guifont) $colorglb(lblfont) set colorglb(dialogfont) TkHeadingFont # Non X11. MacOS or Windows lassign [colors:shades $bg] panelbg thumb lighter light shadow set colorglb(canvbg) $panelbg set colorglb(canvfg) $fg set colorglb(treebg) $panelbg set colorglb(treefg) $fg set colorglb(thumb) $thumb set colorglb(trough) $shadow set colorglb(lighter) $lighter set colorglb(light) $light set colorglb(shadow) $shadow } if {! [info exists colorglb(tooltipbg)]} { set colorglb(tooltipbg) #ffec8b ;# lightgoldenrod1 set colorglb(tooltipfg) #000000 } #lappend start_log "Scaling: [tk scaling]" lappend start_log "FoNt_textfont: $colorglb(textfont)" lappend start_log "FoNt_menufont: $colorglb(menufont)" lappend start_log "FoNt_btnfont: $colorglb(btnfont)" lappend start_log "FoNt_listboxfont: $colorglb(listboxfont)" lappend start_log "FoNt_guifont: $colorglb(guifont)" lappend start_log "FoNt_dialogfont: $colorglb(dialogfont)" lappend start_log "FoNt_tooltipfont: TkTooltipFont" lappend start_log "CoLoR_colorglb(bg): $colorglb(bg)" lappend start_log "CoLoR_colorglb(fg): $colorglb(fg)" foreach k [lsort [array names colorglb *??g]] { lappend start_log "CoLoR_colorglb($k): $colorglb($k)" } # Suppress tearoffs in menubars option add *tearOff 0 # This makes tk_messageBox use our font. The default tends to be terrible # no matter what platform catch {option add *Dialog.msg.font $colorglb(dialogfont) userDefault} catch {option add *Message.font $colorglb(dialogfont) userDefault} if {$WSYS eq "x11"} { ttk::style configure TScrollbar -background $colorglb(thumb) \ -troughcolor $colorglb(trough) -arrowcolor $colorglb(fg) ttk::style map "TScrollbar" \ -background [list disabled $colorglb(thumb) active $colorglb(lighter)] ttk::style configure TFrame -background $colorglb(bg) -foreground $colorglb(fg) ttk::style configure TLabel -background $colorglb(bg) -foreground $colorglb(fg) \ -font $colorglb(guifont) # Caution when using ttk::button. It won't do at all on MacOS if you do # anything remotely fancy with buttons. ttk::style configure TButton -borderwidth 2 \ -background $colorglb(bg) -foreground $colorglb(fg) \ -activebackground $colorglb(shadow) ttk::style map "TButton" \ -background [list disabled $colorglb(shadow) active $colorglb(shadow)] ttk::style configure TEntry -relief sunken -bd 2 \ -fieldbackground $colorglb(textbg) -readonlybackground $colorglb(shadow) \ -foreground $colorglb(textfg) -background $colorglb(textbg) \ -font $colorglb(listboxfont) ttk::style map "TEntry" \ -background [list readonly $colorglb(shadow) disabled $colorglb(shadow)] ttk::style configure TCheckbutton \ -background $colorglb(bg) -foreground $colorglb(fg) ttk::style map "TCheckbutton" \ -indicatorcolor [list selected $colorglb(hlbg)] # New style for things in the preferences dialog ttk::style configure Tabs.TCheckbutton \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::style configure Tabs.TRadiobutton \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::style configure Tabs.TLabel \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::style configure TRadiobutton \ -background $colorglb(bg) -foreground $colorglb(fg) ttk::style map "TRadiobutton" \ -indicatorcolor [list selected $colorglb(hlbg)] ttk::style configure TCombobox -fieldbackground $colorglb(textbg) \ -arrowcolor $colorglb(fg) \ -background $colorglb(bg) -foreground $colorglb(textfg) \ -selectbackground $colorglb(hlbg) -selectforeground $colorglb(hlfg) \ -font $colorglb(listboxfont) # font doesn't work tho ^ ttk::style map "TCombobox" \ -background [list active $colorglb(lighter)] # get some shades for the notebook lassign [colors:shades $colorglb(menubg)] panelbg thumb lighter light shadow ttk::style configure TNotebook \ -background $panelbg -foreground $colorglb(menufg) ttk::style configure TNotebook.Tab \ -background $colorglb(menubg) -foreground $colorglb(menufg) ttk::style map "TNotebook.Tab" \ -background [list selected $light] \ -foreground [list selected $colorglb(menufg)] ttk::style configure TSpinbox \ -arrowcolor $colorglb(fg) -fieldbackground $colorglb(textbg) \ -background $colorglb(menubg) -foreground $colorglb(textfg) ttk::style map "TSpinbox" \ -background [list active $colorglb(lighter)] } # Style the treeview for all platforms, although some things won't # take on MacOS or Windows ttk::style configure Treeview \ -background $colorglb(treebg) -foreground $colorglb(treefg) \ -fieldbackground $colorglb(treebg) \ -font $colorglb(listboxfont) ttk::style configure Treeview.Tree -selectbackground $colorglb(hlbg) ttk::style configure Treeview.Heading -font $colorglb(listboxfont) \ -background $colorglb(bg) -foreground $colorglb(treefg) ttk::style configure Treeview.Heading -padding {4 0} ttk::style map "Treeview.Heading" \ -background [list active $colorglb(light)] ttk::style configure Treeview.Cell -padding {2 0} ttk::style map "Treeview" \ -background [list selected $colorglb(hlbg)] \ -foreground [list selected $colorglb(hlfg)] } tkrev_9.6.1/tkrev/load_images.tcl0000664000175000017500000001406215015446517017372 0ustar dorothyrdorothyr# Keep all the images in one place proc load_all_images {} { global cvscfg global cvsglb # App icons image create photo AppIcon -format png -file [file join $cvscfg(bitmapdir) wm_TkSVN.png] image create photo Blame -format png -file [file join $cvscfg(bitmapdir) wm_blame.png] image create photo Branch -format png -file [file join $cvscfg(bitmapdir) wm_branch.png] image create photo Merge -format png -file [file join $cvscfg(bitmapdir) wm_merge.png] image create photo Help -format png -file [file join $cvscfg(bitmapdir) wm_help.png] image create photo Says -format png -file [file join $cvscfg(bitmapdir) wm_says.png] image create photo Trace -format png -file [file join $cvscfg(bitmapdir) wm_trace.png] # Buttons set photodict [dict create] dict set photodict Add add.png dict set photodict Annotate annotate.png dict set photodict Branches branch.png dict set photodict BranchNo lightning.png dict set photodict Branchtag branchtag.png dict set photodict Check check.png dict set photodict Checkin checkin.png dict set photodict Checkout checkout.png dict set photodict CheckoutOpts checkout_opts.png dict set photodict Conflict conflict.png dict set photodict Delete delete.png dict set photodict Diff delta_feather.png dict set photodict Difflines difflines.png dict set photodict DirBranches dirbranch.png dict set photodict Dir_new folder_new.png dict set photodict Edit edit.png dict set photodict Export export.png dict set photodict Fileedit fileedit.png dict set photodict Files files.png dict set photodict Fileview fileview.png dict set photodict Folder dir.png dict set photodict GitCheckin git_checkin.png dict set photodict GitCheckout git_checkout.png dict set photodict Import import.png dict set photodict Lock locked.png dict set photodict Log log.png dict set photodict Man man.png dict set photodict Mergebranch newmerge_simple.png dict set photodict Mergebranch newmerge_simple.png dict set photodict Mergediff newmerge.png dict set photodict Mergediff newmerge.png dict set photodict Modules modbrowse.png dict set photodict Modules_cvs modbrowse_cvs.png dict set photodict Modules_git modbrowse_git.png dict set photodict Modules_svn modbrowse_svn.png dict set photodict Patches rdiff.png dict set photodict Patchfile patchfile.png dict set photodict Refresh refresh.png dict set photodict Remove remove.png dict set photodict Revert loop-ball.png dict set photodict SvnRemove delete_red.png dict set photodict Tag tag.png dict set photodict Tags tags.png dict set photodict UnLock unlocked.png dict set photodict Unedit unedit.png dict set photodict Who who.png dict set photodict Workdir folderopen.png dict set photodict arr_dn arrow_dn.png dict set photodict arr_up arrow_up.png dict set photodict updir updir.png dict set photodict adir adir.png dict set photodict amod amod.png dict set photodict dir dir.png dict set photodict mdir mdir.png dict set photodict mod mod.png dict set photodict cvsdir dir_cvs.png dict set photodict dir_minus dir_minus.png dict set photodict dir_mod dir_mod.png dict set photodict dir_ok dir_ok.png dict set photodict dir_ood dir_ood.png dict set photodict dir_plus dir_plus.png dict set photodict dir dir.png dict set photodict gitdir dir_git.png dict set photodict link link.png dict set photodict link_mod link_mod.png dict set photodict link_modml link_modml.png dict set photodict link_modol link_modol.png dict set photodict link_ok link_ok.png dict set photodict link_okml link_okml.png dict set photodict link_okol link_okol.png dict set photodict link_plus link_plus.png dict set photodict paper paper.png dict set photodict rcsdir dir_rcs.png dict set photodict stat_conf stat_conf.png dict set photodict stat_cvsplus_kb stat_plus_kb.png dict set photodict stat_ex stat_ex.png dict set photodict stat_kb stat_kb.png dict set photodict stat_merge stat_merge.png dict set photodict stat_minus stat_minus.png dict set photodict stat_mod stat_mod.png dict set photodict stat_mod_green stat_mod_green.png dict set photodict stat_mod_red stat_mod_red.png dict set photodict stat_modml stat_modml.png dict set photodict stat_modol stat_modol.png dict set photodict stat_ok stat_ok.png dict set photodict stat_okml stat_okml.png dict set photodict stat_okol stat_okol.png dict set photodict stat_ood stat_ood.png dict set photodict stat_oodml stat_oodml.png dict set photodict stat_plus stat_plus.png dict set photodict stat_plus_minus stat_plus_minus.png dict set photodict stat_ques stat_ques.png dict set photodict svndir dir_svn.png dict set photodict Tclfish TkCVS_128.png dict set photodict Toothyfish TkSVN_128.png dict set photodict Squid TkRev_128.png dict for {image png} $photodict { image create photo $image -format png -file [file join $cvscfg(bitmapdir) $png] if {$cvscfg(large_icons)} { image create photo Zoomed -format png # Enlarge the orignal and copy it into a temporary image Zoomed copy $image -zoom $cvscfg(icon_mag) $cvscfg(icon_mag) # empty the original. compositingrule doesn't seem to work $image blank # copy the zoomed one back into the original $image copy Zoomed # Discard the temporary image delete Zoomed } } set cvsglb(mod_iconwidth) [image width paper] set cvsglb(mod_iconheight) [image height paper] } tkrev_9.6.1/tkrev/tkrev_def.tcl0000664000175000017500000002745415033645673017114 0ustar dorothyrdorothyr# TkRev defaults file. # # This file is read by TkRev on startup. It will be installed # automatically by the "configure" script. # # Defaults in the .tkrev file in the user's home directory will # over-ride this file. # # Make Subversion output English set env(LC_MESSAGES) C # Which version control system to prefer if more than one is present, # eg. if there are local RCS files in a Git-controlled directory # This is the historical default set cvscfg(vcspref) {cvs svn git rcs} # Accessibility: increase the size of the icons set cvscfg(large_icons) 0 # Magnify icons this much. Must be an integer. set cvscfg(icon_mag) 2 # Try to match a desktop theme? set cvscfg(match_desktop) false # Working Directory Browser options # If you want to use "cvs edit" set cvscfg(econtrol) false # If you want to use cvs in locking mode set cvscfg(cvslock) false # If you want to see the status column set cvscfg(showstatcol) true # If you want to see the date column set cvscfg(showdatecol) true # If you want to see the revision (commit ID) column set cvscfg(showwrevcol) true # If you want to see the editors/author/lockers column set cvscfg(showeditcol) true # Sort by filename or status (filecol or statcol) set cvscfg(sort_pref) {filecol -increasing} # Show the line numbers in the annotation browser set cvscfg(blame_linenums) 0 # If you want to see hash and author in Git workdir set cvscfg(gitdetail) false # Since date for git log diagram set cvscfg(gitlog_since) "" # Since date for git blame set cvscfg(gitblame_since) "" # Max number of revs to go back in a git branch diagram set cvscfg(gitmaxhist) 500 # Max number of git branches to process set cvscfg(gitmaxbranch) 100 # Which groups of git branches to consider. F can't be excluded. # F only those captured in the file log # L local, found by "git branch" # R remote, found by "git branch -r" set cvscfg(gitbranchgroups) "FL" # Max number of branches in a git branch diagram set cvscfg(gitmaxbranch) 100 # Which git log options to use for the branch diagram set cvscfg(gitlog_opts) "--first-parent" # Which branches to process for the branch diagram # as a regexp pattern set cvscfg(gitbranchregex) "" # Branch Diagram options # Number of tags in a Subversion repository that's "too many", ie # will take longer to proecess than you're willing to wait. set cvscfg(toomany_tags) 25 # Number of tags you want to see for each revision on the branching # diagram before it says "more..." set cvscfg(tagdepth) 6 # Hilight colours for revision-log boxes set cvscfg(colourA) palegreen4 set cvscfg(colourB) brown3 # Maximum number of places to save in the picklist history set cvscfg(picklist_items) 10 # If you want the module browser to come up on startup instead of the # working-directory browser, uncomment this. #set cvscfg(startwindow) "module" # # Format of date display in workdir dialog # The default: # # %Y-%m-%d %H:%M:%S - 2000-03-25 14:41:33 # # is useful because it sorts properly. Other possibilities # are: # # %d/%m/%y %I:%M:%S %p - 03/25/00 02:41:33 PM # %d-%b-%y %H:%M:%S - 03-Mar-00 14:41:33 # # Look up "date" in the tcl reference manual for a complete # description of date formats. # set cvscfg(dateformat) "%Y-%m-%d %H:%M:%S" # Format for mergeto- and mergefrom- tags. The _BRANCH_ part must be # left as-is, but you can change the prefix and the date format, for # example "mergeto_BRANCH_%d%b%y". The date format must be the same # for both. # CVS rule: a tag must not contain the characters `$,.:;@' #set cvscfg(mergetoformat) "t_BRANCH_%d%b%y_%H-%M" #set cvscfg(mergefromformat) "f_BRANCH_%d%b%y_%H-%M" set cvscfg(mergetoformat) "mergeto_BRANCH_%d%b%y" set cvscfg(mergefromformat) "mergefrom_BRANCH_%d%b%y" set cvscfg(mergetrunkname) "trunk" # The branch browser depends on the convention of having a trunk, branches, and # tags structure to draw the diagram. These variables may give you a little # more flexibility. set cvscfg(svn_trunkdir) "trunk" set cvscfg(svn_branchdir) "branches" set cvscfg(svn_tagdir) "tags" # -------------------- # Revision tree log display configuration. # Font size for tag lists and box contents (+ve = points, -ve = pixels) # FIXME: can we make this relative to some text size? set logcfg(font_size) -12 # Gaps between revisions in units of the chosen font's line spacing # spcx = x spacing between revisions # spcy = y spacing between revisions # yfudge = max extra y space used to fit branch in rather than moving right # boff = vertical offset for branch placement set logcfg(spcx) 3 set logcfg(spcy) 1 set logcfg(yfudge) 12 set logcfg(boff) 1 # Padding between box outline and box contents in pixels set logcfg(padx) 4 set logcfg(pady) 2 # Space between tag list and box in pixels set logcfg(tspcb) 2 # Line and box outline width in pixels set logcfg(width) 3 # Arrow shape for connecting lines set logcfg(arrowshape) { 6 6.7 3 } # Delay between a user option being changed and the redraw of the # tree taking place. This is to allow the user chance to change # several options at once without the tree being redrawn unecessarily. # It's in milliseconds and something in the 1.5-3 second range is # generally reasonable. set logcfg(draw_delay) 2000 # Scaling options to offer user set logcfg(scaling_options) {50% 0.5 80% 0.8 90% 0.9 100% 1.0 120% 1.2 150% 1.5} # User options for info display set logcfg(update_drawing) 2 set logcfg(scale) 1.0 set logcfg(show_tags) 1 set logcfg(show_branches) 1 set logcfg(show_merges) 1 set logcfg(show_empty_branches) 1 set logcfg(show_inter_revs) 1 set logcfg(show_root_tags) 1 set logcfg(show_box_rev) 1 set logcfg(show_box_revwho) 1 set logcfg(show_box_revdate) 1 set logcfg(show_box_revtime) 0 # -------------------- # Platform specific configuration. # # Decide wether you are unlucky and have to run tkrev on DOS/WIN # some things will be setup in the following # # Please note that you may have to setup a bit more. # if {$tcl_platform(platform) == "windows"} { # file mask for all files set cvscfg(aster) "*.*" # null-device set cvscfg(null) "nul" # Terminal program set cvscfg(terminal) "command /c" # Please don't ask me why you have to set -T on DOS, # experiments say you have! - CJ #set cvs "cvs -T $cvscfg(tmpdir)" set cvs "cvs" set cvscfg(editor) "notepad" # set temp directory set cvscfg(tmpdir) "c:/temp" #set cvscfg(tkdiff) "$TclExe [file join \"[file dirname $ScriptBin] tkdiff.tcl\"]" set cvscfg(tkdiff) "[file join \"[file dirname "$ScriptBin"] tkdiff\"]" set cvscfg(print_cmd) "pr" set cvscfg(shell) "" set cvscfg(allow_abort) "no" } else { if {[tk windowingsystem] eq "aqua"} { set cvscfg(terminal) "open -a Terminal -n" set cvscfg(editor) "open -e" #set cvscfg(editor) /Applications/TextEdit.app/Contents/MacOS/TextEdit # If you invoke vim this way, -psn_ tells it to run in its own window #set cvscfg(editor) {/Applications/Vim.app/Contents/MacOS/Vim -psn} set cvscfg(shell) "open -a Terminal -n" #set cvscfg(tkdiff) "\"/Applications/TkDiff.app/Contents/MacOS/tkdiff\"" } else { # Execution set cvscfg(terminal) "xterm -e" # Command shell set cvscfg(shell) {xterm -name tkrevxterm -n {TkRev xterm}} # To override the default editor (setup when tkrev is configured and # installed) a user can set the cvscfg(editor) variable to the editor # of choice in their .tkrev file set cvscfg(editor) {xterm -e vi} #set cvscfg(print_cmd) {enscript -Ghr -fCourier8} set cvscfg(print_cmd) "lpr" } set cvscfg(tmpdir) "/tmp" set cvscfg(aster) "*" set cvscfg(null) "/dev/null" # # Other defaults # # Full path to the CVS program if you want to give it, # otherwise the PATH environment variable will be searched. set cvs "cvs" set cvscfg(tkdiff) "tkdiff" # The file editor to be used may also be identified by pattern-matching the # filename by setting the cvscfg(editors) variable. This contains a series # of string pairs giving the editor-command and string-match-pattern. The # first pattern (see rules for [string match]) which matches the filename # going down the list determines which editor is run. If no patterns match # or the option is not set, the cvscfg(editor) value will be used instead. # - anj@aps.anl.gov #set cvscfg(editors) { # nedit *.html # nedit *.c # bitmap *.xbm # gimp *.xpm # gimp *.gif # {calibredrv -m} *.gds #} set cvscfg(allow_abort) "yes" } # # -------------------- # User Menus # # Add a cvs command to add to the User Menu # set cvsmenu(Show_My_Checkouts) "history" # set cvsmenu(Show_All_Checkouts) "history -a" # Run a a shell command whose output you want to catch # set usermenu(show_makevars) "gmake -pn | grep '='" # Run a standalone programs # set execmenu(tkman_cvs) "tkman cvs" # set execmenu(GitK) {gitk [lindex $cvsglb(current_selection) $i]} # # -------------------- # Other defaults # These can be set and saved from the GUI. # # Set this to 1 to see all files displayed in the directory # browser (including hidden files) by default. set cvscfg(allfiles) false # set the default pattern to be used by the filter. Use any valid # pattern that can be used for a pattern for 'ls'. An empty string # is equivalent to the entire directory (minus hidden files); # i.e., ls * set cvscfg(show_file_filter) "" set cvscfg(ignore_file_filter) "*.a *.o *~" set cvscfg(clean_these) "*.bak *~ .#* *tmp #* *%" # set the default for automatic statusing of a CVS controlled # directory. Automatic updates are done when a directory is # entered and after some operations. set cvscfg(auto_status) true # set the default value for confirmation prompting before performing an # operation over selected files. set cvscfg(confirm_prompt) true # some of the reporting operations could usefully be recursive. Set # the default value here. set cvscfg(recurse) false # Filter out "?" unknown files from CVS Check and CVS Update reports set cvscfg(status_filter) false # Kinds of messages for debugging: # C CVS commands # E stderr from commands # F File creation/deletion # S stdout from commands # T Function entry/exit tracing # D Debugging" set cvscfg(log_classes) "CEF" # On (1) or off (0) set cvscfg(logging) false # How many trace lines to save. The debugging output can get very large. set cvscfg(trace_savelines) 100000 # In the Repository Browser, if true this will cause the alias modules # to be grouped in one folder. Cleans up clutter if there are a lot of # aliases. If it's false, they will be listed separately at the top # level. set cvscfg(aliasfolder) true # Set colours for tagging cvs output set cvscfg(outputColor,added) darkgreen set cvscfg(outputColor,conflict) red set cvscfg(outputColor,modified) darkviolet set cvscfg(outputColor,patched) royalblue3 set cvscfg(outputColor,removed) firebrick3 set cvscfg(outputColor,stderr) red4 set cvscfg(outputColor,updated) darkgoldenrod set cvscfg(outputColor,warning) orange set cvscfg(outputColor,unknown) gray30 set cvscfg(outputColor,black) black set cvscfg(outputColor,red) red set cvscfg(outputColor,green) green set cvscfg(outputColor,yellow) darkgoldenrod set cvscfg(outputColor,blue) blue set cvscfg(outputColor,magenta) magenta set cvscfg(outputColor,cyan) turquoise set cvscfg(outputColor,white) gray30 set cvscfg(outputColor,none) black # Print setup. Removed in v7.1 #set cvscfg(papersize) "A4" #set cvscfg(pointsize) 10 #set cvscfg(headingsize) 13 #set cvscfg(subheadingsize) 11 #set cvscfg(printer) "ps" # # -------------------- # At the very end, look for a file called "site_def" in the installation # directory. That's a good place to define your tagcolours and other # site-specific things. It won't be overwritten by installs like this file is. set tkrev_path [lrange $auto_path 0 0] if {[file exists [file join $tkrev_path site_def]]} { source [file join $tkrev_path site_def] } tkrev_9.6.1/tkrev/tkrev.tcl0000755000175000017500000002265715034252612016263 0ustar dorothyrdorothyr#!/bin/sh #-*-tcl-*- # the next line restarts using wish \ exec wish "$0" -- ${1+"$@"} # # TkRev Main program -- A Tk interface to CVS. # # Uses a structured modules file -- see the manpage for more details. # # Author: Del (del@babel.dialix.oz.au) # # If we can't get this far (maybe because X display connection refused) # quit now. If we get further, the error message is very misleading. if {[info exists starkit::topdir]} { package require Tk } if {! [info exists tk_version] } { puts "Initialization failed" exit 1 } if {$tk_version < 8.6} { puts "TkRev requires Tcl/Tk 8.6 or better!" exit 1 } ############################################################ # Find out how we're invoked, so we can find our libraries ############################################################ if {[info exists starkit::topdir]} { set TclRoot [file join $starkit::topdir lib] set ScriptBin $starkit::topdir } else { if {[info exists TclRoot]} { # Perhaps we are being sourced recursively. # That would be bad. return } set Script [info script] set ScriptTail [file tail $Script] #puts "Tail $ScriptTail" if {[file type $Script] == "link"} { #puts "$Script is a link" set ScriptBin [file join [file dirname $Script] [file readlink $Script]] } else { set ScriptBin $Script } #puts "ScriptBin $ScriptBin" set TclRoot [file join [file dirname $ScriptBin]] #puts "TclRoot $TclRoot" if {$TclRoot == "."} { set TclRoot [pwd] } #puts "TclRoot $TclRoot" set TclRoot [file join [file dirname $TclRoot] "lib"] #puts "TclRoot $TclRoot" # allow runtime replacement if {[info exists env(TCLROOT)]} { set TclRoot $env(TCLROOT) } #puts "TclRoot $TclRoot" } set TclExe [info nameofexecutable] if {$tcl_platform(platform) == "windows"} { set TclExe [file attributes $TclExe -shortname] } set TCDIR [file join $TclRoot tkrev] set cvscfg(bitmapdir) [file join $TclRoot tkrev bitmaps] #puts "TCDIR $TCDIR" #puts "BITMAPDIR $cvscfg(bitmapdir)" ############################################################ # Now get some settings we need ############################################################ set cvscfg(version) "9.6.1" if {! [info exists cvscfg(editorargs)]} { set cvscfg(editorargs) "" } set auto_path [linsert $auto_path 0 $TCDIR] set cvscfg(allfiles) false if {! [info exists cvscfg(startwindow)]} { set cvscfg(startwindow) "workdir" } set cvscfg(auto_tag) false set cvscfg(econtrol) false set cvscfg(use_cvseditor) false set maxdirs 15 set dirlist "" set totaldirs 0 # Orient ourselves if { [info exists env(HOME)] } { set cvscfg(home) $env(HOME) } else { if {$tk_version >= 9.0} { set cvscfg(home) [file home] } else { set cvscfg(home) "~" } } if { [info exists env(USER)] } { set cvscfg(user) $env(USER) } elseif { [info exists env(USERNAME)] } { # Windows set cvscfg(user) $env(USERNAME) } else { set cvscfg(user) "" } set cvscfg(cvsroot) "" set cvscfg(svnroot) "" set cvscfg(gitroot) "" # Read in defaults if {[file exists [file join $TCDIR tkrev_def.tcl]]} { source [file join $TCDIR tkrev_def.tcl] } set optfile [file join $cvscfg(home) .tkrev] set old_optfile [file join $cvscfg(home) .tkcvs] if {[file exists $old_optfile] && ![file exists $optfile]} { file copy $old_optfile $optfile } if {[file exists $optfile]} { catch {source $optfile} } set pickfile [file join $cvscfg(home) .tkrev-picklists] if {[file exists $pickfile]} { picklist_load } if {! [info exist cvsglb(directory)]} { set cvsglb(directory) [pwd] } if {[info exists cvsglb(cvsroot)]} { set cvscfg(cvsroot) [lindex $cvsglb(cvsroot) 0] } # Can be overridden on command line set cvsglb(vcspref) $cvscfg(vcspref) # Clear some variables set cvsglb(commit_comment) "" set cvsglb(cvs_version) "" if {$cvscfg(use_cvseditor) && ![info exists cvscfg(terminal)]} { cvserror "cvscfg(terminal) is required if cvscfg(use_cvseditor) is set" } ############################################################ # Detect platform windowing system and try to more or less match it ############################################################ colors:match_desktop # Once we have a UI, initialize logging (classes are C,F,T,D) if { ! [info exists cvscfg(log_classes)] } { set cvscfg(log_classes) "C" } foreach class [split $cvscfg(log_classes) {}] { set logclass($class) $class } if { ! [info exists cvscfg(logging)] } { set cvscfg(logging) false } load_all_images if {$cvscfg(logging)} { gen_log:init # log the trace stuff we saved from before we could post it if {[regexp {[FD]} $cvscfg(log_classes)]} { gen_log:color $start_log } } ############################################################ # # Command line options # ############################################################ set usage "Usage:" append usage "\n tkrev \[--vcs \] \[--root \] \[--dir ] \[--win workdir|module|merge\]" append usage "\n tkrev \[--log|blame \]" append usage "\n tkrev - same as tkrev --log " for {set i 0} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] set val [lindex $argv [expr {$i+1}]] switch -regexp -- $arg { {^--*d.*} { # -ddir: Starting directory set dir $val; incr i cd $dir } {^--*v.*} { # -vcs: which version control system(s) to prefer. Will override cvscfg(vcspref) set colorglb(vcspref) $val; incr i } {^--*r.*} { # -root: CVSROOT, SVN URL, or Git origin set cvscfg(cvsroot) $val; incr i } {^--*w.*} { # workdir|module|merge: window to start with. workdir is default. set cvscfg(startwindow) $val; incr i lassign [vcs_detect [pwd]] incvs insvn inrcs ingit } {^--*l.*} { # -log : Browse the log of specified file set cvscfg(startwindow) log set lcfile $val; incr i lassign [vcs_detect [pwd]] incvs insvn inrcs ingit } {^--*[ab].*} { # annotate|blame: Browse colorcoded history of specified file set cvscfg(startwindow) blame set lcfile $val; incr i lassign [vcs_detect [pwd]] incvs insvn inrcs ingit } {^-psn_.*} { # Ignore the Carbon Process Serial Number, in case we're in a MacOS package incr i } {^--*h.*} { puts $usage exit 0 } {^\.*\w*} { # If a filename is provided as an argument, assume -log # except if it's a directory and it's CVS or RCS, which don't # version directories. In that case, instead of throwing an error # let's just open the workdir in the arg directory lassign [vcs_detect [pwd]] incvs insvn inrcs ingit if {!($insvn || $ingit) && [file isdirectory $arg]} { set dir $arg cd $arg } else { set cvscfg(startwindow) log set lcfile $arg; incr i } } default { puts $usage exit 1 } } } if {[info exists lcfile]} { set d [file dirname $lcfile] set f [file tail $lcfile] set lcfile $f cd $d } if {![info exists cvscfg(ignore_file_filter)]} { set cvscfg(ignore_file_filter) "" } if {[info exists cvscfg(file_filter)]} { unset cvscfg(file_filter) } if {![info exists cvscfg(show_file_filter)]} { set cvscfg(show_file_filter) "*" } set cvsglb(root) "" set cvsglb(vcs) "" # Create a window # Start with Module Browser if {[string match {mod*} $cvscfg(startwindow)]} { wm withdraw . # If we're in a version-controlled directory, open that repository if {$insvn} { set cvsglb(root) $cvscfg(svnroot) set cvsglb(vcs) svn } elseif {$incvs} { set cvsglb(root) $cvscfg(cvsroot) set cvsglb(vcs) cvs } elseif {$ingit} { set cvsglb(root) $cvscfg(url) set cvsglb(vcs) git } elseif {$inrcs} { set cvsglb(root) $cvscfg(rcsdir) set cvsglb(vcs) rcs } else { # We'll respect CVSROOT environment variable if it's set if {[info exists env(CVSROOT)]} { gen_log:log D "setting cvsglb(root) from CVSROOT envvar" set cvsglb(root) $env(CVSROOT) set cvscfg(cvsroot) $env(CVSROOT) set cvsglb(vcs) cvs } } # Othewise we set it to the most recent saved in picklist # which we've saved in cvscfg(cvsroot) if {$cvsglb(root) == ""} { gen_log:log D "setting cvsglb(root) to the last one visited" set cvsglb(root) $cvscfg(cvsroot) } modbrowse_run # Start with Branch Browser } elseif {$cvscfg(startwindow) == "log"} { if {! [file exists $lcfile]} { puts "ERROR: $lcfile doesn't exist!" exit 1 } wm withdraw . if {$incvs} { cvs_branches [list $lcfile] } elseif {$inrcs} { set cwd [pwd] set module_dir "" rcs_branches [list $lcfile] } elseif {$insvn} { svn_branches [list $lcfile] } elseif {$ingit} { git_branches [list $lcfile] } else { puts "File doesn't seem to be in CVS, SVN, RCS, or GIT" } # Start with Annotation Browser } elseif {$cvscfg(startwindow) == "blame"} { if {! [file exists $lcfile]} { puts "ERROR: $lcfile doesn't exist!" exit 1 } wm withdraw . if {$incvs} { cvs_annotate $current_tagname [list $lcfile] } elseif {$insvn} { svn_annotate rBASE [list $lcfile] } elseif {$ingit} { read_git_dir . git_annotate $current_tagname [list $lcfile] } else { puts "File doesn't seem to be in CVS, SVN, or GIT" } # Start with Directory Merge } elseif {[string match {mer*} $cvscfg(startwindow)]} { wm withdraw . if {$incvs} { cvs_joincanvas } elseif {$insvn} { svn_directory_merge } else { puts "Directory doesn't seem to be in CVS or SVN" } # The usual way, with the Workdir Browser } else { setup_dir } tkrev_9.6.1/tkrev/annotate.tcl0000664000175000017500000005100715027434303016730 0ustar dorothyrdorothyrnamespace eval ::annotate { variable instance 0 proc new {revision fnam type {L1 {}} {L2 {}}} { # # show information on the last modification for each line of a file. # variable instance set my_idx $instance incr instance gen_log:log T "ENTER ($revision $fnam $type $L1 $L2)" namespace eval $my_idx { set my_idx [uplevel {concat $my_idx}] variable revision [uplevel {concat $revision}] variable fnam [uplevel {concat $fnam}] variable type [uplevel {concat $type}] variable L1 [uplevel {concat $L1}] variable L2 [uplevel {concat $L2}] variable blamewin .annotate$my_idx variable ll upvar ::cvscfg cvscfg upvar ::insvn in_svn upvar ::inrcs in_git upvar ::cvs cvs global tcl_platform proc redo {w} { variable log_lines variable revcolors variable blameproc variable lc gen_log:log T "ENTER ($w)" catch {unset revcolors} $w.text configure -state normal $w.text delete 1.0 end busy_start $w set lc 0 foreach logline [lrange $log_lines 0 end-1] { incr lc $blameproc $w.text $logline $lc } ro_textbindings $w.text # Focus in the text widget to activate the text bindings focus $w.text busy_done $w update idletasks gen_log:log T "LEAVE" } # Get the line the mouse was clicked on proc get_blamerev {win x y} { global cvscfg set parent [winfo parent $win] set lineloc [$win index @$x,$y] set linenum [lindex [split $lineloc "."] 0] set linetext [$win get $linenum.0 $linenum.end] set f1 "" set f2 "" regexp {^\s*(\S+)\s+(\S+)} $linetext all f1 f2 orig_line $parent.top.reventry delete 0 end if {$cvscfg(blame_linenums)} { set selected_rev $f2 } else { set selected_rev $f1 } $parent.top.reventry insert end $selected_rev } # We already made a sorted revision list in order to do the heat map, so # we can use it for free to find the revision previous to the selected # one proc previous_rev {rev} { variable revlist variable type variable blamewin set is_svn 0 if {[string match {svn*} $type]} { set is_svn 1 } if {$is_svn} { set rev [string trimleft $rev {r}] } # Find the selected revision in the list set ind [lsearch $revlist $rev] # Get the previous one set previous_rev [lindex $revlist $ind-1] if {$previous_rev eq ""} { if {$ind == 0} { cvsfail "Please select a revision other than the first one!" $blamewin } else { cvsfail "Please select a revision!" $blamewin } } if {$is_svn} { set previous_rev "r$previous_rev" } gen_log:log T "LEAVE ($previous_rev)" return $previous_rev } proc cvs_annotate_color {w logline ln} { global cvscfg global cvsglb global colorglb global tk_version variable revcolors variable agecolors variable revlist variable nrevs variable revspercolor variable maxrevlen variable ll # Separate the line into annotations and content regexp {(^.*): (.*$)} $logline all annotations orig_line regexp {(^[\d\.]*)\s+(.*$)} $annotations all revnum who_when set line "$who_when: $orig_line" # Beginning of a revision if {! [info exists revcolors($revnum)]} { # determine the number of revisions then set color accordingly set revticks [lsearch -exact $revlist $revnum] set revticks [expr {$nrevs - $revticks}] set revindex [expr {$revticks / $revspercolor}] set ncolors [expr {[array size agecolors] - 1}] if {$revindex > $ncolors} {set revindex $ncolors} if {$revindex < 0} {set revindex 0} set revcolors($revnum) $agecolors($revindex) $w tag configure $revnum -background $revcolors($revnum) \ -foreground black -selectbackground $colorglb(hlbg) } if {$cvscfg(blame_linenums)} { $w insert end [format "%${ll}d " $ln] } $w insert end [format "%-${maxrevlen}s " $revnum] $revnum $w insert end "$line\n" $revnum } proc git_annotate_color {w logline ln} { global cvscfg global colorglb global tk_version variable revcolors variable agecolors variable revlist variable nrevs variable revspercolor variable maxrevlen variable ll # Separate the line into annotations and content regexp {(^\S+)\s+\((.*?)\)(.*$)} $logline all revnum annot orig_line set annot [string trim $annot] regsub -all {\s+} $annot { } annot set linenum [lindex $annot end] set when [lindex $annot end-3] # Is the name ever in two parts? (Yes. Or three.) set who [lrange $annot 0 end-4] set line "($who $when): $orig_line" # Beginning of a revision if {! [info exists revcolors($revnum)]} { # determine the number of revisions then set color accordingly set revticks [lsearch -exact $revlist $revnum] set revticks [expr {$nrevs - $revticks}] set revindex [expr {$revticks / $revspercolor}] set ncolors [expr {[array size agecolors] - 1}] if {$revindex > $ncolors} {set revindex $ncolors} if {$revindex < 0} {set revindex 0} set revcolors($revnum) $agecolors($revindex) $w tag configure $revnum -background $revcolors($revnum) \ -foreground black -selectbackground $colorglb(hlbg) } if {$cvscfg(blame_linenums)} { $w insert end [format "%${ll}d " $linenum] } $w insert end [format "%-${maxrevlen}s " $revnum] $revnum $w insert end "$line\n" $revnum } proc svn_annotate_color {w logline ln} { global cvscfg global colorglb global tk_version variable revcolors variable agecolors variable revlist variable nrevs variable revspercolor variable maxrevlen variable ll # Separate the line into annotations and content regexp {^\s*(\d+)\s+(.*?\) )(.*$)} $logline all revnum annotations orig_line regexp {^(\S+) ([-\d]*)} $annotations all who when if {$revnum == "Skipping"} { cvsfail "Skipping binary file" $w return "" } set line "($who $when): $orig_line" # Beginning of a revision if {! [info exists revcolors($revnum)]} { # determine the number of revisions then set color accordingly set revticks [lsearch -exact $revlist $revnum] set revticks [expr {$nrevs - $revticks}] set revindex [expr {$revticks / $revspercolor}] set ncolors [expr {[array size agecolors] - 1}] if {$revindex > $ncolors} {set revindex $ncolors} if {$revindex < 0} {set revindex 0} set revcolors($revnum) $agecolors($revindex) $w tag configure $revnum -background $revcolors($revnum) \ -foreground black -selectbackground $colorglb(hlbg) } if {$cvscfg(blame_linenums)} { $w insert end [format "%${ll}d " $ln] } # we're sticking an "r" on - one more character set lr [expr {$maxrevlen+1}] $w insert end [format "r%-${lr}s " $revnum] $revnum $w insert end "$line\n" $revnum return "" } regsub -all {\$} $fnam {\$} fnam switch $type { "svn" - "svn_r" { set blameproc svn_annotate_color set commandline "svn annotate -v $revision \"$fnam\"" } "cvs" { set blameproc cvs_annotate_color set commandline "$cvs annotate $revision \"$fnam\"" } "cvs_r" { # First see if we can do this # rannotate appeared in 1.11.1 set versionsplit [split $cvsglb(cvs_version) {.}] set major [lindex $versionsplit 1] set minor [lindex $versionsplit 2] set too_old 0 if {$major < 11} { set too_old 1 } elseif {($major == 11) && ($minor < 1)} { set too_old 1 } if {$too_old} { cvsfail "You need CVS >= 1.11.1 to do this" $w namespace delete [namespace current] return "" } set blameproc cvs_annotate_color set commandline "$cvs -d $cvscfg(cvsroot) rannotate $revision \"$fnam\"" } "git" - "git_r" { if {$cvscfg(gitblame_since) != ""} { set sinceflag "--since=\"$cvscfg(gitblame_since)\"" regsub -all {\s+} $sinceflag {\\ } sinceflag } else { set sinceflag "" } set blameproc git_annotate_color set commandline "git annotate --abbrev-commit $sinceflag $revision \"$fnam\"" } "git_range" { if {$cvscfg(gitblame_since) != ""} { set sinceflag "--since=\"$cvscfg(gitblame_since)\"" regsub -all {\s+} $sinceflag {\\ } sinceflag } else { set sinceflag "" } set blameproc git_annotate_color set commandline "git annotate --abbrev-commit $sinceflag -L$L1,$L2 $revision \"$fnam\"" } default { cvsfail "I don't understand flag \"$type\"" return "" } } # Initialize searching search_textwidget_init # Make the window toplevel $blamewin menubar_menus $blamewin help_menu $blamewin text $blamewin.text -setgrid yes -exportselection 1 \ -relief sunken -borderwidth 2 -height 40 -width 122 \ -yscrollcommand "$blamewin.scroll set" ttk::scrollbar $blamewin.scroll -command "$blamewin.text yview" frame $blamewin.top -relief groove -borderwidth 2 entry $blamewin.top.reventry button $blamewin.top.viewfile -image Fileview button $blamewin.top.log -image Log button $blamewin.top.ddiff -image Difflines button $blamewin.top.patchdiff -image Patches button $blamewin.top.diff -image Diff button $blamewin.top.workdir -image Workdir -command {workdir_setup} frame $blamewin.bottom button $blamewin.bottom.close -text "Close" \ -command [namespace code { global cvscfg variable w variable my_idx set cvscfg(blamegeom) [wm geometry $blamewin] destroy $blamewin namespace delete [namespace current] exit_cleanup 0 }] label $blamewin.bottom.days -text "Revs per Color" -width 20 -anchor e ttk::checkbutton $blamewin.bottom.linum -text "Show Line Numbers" \ -variable [namespace current]::cvscfg(blame_linenums) \ -onvalue 1 -offvalue 0 entry $blamewin.bottom.dayentry -width 3 \ -textvariable [namespace current]::revspercolor button $blamewin.bottom.redo -text "Redo Colors" button $blamewin.bottom.srchbtn -text Search \ -command "search_textwidget $blamewin.text" entry $blamewin.bottom.entry -width 20 -textvariable cvsglb(searchstr) bind $blamewin.bottom.entry "search_textwidget $blamewin.text" pack $blamewin.bottom -side bottom -fill x pack $blamewin.bottom.srchbtn -side left pack $blamewin.bottom.entry -side left pack $blamewin.bottom.linum -side left -padx 4 pack $blamewin.bottom.days -side left pack $blamewin.bottom.dayentry -side left pack $blamewin.bottom.redo -side left pack $blamewin.bottom.close -side right -ipadx 15 pack $blamewin.top -side top -fill x pack $blamewin.top.reventry -side left pack $blamewin.top.viewfile \ $blamewin.top.log \ $blamewin.top.diff \ -in $blamewin.top -side left -ipadx 4 -ipady 4 if {$in_svn || $in_git} { pack $blamewin.top.patchdiff \ $blamewin.top.ddiff \ -in $blamewin.top -side left -ipadx 4 -ipady 4 } pack $blamewin.top.workdir -side right pack $blamewin.scroll -side right -fill y pack $blamewin.text -fill both -expand 1 wm title $blamewin "TkRev Annotate [file tail $fnam]" if { [tk windowingsystem] eq "x11" } { wm iconphoto $blamewin Blame } wm minsize $blamewin 1 1 if {[info exists cvscfg(blamegeom)]} { wm geometry $blamewin $cvscfg(blamegeom) } switch -glob -- $type { {cvs*} { if {$type eq "cvs_r"} { set file [file tail $fnam] } $blamewin.top.viewfile configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { cvs_fileview_update $rev "$fnam" } }] $blamewin.top.log configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { cvs_log_rev $rev "$fnam" } }] $blamewin.top.diff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] set previous [previous_rev $rev] if {$previous ne ""} { comparediff_r $previous $rev $blamewin "$fnam" } }] } {svn*} { $blamewin.top.viewfile configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { svn_fileview $rev $fnam "file"} }] $blamewin.top.log configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { svn_log_rev $rev $fnam } }] $blamewin.top.diff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] set previous [previous_rev $rev] if {$previous ne ""} { comparediff_r $previous $rev $blamewin $fnam } }] $blamewin.top.ddiff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { svn_show_rev $rev $fnam } }] $blamewin.top.patchdiff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { svn_difflog_rev $rev $fnam } }] } {git*} { $blamewin.top.viewfile configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { git_fileview $rev "." $fnam} }] $blamewin.top.log configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { git_log_rev $rev $fnam} }] $blamewin.top.diff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { comparediff_r $rev^ $rev $blamewin $fnam } }] $blamewin.top.ddiff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { git_show $rev } }] $blamewin.top.patchdiff configure -state normal \ -command [namespace code { set rev [$blamewin.top.reventry get] if {$rev ne ""} { git_patch $fnam $rev } }] } } set_tooltips $blamewin.top.workdir \ {"Open the Working Directory Browser"} set_tooltips $blamewin.top.viewfile \ {"View a version of the file"} set_tooltips $blamewin.top.log \ {"Revision log of the file"} set_tooltips $blamewin.top.diff \ {"Side-by-side comparison of a version to its predecessor"} set_tooltips $blamewin.top.ddiff \ {"List changed files in a commit"} set_tooltips $blamewin.top.patchdiff \ {"Show file changes in a commit"} # Define the colors array set agecolors { 0 #FFFF4B4B4B4B 1 #FFFF6C6C4B4B 2 #FFFF82824B4B 3 #FFFF97974B4B 4 #FFFFA8A84B4B 5 #FFFFB4B44B4B 6 #FFFFC5C54B4B 7 #FFFFDBDB4B4B 8 #FFFFFCFC4B4B 9 #DBDBFFFF4B4B 10 #ACACFFFF4B4B 11 #7575FFFF4B4B 12 #4F4FFFFF4B4B 13 #4B4BFFFFB4B4 14 #4B4BFFFFDFDF 15 #4B4BF4F4FFFF 16 #4B4BDFDFFFFF 17 #4B4BD2D2FFFF 18 #4B4BB0B0FFFF 19 #4B4B8686FFFF 20 #4B4B7979FFFF 21 #4B4B6464FFFF 22 #4B4B5757FFFF 23 #4B4B4B4BFFFF } gen_log:log C "$commandline" busy_start $blamewin set exec_cmd [exec::new "$commandline"] set log [$exec_cmd\::output] # Read the log lines. Assign a color to each unique revision. catch {unset revcolors} set log_lines [split [set log] "\n"] # We have 24 colors. How many revs do we have? set revlist "" set maxrevlen 0 switch -glob -- $type { {cvs*} - {svn*} { # Sort the revisions foreach logline $log_lines { set line [split [string trimleft $logline]] set revnum [lindex $line 0] if {$revnum == ""} {continue} if {$revnum ni $revlist} { lappend revlist $revnum set l [string length $revnum] if {$l > $maxrevlen} { set maxrevlen $l } } } set revlist [lsort -dictionary $revlist] } {git*} { # Sort by date instead of by commit number foreach logline $log_lines { regexp {(^\S+)\s+\((.*?)\)(.*$)} $logline all revnum annot orig_line set full_date [lrange $annot end-3 end-2] if {! [info exists commit($full_date]} { set commit($full_date) $revnum } set maxrevlen [string length $revnum] } foreach d [lsort -dictionary [array names commit]] { lappend revlist $commit($d) } } } set nrevs [llength $revlist] if {$nrevs == 0} { set msg "No output for $commandline" cvsfail $msg $blamewin return "" } gen_log:log D "$revlist" set ncolors [expr {[array size agecolors] - 1}] if {$nrevs < $ncolors} { set revspercolor 1 } else { set rpc [expr {1 + ($nrevs / $ncolors)}] set revspercolor $rpc } gen_log:log D "nrevs $nrevs" gen_log:log D "revs per color $revspercolor" # Since there's an entry for changing revspercolor, make sure it's # something you can divide by or it will produce an error. if {[string length $revspercolor] == 0 || $revspercolor == 0} { gen_log:log D "revspercolor was \"$revspercolor\": setting to 1" set revspercolor 1 } # linecount set lc 0 set ll [string length [llength $log_lines]] foreach logline [lrange $log_lines 0 end-1] { incr lc $blameproc $blamewin.text $logline $lc } $blamewin.text yview moveto 0 update idletasks bind $blamewin.bottom.dayentry [namespace code {redo $blamewin}] $blamewin.bottom.redo configure -command [namespace code {redo $blamewin}] $blamewin.bottom.redo configure -command [namespace code {redo $blamewin}] $blamewin.bottom.linum configure -command [namespace code {redo $blamewin}] # Disable key presses and make a popup for mouse Copy ro_textbindings $blamewin.text bind $blamewin.text [namespace code {get_blamerev %W %x %y}] # Focus in the text widget to activate the text bindings focus $blamewin.text busy_done $blamewin ro_textbindings $blamewin.text return [namespace current] } } } tkrev_9.6.1/tkrev/rcs.tcl0000664000175000017500000003343415033645673015725 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # Contains procedures used in interaction with CVS. # proc rcs_notinrcs {} { cvsfail "No RCS files found." .workdir } # Get the revision log of an RCS file and send it to the # branch-diagram browser. # Disable merge buttons. proc rcs_branches {files} { global cwd gen_log:log T "ENTER ($files)" if {$files == {}} { cvsfail "Please select one or more files!" .workdir return } foreach filename $files { ::cvs_branchlog::new RCS "$filename" } gen_log:log T "LEAVE" } # check out (co) a file. Called from the "update" button proc rcs_checkout {files} { global cvscfg gen_log:log T "ENTER ($files)" if {$files == {}} { cvsfail "Please select one or more files!" .workdir return } set commandline "co -l $files" set v [::viewer::new "RCS Checkout"] $v\::do "$commandline" 1 if {$cvscfg(auto_status)} { $v\::wait setup_dir } gen_log:log T "LEAVE" } proc rcs_lock {do files} { global cvscfg if {$files == {}} { cvsfail "Please select one or more files!" .workdir return } switch -- $do { lock { set commandline "rcs -l $files"} unlock { set commandline "rcs -u $files"} } gen_log:log C "$commandline" set rcscmd [::exec::new "$commandline"] if {$cvscfg(auto_status)} { $rcscmd\::wait setup_dir } } # RCS checkin. proc rcs_checkin {revision comment args} { global cvscfg global inrcs gen_log:log T "ENTER ($args)" set filelist [lindex $args 0] if {$filelist == ""} { cvsfail "Please select some files!" return 1 } set commit_output "" foreach file $filelist { append commit_output "\n$file" } set mess "This will commit your changes to:$commit_output" append mess "\n\nAre you sure?" set commit_output "" if {[cvsconfirm $mess .workdir] != "ok"} { return 1 } set revflag "" if {$revision != ""} { set revflag "-r $revision" } if {$cvscfg(use_cvseditor)} { # Starts text editor of your choice to enter the log message. # This way a template in CVSROOT can be used. update idletasks set commandline \ "$cvscfg(terminal) ci $revflag $filelist" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$ret} { cvsfail $view_this .workdir gen_log:log T "LEAVE ERROR ($view_this)" return } } else { if {$comment == ""} { cvsfail "You must enter a comment!" .commit return 1 } set v [viewer::new "RCS Checkin"] regsub -all {"} $comment {\"} comment regsub -all { } $comment {\ } comment regsub -all {\n} $comment {\\n} comment set now [clock format [clock seconds] -format "$cvscfg(dateformat)"] set description "Created $now" regsub -all { } $description {_} description # The -t is necessary if it's the initial commit (aka "add" in other systems.) # It's ignored otherwise, so it does no harm. set commandline "ci $revflag -t-$description -m\"$comment\" $filelist" $v\::do "$commandline" 1 $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc rcs_commit_dialog {filelist} { global cvsglb global cvscfg global colorglb gen_log:log T "ENTER" # commit any files selected via listbox selection mechanism. set cvsglb(commit_list) $filelist # If we want to use an external editor, just do it if {$cvscfg(use_cvseditor)} { rcs_checkin "" "" $cvsglb(commit_list) return } if {[winfo exists .commit]} { destroy .commit } toplevel .commit frame .commit.top -borderwidth 8 frame .commit.vers frame .commit.down -relief groove -borderwidth 2 pack .commit.top -side top -fill x pack .commit.down -side bottom -fill x pack .commit.vers -side top -fill x label .commit.lvers -text "Specify Revision (-r) (usually ignore)" \ -anchor w entry .commit.tvers -relief sunken -textvariable version pack .commit.lvers .commit.tvers -in .commit.vers \ -side left -fill x -pady 3 frame .commit.comment pack .commit.comment -side top -fill both -expand 1 label .commit.comment.lcomment -text "Your log message" -anchor w button .commit.comment.history -text "Log History" \ -command history_browser text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ -bg $colorglb(textbg) -fg $colorglb(textfg) -exportselection 1 \ -wrap word -borderwidth 2 -setgrid yes # Explain what it means to "commit" files message .commit.message -justify left -aspect 500 -relief groove -bd 2 \ -text "This will commit changes from your \ local, working directory into the repository." pack .commit.message -in .commit.top -padx 2 -pady 5 button .commit.ok -text "OK" \ -command { #grab release .commit wm withdraw .commit set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] rcs_checkin $version $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.apply -text "Apply" \ -command { set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] rcs_checkin $version $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.clear -text "ClearAll" \ -command { set version "" .commit.comment.tcomment delete 1.0 end } button .commit.quit \ -command { #grab release .commit wm withdraw .commit } .commit.ok configure -text "OK" .commit.quit configure -text "Close" grid columnconf .commit.comment 1 -weight 1 grid rowconf .commit.comment 1 -weight 1 grid .commit.comment.lcomment -column 0 -row 0 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew grid .commit.comment.history -column 0 -row 1 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Fill in the most recent commit message .commit.comment.tcomment insert end [string trimright $cvsglb(commit_comment)] wm title .commit "Commit Changes" wm minsize .commit 1 1 gen_log:log T "LEAVE" } # Tags one or more files proc rcs_tag {tagname force args} { global inrcs global cvscfg gen_log:log T "ENTER ($tagname $force $args)" if {! $inrcs} { cvs_notinrcs return 1 } if {$tagname == ""} { cvsfail "Please enter a tag name!" .workdir return 1 } set filelist [join $args] if {$force == "yes"} { set command "rcs -N$tagname:" } else { set command "rcs -n$tagname:" } foreach f $filelist { append command " \"$f\"" } # If it refuses to tag, it can exit with 0 but still put out some stderr set v [viewer::new "RCS Tag (Symbolic name)"] $v\::do "$command" 1 $v\::wait if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # Get an rcs status for files in working directory, for the dircanvas proc rcs_workdir_status {} { global cvscfg global Filelist gen_log:log T "ENTER" set rcsfiles [glob -nocomplain -- RCS/* RCS/.??* *,v .??*,v] set command "rlog -h $rcsfiles" gen_log:log C "$command" set ret [catch {exec {*}$command} raw_rcs_log] gen_log:log S "$raw_rcs_log" # The older version (pre-5.x or something) of RCS is a lot different from # the newer versions, explaining some of the ugliness here set rlog_lines [split $raw_rcs_log "\n"] set lockers "" set filenames "" foreach rlogline $rlog_lines { # Found one! if {[string match "*Working file:*" $rlogline]} { regsub {^.*Working file:\s+} $rlogline "" filename regsub {\s*$} $filename "" filename lappend filenames $filename gen_log:log D "RCS file $filename" set Filelist($filename:wrev) "" set Filelist($filename:stickytag) "" set Filelist($filename:option) "" if {[file exists $filename]} { set Filelist($filename:status) "RCS Up-to-date" # Do rcsdiff to see if it's changed set command "rcsdiff \"$filename\"" gen_log:log C "$command" set ret [catch {exec {*}$command} output] gen_log:log S "$output" set splitline [split $output "\n"] if {[string match {====*} [lindex $splitline 0]]} { set splitline [lrange $splitline 1 end] } if {[llength $splitline] > 3} { set Filelist($filename:status) "RCS Modified" gen_log:log D "$filename MODIFIED" } } else { set Filelist($filename:status) "RCS Needs Checkout" } set who "" set lockers "" continue } if {[string match "head:*" $rlogline]} { regsub {head:\s+} $rlogline "" revnum set Filelist($filename:wrev) "$revnum" set Filelist($filename:stickytag) "$revnum on trunk" gen_log:log D " Rev \"$revnum\"" continue } if {[string match "branch:*" $rlogline]} { regsub {branch: *} $rlogline "" revnum if {[string length $revnum] > 0} { set Filelist($filename:wrev) "$revnum" set Filelist($filename:stickytag) "$revnum on branch" gen_log:log D " Branch rev \"$revnum\"" } continue } if { [string index $rlogline 0] == "\t" } { set splitline [split $rlogline] set who [lindex $splitline 1] set who [string trimright $who ":"] append lockers ",$who" gen_log:log D " lockers $lockers" } else { if {[string match "access list:*" $rlogline]} { set lockers [string trimleft $lockers ","] set Filelist($filename:editors) $lockers # No more tags after this point continue } } } foreach f $filenames { set lockers $Filelist($f:editors) if { $lockers ne "" } { if {$cvscfg(user) in $lockers} { append Filelist($f:status) "/HaveLock" } else { append Filelist($f:status) "/Locked" } } } gen_log:log T "LEAVE" } # for Directory Status Check proc rcs_check {} { global cvscfg gen_log:log T "ENTER" set v [::viewer::new "RCS Directory Check"] set rcsfiles [glob -nocomplain -- RCS/* RCS/.??* *,v .??*,v] set command "rlog -h $rcsfiles" gen_log:log C "$command" set ret [catch {exec {*}$command} raw_rcs_log] gen_log:log S "$raw_rcs_log" set rlog_lines [split $raw_rcs_log "\n"] foreach rlogline $rlog_lines { if {[string match "Working file:*" $rlogline]} { regsub {Working file: } $rlogline "" filename regsub {\s*$} $filename "" filename gen_log:log D "RCS file $filename" if {[file exists $filename]} { # Do rcsdiff to see if it's changed set command "rcsdiff -q \"$filename\" > $cvscfg(null)" gen_log:log C "$command" set ret [catch {exec {*}$command}] if {$ret == 1} { $v\::log "\nM $filename" } } else { $v\::log "\nU $filename" } } } gen_log:log T "LEAVE" } # Called by either the workdir or module browser proc rcs_log {detail args} { gen_log:log T "ENTER ($detail $args)" set filelist $args if {$filelist == ""} { set filelist [glob -nocomplain -- RCS/* RCS/.??* *,v .??*,v] } gen_log:log D "detail $detail" gen_log:log D "$filelist" set commandline "rlog " switch -- $detail { latest { append commandline "-R " } summary { append commandline "-t " } } foreach f $filelist { append commandline "\"$f\"" } set v [viewer::new "RCS log ($detail)"] $v\::do "$commandline" 0 rcslog_colortags catch {busy_done .workdir.main} gen_log:log T "LEAVE" } proc rcs_log_rev {revision filename} { gen_log:log T "ENTER ($revision $filename)" set commandline "rlog" if {$revision ne ""} { append commandline " -r$revision" } append commandline " \"$filename\"" set v [viewer::new "RCS log -r$revision $filename "] $v\::do "$commandline" 0 rcslog_colortags gen_log:log T "LEAVE" } # This views a specific revision of a file # Called by either the workdir or module browser proc rcs_fileview_checkout {revision filename} { gen_log:log T "ENTER ($revision $filename)" if {$revision == {}} { set commandline "co -p \"$filename\"" set v [viewer::new "$filename"] $v\::do "$commandline" 0 } else { set commandline "co -p -r$revision \"$filename\"" set v [viewer::new "$filename Revision $revision"] $v\::do "$commandline" 0 } gen_log:log T "LEAVE" } # Revert a file to checked-in version by removing the local # copy and updating it proc rcs_revert {args} { global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] gen_log:log D "Reverting $filelist" gen_log:log F "DELETE $filelist" file delete $filelist gen_log:log C "co $filelist" set rcscmd [exec::new "co $filelist"] if {$cvscfg(auto_status)} { $rcscmd\::wait setup_dir } gen_log:log T "LEAVE" } proc find_rcsfiles {rcspath} { global colorglb global modval global modtitle gen_log:log T "ENTER ($rcspath)" # Clear the arrays catch {unset modval} catch {unset modtitle} set tv .modbrowse.treeframe.pw if {[regexp -nocase {^RCS$} [file tail $rcspath]]} { set rcspath [file dirname $rcspath] } # Not all versions of find have printf #set command "find $rcspath -name \"*,v\" -printf \"%p %AF %AH:%AM:%AS\n\"" set command "find -L $rcspath -name \"*,v\" -ls" gen_log:log C "$command" set find_cmd [exec::new $command] set find_output [$find_cmd\::output] set id 0 foreach line [split $find_output "\n"] { if {$line eq ""} {continue} set date [lrange $line 7 9] set filename [lrange $line 10 end] set vname [join $filename " "] gen_log:log D "filevname=$vname date=$date" incr id # This is the hash gen_log:log D "$tv insert {} end -id $id -values [list $vname $date]" $tv insert {} end -id $id -values [list "$vname" "$date"] } update idletasks gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/gen_log.tcl0000664000175000017500000001674315033645673016554 0ustar dorothyrdorothyr# # Debugging trace functions adapted from set by Marcel Koelewijn # proc gen_log:init {} { global cvscfg global cvsglb global tcl_platform toplevel .trace wm protocol .trace WM_DELETE_WINDOW { .trace.close invoke } if {[info exists cvscfg(tracgeom)]} { wm geometry .trace $cvscfg(tracgeom) } # Define the colors right away set logcolor(C) navy set logcolor(E) maroon set logcolor(S) darkgreen set logcolor(T) goldenrod4 set logcolor(D) red set logcolor(F) black # White background so the colored text shows up text .trace.text -setgrid yes -relief sunken -borderwidth 2 \ -background white \ -insertwidth 0 -exportselection 1 \ -yscrollcommand ".trace.scroll set" ttk::scrollbar .trace.scroll -command ".trace.text yview" frame .trace.bottom button .trace.bottom.clear -text "Clear" \ -command gen_log:clear button .trace.bottom.save -text "Save to File" \ -command gen_log:save # Classic Tk color so the colored text shows up frame .trace.top -background #d9d9d9 # Old-style checkbuttons so we can control the color checkbutton .trace.top.c -text "commands (C)" \ -variable logclass(C) -onvalue "C" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(C) -command gen_log:changeclass checkbutton .trace.top.e -text "stderr (E)" \ -variable logclass(E) -onvalue "E" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(E) -command gen_log:changeclass checkbutton .trace.top.t -text "Function entry/exit (T)" \ -variable logclass(T) -onvalue "T" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(T) -command gen_log:changeclass checkbutton .trace.top.d -text "Debugging (D)" \ -variable logclass(D) -onvalue "D" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(D) -command gen_log:changeclass checkbutton .trace.top.s -text "stdout (S)" \ -variable logclass(S) -onvalue "S" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(S) -command gen_log:changeclass checkbutton .trace.top.f -text "files (F)" \ -variable logclass(F) -onvalue "F" -offvalue "" \ -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \ -foreground $logcolor(F) -command gen_log:changeclass search_textwidget_init button .trace.bottom.srchbtn -text Search \ -command "search_textwidget .trace.text" entry .trace.bottom.entry -width 20 -textvariable cvsglb(searchstr) bind .trace.bottom.entry \ "search_textwidget .trace.text" button .trace.close -text "Stop Tracing" \ -command { gen_log:quit; exit_cleanup 0 } pack .trace.top -side top -fill x foreach logtype {c e s t d f} { pack .trace.top.$logtype -side left -anchor w } pack .trace.bottom -side bottom -fill x pack .trace.scroll -side right -fill y pack .trace.text -fill both -expand 1 pack .trace.bottom.srchbtn -side left pack .trace.bottom.entry -side left pack .trace.bottom.clear -side left -expand 1 -anchor c pack .trace.bottom.save -side left pack .trace.close -in .trace.bottom -side right #.trace.text configure -background gray92 .trace.text tag configure tagC -foreground $logcolor(C) \ -selectbackground $logcolor(C) -selectforeground white .trace.text tag configure tagE -foreground $logcolor(E) \ -selectbackground $logcolor(E) -selectforeground white .trace.text tag configure tagT -foreground $logcolor(T) \ -selectbackground $logcolor(T) -selectforeground white .trace.text tag configure tagD -foreground $logcolor(D) \ -selectbackground $logcolor(D) -selectforeground white .trace.text tag configure tagS -foreground $logcolor(S) \ -selectbackground $logcolor(S) -selectforeground white .trace.text tag configure tagF -foreground $logcolor(F) \ -selectbackground $logcolor(F) -selectforeground white # Disable key presses and make a popup for mouse Copy ro_textbindings .trace.text # Focus in the text widget to activate the text bindings focus .trace.text wm title .trace "TkRev Trace" if { [tk windowingsystem] eq "x11" } { wm iconphoto .trace Trace } } proc gen_log:log { class string } { global cvscfg # check class+level first, if no logging required, skip if {$cvscfg(logging) && [string match "*\[$class\]*" $cvscfg(log_classes)]} { set callerlevel [expr {[info level] - 1}] if { $callerlevel == 0 } { # called from the toplevel set callerid "toplevel" } else { set callerid [lindex [info level $callerlevel] 0] } # Uncomment this to see the trace on stdout #puts "$class ($callerid) $string" .trace.text insert end [format "\[%s] %s\n" $callerid "$string"] tag$class set overflow [expr {[.trace.text index end] - $cvscfg(trace_savelines)}] if { $overflow > 10 } { .trace.text delete 0.0 $overflow } .trace.text yview end } } proc gen_log:quit { } { global cvscfg set cvscfg(logging) false if {[winfo exists .trace]} { set cvscfg(tracgeom) [wm geometry .trace] destroy .trace } } proc gen_log:clear { } { .trace.text delete 1.0 end } proc gen_log:save { } { global tcl_version set initialfile "tkrev_log.txt" set types {{ "Text Files" {*.txt *.log}} {"All Files" {*}} } set savfile [ \ tk_getSaveFile -title "Save Trace" \ -filetypes $types \ -initialfile $initialfile \ -parent .trace ] if {$savfile == ""} { return } if {[catch {set fo [open $savfile w]}]} { puts "Cannot open $savfile for writing" return } if {$tcl_version >= 9.0} {chan configure $fo -profile tcl8} puts $fo [.trace.text get 1.0 end] close $fo } proc gen_log:changeclass { } { global cvscfg global logclass set cvscfg(log_classes) "" foreach c [array names logclass] { append cvscfg(log_classes) $logclass($c) } } # This is for the startup messages that detect desktop colors proc gen_log:color {array} { foreach line $array { set callerid "startup" if { [string match {CoLoR_*} $line] } { # color detected regsub {^CoLoR_} $line {} line set colorstr [lindex $line end] if {[string length $colorstr] < 3} { continue } set linebegin [lrange $line 0 end-1] catch {.trace.text tag configure tag$colorstr -background $colorstr} .trace.text tag configure tag$colorstr -foreground [colors:contrast $colorstr] .trace.text insert end [format "\[%s] %s" $callerid "$linebegin"] tagF .trace.text insert end " $colorstr\n" tag$colorstr } elseif { [string match {FoNt_*} $line] } { regsub {^FoNt_} $line {} line # font detected set ourlabel [lindex $line 0] set lineremainder [lrange $line 1 end] set fonttype $lineremainder set ret [catch {set actualfont [font actual $fonttype -displayof .trace.text]} out] if {$ret} { .trace.text insert end "$line\n" tagF gen_log:log E "$out" continue } .trace.text tag configure tag$ourlabel -font "$actualfont" \ -background white -foreground black .trace.text insert end "\[$callerid\] $ourlabel $fonttype" tagF .trace.text insert end " ($actualfont)\n" tag$ourlabel } else { # nothing special about this line .trace.text insert end [format "\[%s] %s" $callerid "$line\n"] tagF } } } tkrev_9.6.1/tkrev/joincanvas.tcl0000664000175000017500000006600315015446517017263 0ustar dorothyrdorothyr# # Tcl Library for TkRev # namespace eval joincanvas { variable instance 0 proc new {localfile filelog {current_tagname {}}} { variable instance set my_idx $instance incr instance # # Creates a new log canvas. filelog must be the output of a cvs # log or rlog command. # namespace eval $my_idx { set my_idx [uplevel {concat $my_idx}] set filelog [uplevel {concat $filelog}] variable localfile [uplevel {concat $localfile}] variable current_tagname [uplevel {concat $current_tagname}] upvar ::cvscfg cvscfg upvar ::colorglb colorglb global cvs global tcl_platform # Height and width to draw boxes variable cvscanv set cvscanv(boxx) 60 set cvscanv(boxy) 20 set cvscanv(midx) [expr {$cvscanv(boxx) / 2}] set cvscanv(midy) [expr {$cvscanv(boxy) / 2}] set cvscanv(boxmin) 64 # Gaps between boxes set cvscanv(space) [expr {$cvscanv(boxy) + 16}] # Indent at top left of canvas set cvscanv(indx) 5 set cvscanv(indy) 5 # Static type variables used while drawing on the canvas. set cvscanv(xhigh) 0 set cvscanv(yhigh) 0 set cvscanv(xlow) 0 set cvscanv(ylow) 0 variable revlist variable revbranches variable tags variable headrev variable joincanvas set joincanvas ".joincanvas$my_idx" proc parse_cvslog_tags {filelog} { global cvsglb variable joincanvas variable tags variable headrev gen_log:log T "ENTER ($joincanvas ...)" set loglist [split $filelog "\n"] set logstate "rcsfile" foreach logline $loglist { #puts "$logline" switch -exact -- $logstate { "rcsfile" { # Look for the first text line which should give the file name. set fileline [split $logline] if {[lindex $fileline 0] == "RCS"} { set logstate "head" continue } } "head" { set fileline [split $logline] if {[lindex $fileline 0] == "head:"} { set headrev [lindex $fileline 1] set logstate "tags" set taglist "" continue } } "tags" { # Any line with a tab leader is a tag if { [string index $logline 0] == "\t" } { set taglist "$taglist$logline\n" set tagitems [split $logline ":"] set tagrevision [string trim [lindex $tagitems 1]] set tagname [string trim [lindex $tagitems 0]] # Add all the tags to a picklist for our "since" tag lappend cvsglb(alltags) $tagname set parts [split $tagrevision {.}] if {[expr {[llength $parts] & 1}] == 1} { set parts [linsert $parts end-1 {0}] set tagrevision [join $parts {.}] } # But we only want to know the branch tags if { [regexp {\.0\.\d+$} $tagrevision] } { set tagstring [string trim [lindex $tagitems 0]] lappend tags($tagrevision) $tagstring } } else { if {$logline == "description:"} { # No more tags after this point set logstate "searching" continue } if {$logline == "----------------------------"} { # Oops, missed something. set logstate "revision" continue } } } "terminated" { # ignore any further lines continue } } } gen_log:log D "alltags: $cvsglb(alltags)" } proc node {joincanvas rev x y} { global colorglb variable cvscanv variable tags upvar treelist treelist upvar ylevel ylevel upvar ind ind gen_log:log T "ENTER ($rev $x $y)" $joincanvas.canvas create line \ $x [expr {$y + $cvscanv(boxy)}] \ $x [expr {$y + $cvscanv(space)}] \ -fill $colorglb(canvfg) gen_log:log T "LEAVE" } proc rectangle {joincanvas rev x y} { # # Breaks out some of the code from the joincanvas_draw_box procedure. # Work out the width of the text to go in the box first, then draw a # box wide enough. # variable cvscanv variable tags variable current_tagname upvar x xpos gen_log:log T "ENTER ($rev $x $y)" set parts [split $rev "."] set tagtext $tags($rev) gen_log:log D "$tagtext\t$rev" $joincanvas.canvas create text \ [expr {$x + 4}] [expr {$y + 2}] \ -text "$tagtext" \ -anchor nw -fill blue \ -font {Helvetica -12 bold} \ -tags b$rev set tagwidth [font measure {Helvetica -12 bold} \ -displayof $joincanvas.canvas $tagtext] if {$tagwidth < $cvscanv(boxmin)} { set tagwidth $cvscanv(boxmin) } # draw the box set boxid [$joincanvas.canvas create rectangle \ $x $y \ [expr {$x + $tagwidth + 5}] [expr {$y + $cvscanv(boxy)}] \ -width 3 \ -fill gray90 -outline black \ -tags [list b$rev rect$rev] \ ] # Drop the fill color below the text so the text isn't hidden $joincanvas.canvas lower $boxid # Bind button-presses to the rectangles. if {$tags($rev) != ""} { $joincanvas.canvas bind b$rev \ [namespace code "select_rectangle $rev $tags($rev)"] } if {"$current_tagname" == "$tagtext"} { you_are_here $rev $tagwidth $x $y } gen_log:log T "LEAVE" } proc unselect_all {} { variable joincanvas set t [$joincanvas.canvas gettags current] if {$t != {} } {return} unselect_rectangle } proc unselect_rectangle {} { variable joincanvas catch {$joincanvas.canvas itemconfigure SelA -fill gray90} $joincanvas.up.rversFrom delete 0 end $joincanvas.canvas dtag SelA } proc select_rectangle {rev tags} { global cvscfg variable joincanvas gen_log:log T "ENTER ($rev $tags)" unselect_rectangle $joincanvas.up.rversFrom delete 0 end $joincanvas.up.rversFrom insert end $tags $joincanvas.canvas addtag SelA withtag rect$rev $joincanvas.canvas itemconfigure SelA -fill $cvscfg(colourA) } # combobox values have to be assigned by a proc in namespace code proc fill_tags_list {cbox} { global cvsglb $cbox configure -values $cvsglb(alltags) } proc fillcanvas {filename filelog} { global colorglb global cvscfg variable joincanvas variable cvscanv variable headrev variable tags variable current_tagname gen_log:log T "ENTER ($filename )" catch {unset tags} # Collect the history from the RCS log $joincanvas.canvas delete all parse_cvslog_tags $filelog # Sort the branch revisions set tagrevlist [lsort -dictionary [array names tags]] # Get rid of duplicates set revlist "" foreach t $tagrevlist { if {$t ni $revlist} { lappend revlist $t } } # Find everybody's parents. Add parent nodes to a new nodelist. # Keep track of everybody's children set treelist "" foreach rev $revlist { gen_log:log D "$rev" # Find its parent set alist [split $rev "."] set alength [llength $alist] set isodd [expr {$alength % 2}] set parent($rev) [join [lrange $alist 0 [expr {$alength - 3}]] "."] #gen_log:log D " parent $parent($rev)" set parentbranch [join [lrange $alist 0 [expr {$alength - 5}]] "."] #gen_log:log D " parentbrancch $parentbranch" set branchnum [lindex $alist [expr {$alength - 4}]] set branchparent [join [list $parentbranch 0 $branchnum] "."] #gen_log:log D " branchparent $branchparent" if {$isodd > 0} { set parent($rev) [join [lrange $alist 0 [expr {$alength - 2}]] "."] #gen_log:log D " parent $parent($rev)" } if {[string length $parentbranch] > 0} { gen_log:log D "set parent parent($rev)" set parent($rev) $branchparent lappend children($branchparent) $rev } else { lappend children($parent($rev)) $rev } # Add to new list of nodes if { ($parent($rev) ni $revlist) && ($parent($rev) ni $treelist) } { lappend treelist $parent($rev) gen_log:log D " add parent $parent($rev) of $rev" } } # Do it all over again for the new ones we added foreach rev $treelist { gen_log:log D "new $rev" # Find its parent set alist [split $rev "."] set alength [llength $alist] set isodd [expr {$alength % 2}] set parent($rev) [join [lrange $alist 0 [expr {$alength - 3}]] "."] #gen_log:log D " parent $parent($rev)" set parentbranch [join [lrange $alist 0 [expr {$alength - 5}]] "."] #gen_log:log D " parentbrancch $parentbranch" set branchnum [lindex $alist [expr {$alength - 4}]] set branchparent [join [list $parentbranch 0 $branchnum] "."] #gen_log:log D " branchparent $branchparent" if {$isodd > 0} { set parent($rev) [join [lrange $alist 0 [expr {$alength - 2}]] "."] #gen_log:log D " parent $parent($rev)" } if {[string length $parentbranch] > 0} { gen_log:log D "set parent parent($rev)" set parent($rev) $branchparent lappend children($branchparent) $rev } else { lappend children($parent($rev)) $rev } } set treelist [concat $revlist $treelist] set treelist [lsort -dictionary $treelist] # Now prepare to draw the revision tree # Root first set y $cvscanv(space) set px(0) 10 set x [font measure {Helvetica -12 bold} \ -displayof $joincanvas.canvas $cvscfg(mergetrunkname)] set px(1) [expr {$px(0) + $x / 2}] set py(1) [expr {$cvscanv(boxy) - 4}] $joincanvas.canvas create text \ $px(1) $y \ -text "ROOT" \ -anchor n -fill $colorglb(canvfg) \ -font {Helvetica -12 bold} # Then the rest foreach rev $treelist { gen_log:log D "$rev" if {[info exists children($rev)]} { foreach r $children($rev) { gen_log:log D "\tparent of $r" } set nchildren($rev) [llength $children($rev)] set kids [array names children $rev.*] foreach kid $kids { set descendents $children($kid) set ndescendents [llength $descendents] gen_log:log D "\tgranchildren: $descendents" incr nchildren($rev) $ndescendents } } else { set nchildren($rev) 0 } gen_log:log D "\t$nchildren($rev) descendents" if {[info exists parent($rev)]} { gen_log:log D "\tchild of $parent($rev)" } set alist [split $rev "."] set alength [llength $alist] # Round up instead of down set ind [expr {($alength +1)/ 2}] set pind [expr {$ind - 1}] if {! [info exists py($ind)]} { gen_log:log D " starting new column $ind" set py($ind) $cvscanv(space) set px($ind) [expr {$px($pind) + $cvscanv(midx) + $cvscanv(space)}] } if {[info exists parent($rev)] && $parent($rev) != ""} { gen_log:log D " this one has a parent in col >=1" if {[info exists ylevel($parent($rev))] && $py($ind) > $ylevel($parent($rev))} { gen_log:log D " jumping to level of parent" set py($ind) $ylevel($parent($rev)) if {$ind > 2} { # Give it a node if its parent isn't in column1 incr ylevel($parent($rev)) -$cvscanv(space) set px($ind) [expr {$px($pind) + $cvscanv(boxx) + $cvscanv(space)}] set py($ind) $ylevel($parent($rev)) node $joincanvas $rev \ [expr {$px($pind) + $cvscanv(midx)}] \ [expr {$py($ind) - 1}] } } else { gen_log:log D " parent not higher" set py($ind) [expr {$py($ind) - $cvscanv(space)}] } set xlevel($rev) [expr {$px($ind) + $cvscanv(midx)}] } else { set py($ind) [expr {$py($ind) - $cvscanv(space)}] gen_log:log D " just stacking it above the last one" set xlevel($rev) $px($ind) } set ylevel($rev) $py($ind) # For column 1, just draw a nondescript node if {$ind == 1} { #node $joincanvas $rev $px($ind) $py($ind) set py($ind) [expr {$py($ind) - ($nchildren($rev) - 1) * $cvscanv(space)}] } else { if {! [info exists tags($rev)]} { set tags($rev) "" } gen_log:log D " tag: $tags($rev)" rectangle $joincanvas $rev $px($ind) $py($ind) # Line linking it to parent if {$ind > 2} { set ly [expr {$ylevel($parent($rev)) + $cvscanv(midy)}] } else { set ly [expr {$py($ind) + $cvscanv(midy)}] } if {![info exists xlevel($parent($rev))]} {set xlevel($parent($rev)) $px([expr $ind-1])} $joincanvas.canvas create line \ $xlevel($parent($rev)) [expr {$ly + 10}] \ [expr {$xlevel($parent($rev)) + 10}] $ly \ $px($ind) [expr {$py($ind) + $cvscanv(midy)}] \ -fill $colorglb(canvfg) set py($ind) [expr {$py($ind) - $nchildren($rev) * $cvscanv(space)}] } } set py(1) [expr {$cvscanv(boxy) - 4}] set maxyind 0 foreach i [array names py] { if {$py($i) < $maxyind} { set maxyind $py($i) } } set tags($headrev) $cvscfg(mergetrunkname) gen_log:log D "HEAD $headrev" gen_log:log D "tagtext \"$tags($headrev)\"" # Make a box for top of trunk set ylevel(trunk) [expr {$maxyind - $cvscanv(boxy)}] set tagwidth [font measure {Helvetica -12 bold} \ -displayof $joincanvas.canvas $cvscfg(mergetrunkname)] if {$tagwidth < $cvscanv(boxmin)} { set tagwidth $cvscanv(boxmin) } set boxid [$joincanvas.canvas create rectangle \ [expr {$px(1) - $tagwidth / 2}] $ylevel(trunk) \ [expr {$px(1) + 5 + $tagwidth / 2}] \ [expr {$ylevel(trunk) - $cvscanv(boxy)}] \ -width 3 \ -fill gray90 -outline black \ -tags b$headrev] $joincanvas.canvas lower $boxid $joincanvas.canvas create text \ [expr {$px(1) + 2}] [expr {$ylevel(trunk) - 2}] \ -text "$cvscfg(mergetrunkname)" \ -anchor s -justify center -fill blue \ -font {Helvetica -12 bold} \ -tags b$headrev # Bottom then top $joincanvas.canvas create line \ $px(1) [expr {$cvscanv(space) - 4}] \ $px(1) $ylevel(trunk) \ -fill $colorglb(canvfg) # Bind button-press $joincanvas.canvas bind b$headrev \ [namespace code "select_rectangle $headrev $cvscfg(mergetrunkname)"] # Clicking in a blank part of the canvas unselects boxes bind $joincanvas.canvas \ [namespace code unselect_all] # You are Here if {$current_tagname == "trunk"} { you_are_here $headrev $tagwidth \ [expr {$px(1) - $tagwidth / 2 }] \ [expr {$ylevel(trunk) - $cvscanv(boxy)}] } # now calculate the bounding box using the canvas bbox function set bbox [$joincanvas.canvas bbox all] set boty [lindex $bbox 1] set topy [lindex $bbox 3] set bheight [expr {$topy - $boty}] set origheight [lindex [$joincanvas.canvas config -height] 4] set screenHeight [winfo vrootheight .] if {$bheight > $screenHeight} { set bheight $screenHeight } if {$bheight > $origheight} { $joincanvas.canvas config -height $bheight } $joincanvas.canvas config -scrollregion $bbox $joincanvas.canvas yview moveto 0 set here [$joincanvas.up.rversTo get] if {$here == ""} { cvsfail "I can't find where I am. Perhaps the working directory isn't at the head of a branch?" $joincanvas } gen_log:log T "LEAVE" } proc you_are_here {rev offset hx hy} { variable cvscanv variable joincanvas variable tags gen_log:log T "ENTER ($rev $offset $hx $hy)" gen_log:log D "tags($rev) $tags($rev)" $joincanvas.canvas create image \ [expr {$hx + $offset + 16}] [expr {$hy + $cvscanv(boxy)}] \ -image Man -anchor s \ -tag you_are_here_icon $joincanvas.canvas create text \ [expr {$hx + $offset + 26}] [expr {$hy + $cvscanv(boxy)}] \ -text "You are\nhere" -anchor sw \ -fill red3 \ -font {Helvetica -10 bold} \ -tag you_are_here_icon # Put the name in the "To" entry and disable it. You can only # merge to where you are. $joincanvas.up.rversTo configure -state normal $joincanvas.up.rversTo delete 0 end $joincanvas.up.rversTo insert end $tags($rev) $joincanvas.up.rversTo configure -state readonly $joincanvas.canvas bind b$rev {} } toplevel $joincanvas wm title $joincanvas "CVS Directory Merge" if { [tk windowingsystem] eq "x11" } { wm iconphoto $joincanvas Merge } wm protocol $joincanvas WM_DELETE_WINDOW \ [namespace code {$joincanvas.close invoke}] $joincanvas configure -menu $joincanvas.menubar menu $joincanvas.menubar -background $colorglb(menubg) -foreground $colorglb(menufg) $joincanvas.menubar add cascade -label "File" \ -menu $joincanvas.menubar.file -underline 0 menu $joincanvas.menubar.file -background $colorglb(menubg) -foreground $colorglb(menufg) $joincanvas.menubar.file add command -label "Close" -underline 0 \ -command [namespace code {$joincanvas.close invoke}] $joincanvas.menubar.file add command -label "Exit" -underline 1 \ -command { exit_cleanup 1 } help_menu $joincanvas frame $joincanvas.up -relief groove -borderwidth 2 pack $joincanvas.up -side top -fill x button $joincanvas.up.bworkdir -image Workdir \ -command { workdir_setup } button $joincanvas.up.bmodbrowse -image Modules_cvs \ -command modbrowse_run label $joincanvas.up.lfname -text "Representative File" -anchor w entry $joincanvas.up.rfname -textvariable [namespace current]::repfile bind $joincanvas.up.rfname \ [namespace code {join_getlog $repfile [namespace current]}] label $joincanvas.up.lversFrom -text "Merge From" -anchor w frame $joincanvas.up.eFrom -bg $cvscfg(colourA) entry $joincanvas.up.rversFrom label $joincanvas.up.lversSince -text " Since" -anchor w frame $joincanvas.up.eSince -bg $cvscfg(colourB) set tagname "" # combobox values have to be assigned by a proc in namespace code ttk::combobox $joincanvas.up.rversSince -textvariable tagname -values [list] \ -postcommand [namespace code {fill_tags_list $joincanvas.up.rversSince}] label $joincanvas.up.lversTo -text "Merge To" -anchor w entry $joincanvas.up.rversTo -relief groove \ -bd 1 -relief sunk -state readonly -readonlybackground $colorglb(bg) grid columnconf $joincanvas.up 1 -weight 1 grid rowconf $joincanvas.up 3 -weight 1 grid $joincanvas.up.lfname -column 0 -row 0 -sticky w grid $joincanvas.up.rfname -column 1 -row 0 -padx 3 -sticky ew grid $joincanvas.up.bworkdir -column 2 -row 0 -rowspan 2 \ -sticky e -padx 2 -pady 1 grid $joincanvas.up.lversFrom -column 0 -row 1 -sticky w grid $joincanvas.up.eFrom -column 1 -row 1 -sticky ew -padx 4 grid $joincanvas.up.bmodbrowse -column 2 -row 2 -rowspan 2 \ -sticky e -padx 2 -pady 1 grid $joincanvas.up.lversSince -column 0 -row 2 -sticky w grid $joincanvas.up.eSince -column 1 -row 2 -sticky ew -padx 4 grid $joincanvas.up.lversTo -column 0 -row 3 -sticky w grid $joincanvas.up.rversTo -column 1 -row 3 -padx 3 -sticky ew pack $joincanvas.up.rversFrom -in $joincanvas.up.eFrom \ -padx 2 -pady 2 -fill x pack $joincanvas.up.rversSince -in $joincanvas.up.eSince \ -padx 2 -pady 2 -fill x set textfont [$joincanvas.up.rfname cget -font] # Pack the bottom before the middle so it doesnt disappear if # the window is resized smaller frame $joincanvas.down -relief groove -borderwidth 2 pack $joincanvas.down -side bottom -fill x set repfile $localfile # The canvas for the big picture canvas $joincanvas.canvas -relief sunken -borderwidth 2 \ -background $colorglb(canvbg) \ -yscrollcommand "$joincanvas.yscroll set" \ -xscrollcommand "$joincanvas.xscroll set" ttk::scrollbar $joincanvas.xscroll -orient horizontal \ -command "$joincanvas.canvas xview" ttk::scrollbar $joincanvas.yscroll -command "$joincanvas.canvas yview" # # Create buttons # button $joincanvas.delta -image Mergediff \ -command [namespace code { set fromrev [$joincanvas.up.rversFrom get] if {$fromrev == ""} { cvsfail "Please select a branch!" $joincanvas; return } set sincerev [$joincanvas.up.rversSince get] cvs_merge $joincanvas $fromrev $sincerev $fromrev . }] button $joincanvas.down.blogfile -image Branches \ -command "cvs_branches $repfile" frame $joincanvas.down.btnfm frame $joincanvas.down.closefm button $joincanvas.close -text "Close" \ -command [namespace code " destroy $joincanvas namespace delete [namespace current] exit_cleanup 0 "] pack $joincanvas.down.blogfile -side left \ -ipadx 4 -ipady 4 pack $joincanvas.down.btnfm -side left -fill y -expand 1 pack $joincanvas.delta \ -in $joincanvas.down.btnfm -side left \ -ipadx 4 -ipady 4 pack $joincanvas.down.closefm -side right -expand yes pack $joincanvas.close \ -in $joincanvas.down.closefm -side right \ -fill both -expand yes set_tooltips $joincanvas.down.blogfile \ {"Revision Log and Branch Diagram of the current file"} set_tooltips $joincanvas.delta \ {"Merge to current"} set_tooltips $joincanvas.up.bworkdir \ {"Open the Working Directory Browser"} set_tooltips $joincanvas.up.bmodbrowse \ {"Open the Repository Browser"} # # Put the canvas on to the display. # pack $joincanvas.xscroll -side bottom -fill x -padx 1 -pady 1 pack $joincanvas.yscroll -side right -fill y -padx 1 -pady 1 pack $joincanvas.canvas -fill both -expand 1 $joincanvas.canvas delete all # # Window manager stuff. # wm minsize $joincanvas 1 1 scrollbindings $joincanvas.canvas focus $joincanvas.canvas fillcanvas $localfile $filelog return [namespace current] } } } proc cvs_joincanvas { } { # Find the bushiest file in the directory and diagram it global cvs global incvs global cvscfg global current_tagname gen_log:log T "ENTER" if {! $incvs} { cvs_notincvs return 1 } set files [glob -nocomplain -types f -- .??* *] regsub -all {\$} $files {\$} files set commandline "$cvs -d $cvscfg(cvsroot) log $files" gen_log:log C "$commandline" catch {exec {*}$commandline} raw_log set log_lines [split $raw_log "\n"] gen_log:log D "Directory tag: $current_tagname" foreach logline $log_lines { if {[string match "Working file:*" $logline]} { set filename [lrange [split $logline] 2 end] set nbranches($filename) 0 continue } if {[string match "total revisions:*" $logline]} { set nrevs($filename) [lindex [split $logline] end] continue } if { [regexp {^\t[-\w]+: .*\.0\.\d+$} $logline] } { incr nbranches($filename) } } set bushiestfile "" set mostrevisedfile "" set nbrmax 0 foreach br [array names nbranches] { if {$nbranches($br) > $nbrmax} { set bushiestfile $br set nbrmax $nbranches($br) } } set nrevmax 0 foreach br [array names nrevs] { if {$nrevs($br) > $nrevmax} { set mostrevisedfile $br set nrevmax $nrevs($br) } } gen_log:log F "Bushiest file \"$bushiestfile\" has $nbrmax branches" gen_log:log F "Most Revised file \"$mostrevisedfile\" has $nrevmax revisions" # Sometimes we don't find a file with any branches at all, so bushiest # is empty. Fall back to mostrevised. All files have at least one rev. if {[string length $bushiestfile] > 0} { join_getlog $bushiestfile } else { join_getlog $mostrevisedfile } gen_log:log T "LEAVE" } # Get the file log. Make a new canvas or re-draw an existing one. proc join_getlog {filename {name_idx {}}} { global cvscfg global cvs global current_tagname gen_log:log T "ENTER ($filename $name_idx)" set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] # If you bail, sometimes you discard a perfectly good log #if {$ret} { #cvsfail $view_this #gen_log:log T "LEAVE ERROR ($view_this)" #return #} if {$name_idx == ""} { joincanvas::new $filename $view_this $current_tagname } else { $name_idx\::fillcanvas $filename $view_this } gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/vendor_merge.tcl0000664000175000017500000004040215015446517017577 0ustar dorothyrdorothyr # Tcl Library for TkRev # # Modifications by Eugene Lee 10/16/03 # 1. .merge window made more robust so user cannot key in incorrect data. # 2. Name of Vendor Module is selectable by user (no longer hardcoded to Vendor). # proc vendor_wait no longer used # 3. Added proc vendorDialog proc merge_run {mcode} { # By: Eugene Lee, Aerospace Corporation, 11/12/95 # Modified by E. Lee 10/16/03 global cvs global modbrowse_module global from_to global sel_to global cwd global module_dir global merge gen_log:log T "ENTER ($mcode)" if {$mcode == ""} { cvsfail "Please select a module!" .modbrowse gen_log:log T "LEAVE" return } if {[winfo exists .merge]} { .merge.right.tcwd configure -textvariable cwd .merge.right.tmodule configure -textvariable modbrowse_module wm deiconify .merge raise .merge #grab set .merge gen_log:log T "LEAVE" return } toplevel .merge #grab set .merge frame .merge.left frame .merge.right frame .merge.vendor -relief groove -borderwidth 2 frame .merge.down -relief groove -borderwidth 2 pack .merge.down -side bottom -fill x -expand yes pack .merge.vendor -side bottom -fill x -expand yes pack .merge.left -side left pack .merge.right -side right -fill x -expand yes label .merge.left.lcwd -text "Current Directory" -width 16 -anchor w label .merge.left.lmodule -text "Module" -width 16 -anchor w label .merge.right.tcwd -textvariable cwd -relief sunken -width 40 -anchor w label .merge.right.tmodule -textvariable modbrowse_module -relief sunken -width 40 -anchor w pack .merge.left.lcwd -side top -fill x -pady 3 pack .merge.left.lmodule -side top -fill x pack .merge.right.tcwd -side top -fill x -pady 3 pack .merge.right.tmodule -side top -fill x frame .merge.vendor.name pack .merge.vendor.name -side top -fill x -expand yes label .merge.vendor.name.l -text "Vendor Module" -width 16 -anchor w label .merge.vendor.name.e -relief sunken -textvariable venselect_mcode -anchor w button .merge.vendor.name.b -text "Browse ..." \ -command "vendorDialog" pack .merge.vendor.name.l -side left -fill x -pady 3 pack .merge.vendor.name.b -side right -anchor w -fill x pack .merge.vendor.name.e -side right -anchor w -fill x -pady 3 -expand yes #.merge.vendor.name.e config -state disabled bind .merge.vendor.name.e { put_rev_tags $venselect_mcode } frame .merge.vendor.l frame .merge.vendor.r pack .merge.vendor.l .merge.vendor.r -side left foreach i {l r} { if { $i == "l" } { set x "From" } else { set x "To" } label .merge.vendor.$i.rev -text "$x Revision Tags" pack .merge.vendor.$i.rev -side top frame .merge.vendor.$i.scroll eval {listbox .merge.vendor.$i.scroll.list \ -yscrollcommand [list .merge.vendor.$i.scroll.sy set] \ -xscrollcommand [list .merge.vendor.$i.scroll.sx set]} \ -relief sunken -width 40 -height 8 ttk::scrollbar .merge.vendor.$i.scroll.sx -orient horizontal \ -command [list .merge.vendor.$i.scroll.list xview] ttk::scrollbar .merge.vendor.$i.scroll.sy -orient vertical \ -command [list .merge.vendor.$i.scroll.list yview] pack .merge.vendor.$i.scroll.sx -side bottom -fill x pack .merge.vendor.$i.scroll.sy -side right -fill y pack .merge.vendor.$i.scroll.list -side left -fill both -expand true pack .merge.vendor.$i.scroll -side top frame .merge.vendor.$i.f pack .merge.vendor.$i.f -side bottom label .merge.vendor.$i.f.l -text $x if { $i == "l" } { label .merge.vendor.$i.f.s \ -textvariable merge(from) -relief sunken -width 15 } else { label .merge.vendor.$i.f.s \ -textvariable merge(to) -relief sunken -width 15 } pack .merge.vendor.$i.f.l -side left -padx 3 -pady 3 pack .merge.vendor.$i.f.s -side left -pady 3 } button .merge.ok -text "OK" \ -command { if { $venselect_mcode == "" } { cvsfail "Please select a Vendor" .merge return } catch do_merge results if { $results == "err" } { return } grab release .merge wm withdraw .merge } button .merge.quit -text "Cancel" \ -command { grab release .merge wm withdraw .merge } pack .merge.ok .merge.quit -in .merge.down -side left \ -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both bind .merge.vendor.l.scroll.list <> { get_j .merge.vendor.l.scroll.list left } bind .merge.vendor.r.scroll.list <> { get_j .merge.vendor.r.scroll.list right } # Needed for slower framebuffers #tkwait visibility .merge wm title .merge "Module Level Merge With Vendor Code" wm minsize .merge 30 10 gen_log:log T "LEAVE" } proc get_j { list side} { # Written by Eugene A. Lee, Aerospace Corp., 12/20/94 global merge gen_log:log T "ENTER ($list $side)" gen_log:log D "[$list curselection]" if {[string compare [$list curselection] ""] == 0} return set Sel [$list get [$list curselection]] if {$side == "left"} { set merge(from) [lindex [split $Sel] 0] } else { set merge(to) [lindex [split $Sel] 0] } gen_log:log T "LEAVE" } proc put_rev_tags {code} { # Written by Eugene A. Lee, Aerospace Corp., 11/12/95 # Called by button .venselect.ok in venget.tcl # Made usable for remote repositories by MK # # Go to the tmpdir aka cvs.tcl # Retrieve the whole friggin stuff into the directory (update from head) # Get the tags for all the files by calling put_rv_tags # Parse that result # global cvscfg global merge global venselect_mcode global cwd global cvs global filenames set tmpwdir [pwd] gen_log:log T "ENTER" .merge.vendor.l.scroll.list delete 0 end .merge.vendor.r.scroll.list delete 0 end set ret [cvs_sandbox_runcmd \ "$cvs -d $cvscfg(cvsroot) checkout $venselect_mcode" cmd_output] if {$ret == $cwd} { cd $cwd gen_log:log T "leave -- failed cvs checkout statement" return } cd $venselect_mcode gen_log:log F "CD [pwd]" set view_lines [split $cmd_output "\n"] foreach line $view_lines { gen_log:log D "Evaluating line $line" if {[string match "U *" $line]} { set dname [lindex [split $line] 1] regsub "$venselect_mcode/" $dname "" fname if {[info exists filenames($venselect_mcode)]} { lappend filenames($venselect_mcode) $fname } else { set filenames($venselect_mcode) $fname } } } gen_log:log F "filenames($venselect_mcode) existence:[info exists filenames($venselect_mcode)]" # get the module into the source if {[info exists filenames($venselect_mcode)]} { get_rv_tags $venselect_mcode r_tag_list v_tag_list } cd $tmpwdir if { [info exists r_tag_list] == 0 } { foreach i {l r} { .merge.vendor.$i.scroll.list insert end "No revision tags found" } } else { for {set i 0} {$i < [llength $r_tag_list]} {incr i} { set tmp [lindex $r_tag_list $i] .merge.vendor.l.scroll.list insert end $tmp .merge.vendor.r.scroll.list insert end $tmp } } cd $cwd gen_log:log T "LEAVE" } proc do_merge {} { global merge global cvscfg global cvs global venselect_mcode global modbrowse_module gen_log:log T "ENTER" set merge(3rd_party) $venselect_mcode if { $merge(3rd_party) == "" } { cvsfail "Vendor Module not specified" .merge return err } if { $merge(from) == "" || $merge(to) == "" } { cvsfail "not all entries filled" .merge return err } # In order to merge difference between tags of 3rd_party into $modbrowse_module # the directory where the merge is to be done later must be in the checkout # directory of $modbrowse_module. If the user just checked out the # $modbrowse_module and invoked the merge command, the current directory at this # point in the script is most likely one above directory $modbrowse_module. # Check for this and save the directory where the merge operation is to be done # later. if { [file tail [pwd]] == $modbrowse_module } { set dir4merge [pwd] } else { set tmpdir [glob -nocomplain $modbrowse_module] if { $tmpdir == "" } { cvsfail "You must invoke the merge command from the checked out directory of $modbrowse_module or one above it" .merge return } set dir4merge [file join [pwd] $tmpdir] } set mess "This will merge differences between $merge(from) and" append mess " $merge(to) of $merge(3rd_party) into $modbrowse_module" append mess "\n\n Are you sure?" if {[cvsconfirm $mess .merge] == 1} { return } # The CVS directory in the checked out $modbrowse_module are associated with # $modbrowse_module. Since we are going to merge in differences between # $merge(from) & $merge(to) of $merge(3rd_party), the CVS directory to be used # later in directory $dir4merge needs to from directory $merge(3rd_party). # Do that next and save it into a temp directory mktemp_dir set mktemp "$cvscfg(tmpdir)/merge[pid]" set mktemp_dir $mktemp.dir set v [viewer::new "Vendor Merge"] $v\::log "CVS Checkout of temp sandbox for $merge(3rd_party)\n" set co_cmd "$cvs checkout -d $mktemp_dir -r$merge(from) $merge(3rd_party)" $v\::do "$co_cmd" $v\::wait update # CVS directory in $mktemp_dir will be copied later cd $dir4merge gen_log:log F "CD [pwd]" # Save CVS directory of $modbrowse_module which is to be restored after # the merge command has been completed. Save it to $mktemp_dir set sav_dir [file join $mktemp_dir CVS_save] gen_log:log F "COPY CVS $sav_dir" file copy CVS $sav_dir gen_log:log F "DELETE CVS" file delete -force CVS; # Need -force for a directory # Then copy the CVS file from $mktemp_dir set sav_cvs [file join $mktemp_dir CVS] gen_log:log F "COPY $sav_cvs CVS" file copy -force $sav_cvs CVS $v\::log "\nCVS Merge of $merge(3rd_party) into $modbrowse_module\n" set co_cmd "$cvs checkout -d [pwd] -j$merge(from) -j$merge(to) $merge(3rd_party)" $v\::do "$co_cmd" $v\::wait $v\::log "\nCVS rdiff from $merge(from) to $merge(to) for $merge(3rd_party)\n" set co_cmd "$cvs rdiff -s -r$merge(from) -r$merge(to) $merge(3rd_party)" $v\::do "$co_cmd" $v\::wait update # Restore CVS directory associated with #modbrowse_module gen_log:log F "DELETE CVS" file delete -force CVS file copy $sav_dir CVS gen_log:log F "COPY $sav_dir CVS" # Remove the temp directory gen_log:log F "DELETE $mktemp_dir" file delete -force $mktemp_dir gen_log:log T "LEAVE" } proc unpack_tag_word { tag_word type tag_message} { upvar $type typ $tag_message tag_m # # Unpacks vendor and release tag information obtained from an RCS ,v file. # In an RCS ,v file, between the keywords "symbols" and "locks" keywords, # there are packed words with the following format: # # tag_info:tag_ident # # where: tag_info is either the vendortag or releasetag which was entered # when a cvs checkin or import command was invoked. # tag_ident is of the form: # x.y.z for a vendor tag (3 subfields or 2 dots) # x.y, x.y.z.w, or x.y.z.w.u.v for a release tag # # Called by: # # input: tag_word - word from a RCS ,v file between the "symbols" and "locks" # keywords # output: type - 0 if tag_word contains packed info on a release tag # 1 if tag_word contains packed info on a vendor tag # output: tag_message - a vendortag or releasetag as entered when a cvs # checkin or import command was invoked # # By: Eugene A. Lee, Aerospace Corporation # Date: Sept 15, 1995 # gen_log:log T "ENTER ($tag_word $type $tag_message)" set fields [split $tag_word :] set tag_m [string trimleft [lindex $fields 0]] set tag_num [string trimleft [lindex $fields 1]] # strip off any trailing ; character regsub {;$} $tag_num "" tag_num if { [llength [split $tag_num . ]] == 3 } { set typ 1; # release tag } else { set typ 0; # vendor tag } gen_log:log T "LEAVE" } proc get_rv_tags { mcode r_tag_list v_tag_list } { global filenames upvar $v_tag_list vtag_list upvar $r_tag_list rtag_list # # From the original code of E.A. Lee # Rewrite by M.R. Koelewijn, trying to make this work with a remote repository # Assumption: # The caller has created the sandbox in a local tmpdir, containing the # relevant files for this 'mcode' # The global 'filenames' has been set up to contain the names of the files # So, with merge_taglist the filenames are passed to CVS, with the request # to cough up some info. This info contains the tags (thanks, whoever did the # branch_diagram): one big list of tags. Than we sort out the uniqe ones. # # Packed releasetag word has the format: # releasetag:branch_id # where: releasetag was specified when the cvs import command was invoked. # branch_id is of the forms: x.y, x.y.z.w, x.y.z.w.u.v, etc, # (odd number or subfields) # # Packed vendortag word has the format: # vendortag:branch_id # where: vendortag was specified when the cvs import command was invoked. # branch_id is of the forms: x.y.z (3 subfields or 2 dots) # # Output: r_tag_list - sorted releasetag list for the CVS module # Output: v_tag_list - sorted vendortag list for the CVS module # # Note: v_tag_list has no planned use for tkrev yet. They are returned just # because this information was available. # gen_log:log T "ENTER ($mcode $r_tag_list $v_tag_list)" set rlist "" ;# easies way to allow lsearch to work without having to set vlist "" ;# use info exists statements foreach tag [cvs_sandbox_filetags $mcode $filenames($mcode)] { gen_log:log D "Next tag: $tag" unpack_tag_word $tag type tag_message gen_log:log D "$tag is type $type message $tag_message" if {$type == 0 } { if {$tag_message ni $rlist} { gen_log:log D "New Release tag found: $tag_message" lappend rlist $tag_message } } if {$type == 1 } { if {$tag_message ni $rlist} { gen_log:log D "New Vendor tag found: $tag_message" lappend vlist $tag_message } } } # Unsorted master releasetag and versiontag lists have been found. if { [info exists rlist] == 1 } { set rtag_list [lsort $rlist] } else { gen_log:log D "no mrlist created" } if { [info exists vlist] == 1 } { set vtag_list [lsort $vlist] } else { gen_log:log D "no mvlist created" } gen_log:log T "LEAVE" } proc merge_taglist {files} { global cvscfg global cvs gen_log:log T "ENTER ($files)" set commandline "$cvs -d $cvscfg(cvsroot) log $files" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] gen_log:log "C" "$view_this" if {$ret} { cvsfail $view_this .merge gen_log:log T "LEAVE ERROR" return $keepers } set view_lines [split $view_this "\n"] foreach line $view_lines { if {[string index $line 0] == "\t" } { regsub -all {[\t ]*} $line "" tag append keepers "$tag " } } gen_log:log T "LEAVE" return $keepers } proc vendorDialog {} { global ExModList ExModDirList global venselect_mcode set w .venDialog grab release .merge catch {destroy $w} toplevel $w wm title $w "Select A Vendor" grab set $w frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m button $w.buttons.ok -text Ok \ -command { if {$venselect_mcode == ""} { return } put_rev_tags $venselect_mcode destroy .venDialog raise .merge #grab set .merge } button $w.buttons.cancel -text Cancel \ -command { grab release .venDialog wm withdraw .venDialog } pack $w.buttons.ok -side left -expand 1 pack $w.buttons.cancel -side left -expand 1 frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview" listbox $w.frame.list -yscrollcommand "$w.frame.scroll set" -setgrid 1 -height 5 pack $w.frame.scroll -side right -fill y pack $w.frame.list -side left -expand 1 -fill both getExistModDialog set nModule [llength $ExModList] for {set i 0} {$i < $nModule} {incr i} { $w.frame.list insert end [lindex $ExModList $i] } bind $w.frame.list { set venselect_mcode [%W get [%W nearest %y] ] } } tkrev_9.6.1/tkrev/dircanvas.tcl0000664000175000017500000007750315015446517017111 0ustar dorothyrdorothyr# # Columns for listing CVS files and their status # proc DirCanvas:create {w} { global cvsglb global cvscfg global colorglb global incvs insvn inrcs ingit gen_log:log T "ENTER ($w)" update set winwid [winfo width $w] set beginwid [expr {$winwid / 5}] if {! [winfo exists $w.tree] } { frame $w.pw -width $winwid pack $w.pw -fill both -expand 1 ttk::treeview $w.tree -columns {filecol statcol datecol wrevcol editcol} \ -yscrollcommand "$w.yscroll set" set text_h [font metrics $colorglb(listboxfont) -linespace] set icon_h $cvsglb(mod_iconheight) set icon_w $cvsglb(mod_iconwidth) set row_h [expr {$icon_h > $text_h} ? {$icon_h} : {$text_h}] set col0_width [expr {$cvsglb(mod_iconwidth) * 2}] ttk::style configure Treeview -rowheight [expr {$row_h + 2}] ttk::scrollbar $w.yscroll -orient vertical \ -command "$w.tree yview" pack $w.yscroll -in $w.pw -side right -fill y pack $w.tree -in $w.pw -side left -expand yes -fill both $w.tree heading filecol -text "File" $w.tree heading statcol -text "Status" $w.tree heading datecol -text "Date" $w.tree heading wrevcol -text "Revision" $w.tree heading editcol -text "Author" $w.tree column #0 -width $col0_width $w.tree column #0 -stretch no } foreach col {filecol statcol datecol wrevcol editcol} { $w.tree column $col -width $beginwid $w.tree heading $col -image "" -command "DirCanvas:sort_by_col $w.tree $col -increasing" } $w.tree heading #0 -image "" -command "DirCanvas:sort_by_col $w.tree statcol -increasing" update gen_log:log D "incvs=$incvs insvn=$insvn inrcs=$inrcs ingit=$ingit" # We've set preliminary defaults, now use the column and sorting preferences gen_log:log D "sort_pref: $cvscfg(sort_pref)" set col [lindex $cvscfg(sort_pref) 0] set sense [lindex $cvscfg(sort_pref) 1] # If we aren't in a VCS and therefore don't have editcol or wrevcol, sort by filename if { (! ($incvs || $inrcs || $insvn || $ingit)) && ( $col == "editcol" || $col == "wrevcol") } { gen_log:log D "setting sort to column \"filecol!\"" set col "filecol" set sense "-increasing" } DirCanvas:displaycolumns $w.tree # Put an arrow on the column we're sorting by gen_log:log D "will sort by column $col $sense" if {[string match "-inc*" $sense]} { $w.tree heading $col -image arr_dn if {$col == "statcol"} { $w.tree heading #0 -image arr_dn } } else { $w.tree heading $col -image arr_up if {$col == "statcol"} { $w.tree heading #0 -image arr_up } } focus $w.tree if {! [winfo exists $w.paper_pop]} { DirCanvas:makepopup $w } gen_log:log T "LEAVE" } # # Insert a new element $v into the list $w. # proc DirCanvas:newitem {w f} { global DirList global Filelist global incvs insvn inrcs ingit #gen_log:log T "ENTER ($w $f)" set rtype "" if {$inrcs} { set rtype "RCS" } elseif {$incvs} { set rtype "CVS" } elseif {$insvn} { set rtype "SVN" } elseif {$ingit} { set rtype "GIT" } set DirList($w:$f:name) $f gen_log:log D "Newitem $f status $Filelist($f:status)" set DirList($w:$f:status) $Filelist($f:status) set DirList($w:$f:date) $Filelist($f:date) if {[info exists Filelist($f:stickytag)]} { set DirList($w:$f:sticky) $Filelist($f:stickytag) } else { set DirList($w:$f:sticky) "" } if {[info exists Filelist($f:option)]} { set DirList($w:$f:option) $Filelist($f:option) } else { set DirList($w:$f:option) "" } if { [info exists Filelist($f:editors)]} { set DirList($w:$f:editors) $Filelist($f:editors) } else { set DirList($w:$f:editors) "" } catch {unset values} foreach vtag {name status date sticky editors} { lappend values $DirList($w:$f:$vtag) } DirCanvas:choose_icon $w $f $rtype $w.tree insert {} end -image $DirList($w:$f:icon) -values $values -tag fileobj #gen_log:log T "LEAVE" } proc DirCanvas:deltree {w} { global DirList foreach t [array names DirList $w:*] { unset DirList($t) } if {[winfo exists $w]} { $w delete [$w children {}] } } # This has the effect that if you click somewhere other than a row, # the selection is cleared. proc DirCanvas:unselectall {w} { global DirList #gen_log:log T "ENTER ($w)" $w.tree selection set {} set DirList($w:selection) "" set cvsglb(current_selection) "" #gen_log:log T "LEAVE" } # Show and hide columns according to the values of cvscfg(show*col) # Yes we could put them in a list variable, but that wouldn't be # backward compatible. proc DirCanvas:displaycolumns {wt} { global cvscfg global incvs insvn inrcs ingit #gen_log:log T "ENTER ($wt)" set col [lindex $cvscfg(sort_pref) 0] set sense [lindex $cvscfg(sort_pref) 1] gen_log:log D "[$wt configure -displaycolumns]" # The file column is mandatory set displayed_columns {filecol} # These columns are always possible foreach column {statcol datecol} { if {$cvscfg(show$column)} { lappend displayed_columns $column } } # Deciding whether to show the editcol is complicated. # We don't do it if we're not in a VCS, obviously. # But we also don't do it if we're in Git but not showing gitdetail, # or if we're in CVS but not doing econtrol or locking. set can_show(editcol) 0 set can_show(wrevcol) 0 if { ($inrcs || $insvn ) } { set can_show(editcol) 1 set can_show(wrevcol) 1 } if {$ingit && $cvscfg(gitdetail)} { set can_show(editcol) 1 set can_show(wrevcol) 1 } if {$incvs} { set can_show(wrevcol) 1 set can_show(editcol) 1 } foreach column {wrevcol editcol} { if {$can_show($column)} { if {$cvscfg(show$column)} { lappend displayed_columns $column } } } $wt configure -displaycolumns $displayed_columns gen_log:log D "$displayed_columns" DirCanvas:adjust_columnwidths $wt #gen_log:log T "LEAVE" } proc DirCanvas:sort_by_col {wt col sense} { global DirList global cvscfg #gen_log:log T "ENTER ($wt $col $sense)" gen_log:log D "old sort prefs $cvscfg(sort_pref)" set old_columnpref [lindex $cvscfg(sort_pref) 0] set old_sensepref [lindex $cvscfg(sort_pref) 1] set all_columns [lindex [$wt configure -columns] end] set displayed_columns [lindex [$wt configure -displaycolumns] end] if {$displayed_columns eq "#all"} { set displayed_columns $all_columns } # Always start with a list sorted by filename. Collects the values from the # filename column, together with the row index set list_by_name "" foreach item [$wt children {}] { lappend list_by_name [list [$wt set $item filecol] $item] } set list_by_name [lsort -dictionary -index 0 $list_by_name] # Collect the values from the column we want to sort by, together # with the row index set ID_by_name "" foreach item $list_by_name { lappend ID_by_name [lindex $item 1] } set column_items "" foreach item $ID_by_name { lappend column_items [list [$wt set $item $col] $item] } # Re-order the rows in the order obtained above set r -1 foreach info [lsort -dictionary $sense -index 0 $column_items] { $wt move [lindex $info 1] {} [incr r] } # Fix up the arrows foreach a $displayed_columns { $wt heading $a -image "" } $wt heading #0 -image "" # Reset the columns other than the current one. We're heavily favoring defaulting # to increasing sorting order here. This is the way I like it to work, although # others might argue. -dar foreach c {filecol statcol datecol wrevcol editcol} { $wt heading $c -image "" -command "DirCanvas:sort_by_col $wt $c -increasing" } $wt heading #0 -image "" -command "DirCanvas:sort_by_col $wt statcol -increasing" # Then toggle the current column's arrow if {[string match "-inc*" $sense]} { $wt heading $col -image arr_dn -command "DirCanvas:sort_by_col $wt $col -decreasing" if {$col == "statcol"} { $wt heading #0 -image arr_dn -command "DirCanvas:sort_by_col $wt $col -decreasing" } } else { $wt heading $col -image arr_up if {$col == "statcol"} { $wt heading #0 -image arr_up } } set cvscfg(sort_pref) [list $col $sense] gen_log:log D "new sort prefs $cvscfg(sort_pref)" DirCanvas:adjust_columnwidths $wt #gen_log:log T "LEAVE" } proc DirCanvas:adjust_columnwidths {wt} { global colorglb #gen_log:log T "ENTER ($wt)" set displayed_columns [lindex [$wt configure -displaycolumns] end] # Try to adjust the width of the columns suitably # First, find the longest string in each column foreach c $displayed_columns { set maxlen($c) 0 set maxstr($c) " " foreach item [$wt children {}] { set string [$wt set $item $c] set item_len [string length $string] if {$item_len > $maxlen($c)} { set maxlen($c) $item_len set maxstr($c) $string } } } # Now use the string lengths to do a font measure and find the desired width # of each column set n_cols [llength $displayed_columns] set tot_colwid 0 foreach c [array names maxstr] { set colwid($c) [font measure $colorglb(listboxfont) "$maxstr($c)mm"] incr tot_colwid $colwid($c) } set col0_w [$wt column #0 -width] set winwid [expr {[winfo width $wt] - $col0_w}] gen_log:log D "winwid $winwid" # The difference. This can be negative. Divvy it up equqlly. set whole_diff [expr {$winwid - $tot_colwid}] set col_diff [expr {$whole_diff / $n_cols}] foreach c $displayed_columns { set col_wid($c) [expr {$colwid($c) + $col_diff}] $wt column $c -width $col_wid($c) gen_log:log D "$c: \"$maxstr($c)\" $maxlen($c) chars, width $col_wid($c)" } #gen_log:log T "LEAVE" } # menu binding for right-cliwinwid on an item. We have to explicitly # set the selection. proc DirCanvas:popup {w x y X Y} { global DirList global colorglb #gen_log:log T "ENTER ($w $x $y $X $Y)" set item [$w.tree identify item $x $y] $w.tree selection set $item update set f [$w.tree set $item filecol] gen_log:log D "$DirList($w:$f:popup)" set pop $DirList($w:$f:popup) tk_popup $w.$pop $X $Y $w.$pop configure -background $colorglb(menubg) -foreground $colorglb(menufg) #gen_log:log T "LEAVE" } proc DirCanvas:bindings {w} { bind $w.tree <1> "DirCanvas:unselectall $w" $w.tree tag bind fileobj <2> "DirCanvas:popup $w %x %y %X %Y" $w.tree tag bind fileobj <3> "DirCanvas:popup $w %x %y %X %Y" $w.tree tag bind fileobj {workdir_edit_file [workdir_list_files]} } # Context-sensitive popups for list items. We build them all at once here, # then bind canvas items to them as appropriate proc DirCanvas:makepopup {w} { #gen_log:log T "ENTER ($w)" # For plain files in an un-versioned directory menu $w.paper_pop $w.paper_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.paper_pop add command -label "Delete" \ -command { workdir_delete_file [workdir_list_files] } # For plain directories in an un-versioned directory menu $w.folder_pop $w.folder_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.folder_pop add command -label "Delete" \ -command { workdir_delete_file [workdir_list_files] } # For plain, unmanaged files in a versioned directory menu $w.stat_local_pop $w.stat_local_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_local_pop add command -label "Delete" \ -command { workdir_delete_file [workdir_list_files] } $w.stat_local_pop add command -label "Add" \ -command { add_dialog [workdir_list_files] } # For CVS directories when cwd isn't in CVS menu $w.cvsrelease_pop $w.cvsrelease_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.cvsrelease_pop add command -label "CVS Release" \ -command { release_dialog [workdir_list_files] } # For plain directories in CVS menu $w.incvs_folder_pop $w.incvs_folder_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.incvs_folder_pop add command -label "CVS Add Recursively" \ -command { addir_dialog [workdir_list_files] } $w.incvs_folder_pop add command -label "Delete" \ -command { workdir_delete_file [workdir_list_files] } # For CVS subdirectories menu $w.cvsdir_pop $w.cvsdir_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.cvsdir_pop add command -label "CVS Remove Recursively" \ -command { subtractdir_dialog [workdir_list_files] } # For SVN subdirectories menu $w.svndir_pop $w.svndir_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.svndir_pop add command -label "SVN Log" \ -command { svn_log verbose [workdir_list_files] } $w.svndir_pop add command -label "SVN Info" \ -command { svn_info [workdir_list_files] } $w.svndir_pop add command -label "Browse the Log Diagram" \ -command { svn_branches [workdir_list_files] } $w.svndir_pop add command -label "SVN Remove" \ -command { subtract_dialog [workdir_list_files] } # For Git subdirectories menu $w.gitdir_pop $w.gitdir_pop add command -label "Descend" \ -command { workdir_edit_file [workdir_list_files] } $w.gitdir_pop add command -label "Git Remove Recursively" \ -command { subtractdir_dialog [workdir_list_files] } # For RCS files menu $w.rcs_pop $w.rcs_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.rcs_pop add command -label "Browse the Log Diagram" \ -command { rcs_branches [workdir_list_files] } $w.rcs_pop add command -label "RCS Lock" \ -command { rcs_lock lock [workdir_list_files] } $w.rcs_pop add command -label "RCS Unlock" \ -command { rcs_lock unlock [workdir_list_files] } $w.rcs_pop add command -label "RCS Revert" \ -command { rcs_revert [workdir_list_files] } $w.rcs_pop add command -label "Delete Locally" \ -command { workdir_delete_file [workdir_list_files] } # For CVS files menu $w.stat_cvsok_pop $w.stat_cvsok_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_cvsok_pop add command -label "CVS Log" \ -command { cvs_log verbose [workdir_list_files] } $w.stat_cvsok_pop add command -label "Browse the Log Diagram" \ -command { cvs_branches [workdir_list_files] } $w.stat_cvsok_pop add command -label "CVS Annotate/Blame" \ -command { cvs_annotate $current_tagname [workdir_list_files] } $w.stat_cvsok_pop add command -label "CVS Remove" \ -command { subtract_dialog [workdir_list_files] } $w.stat_cvsok_pop add command -label "Set Edit Flag" \ -command { cvs_edit [workdir_list_files] } $w.stat_cvsok_pop add command -label "Unset Edit Flag" \ -command { cvs_unedit [workdir_list_files] } $w.stat_cvsok_pop add command -label "Set Binary Flag" \ -command { cvs_binary [workdir_list_files] } $w.stat_cvsok_pop add command -label "Unset Binary Flag" \ -command { cvs_ascii [workdir_list_files] } # For SVN files menu $w.stat_svnok_pop $w.stat_svnok_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_svnok_pop add command -label "SVN Log" \ -command { svn_log verbose [workdir_list_files] } $w.stat_svnok_pop add command -label "SVN Info" \ -command { svn_info [workdir_list_files] } $w.stat_svnok_pop add command -label "Browse the Log Diagram" \ -command { svn_branches [workdir_list_files] } $w.stat_svnok_pop add command -label "SVN Annotate/Blame" \ -command { svn_annotate "" [workdir_list_files] } $w.stat_svnok_pop add command -label "SVN Rename" \ -command { svn_rename_ask [workdir_list_files] } $w.stat_svnok_pop add command -label "SVN Remove" \ -command { subtract_dialog [workdir_list_files] } # For Git files menu $w.stat_gitok_pop $w.stat_gitok_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_gitok_pop add command -label "Git Log" \ -command { git_log verbose [workdir_list_files] } $w.stat_gitok_pop add command -label "Browse the Log Diagram" \ -command { git_branches [workdir_list_files] } $w.stat_gitok_pop add command -label "Git Annotate/Blame" \ -command { git_annotate "" [workdir_list_files] } $w.stat_gitok_pop add command -label "Git Rename" \ -command { git_rename_ask [workdir_list_files] } $w.stat_gitok_pop add command -label "Git Remove" \ -command { subtract_dialog [workdir_list_files] } # For CVS files that are out of date menu $w.stat_cvsood_pop $w.stat_cvsood_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_cvsood_pop add command -label "Update" \ -command { \ cvs_update {BASE} {Normal} {Remove} {recurse} {prune} {No} { } [workdir_list_files] } $w.stat_cvsood_pop add command -label "Update with Options" \ -command cvs_update_options # For SVN files that are out of date menu $w.stat_svnood_pop $w.stat_svnood_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_svnood_pop add command -label "Update" \ -command { svn_update [workdir_list_files] } # For Git files that are out of date menu $w.stat_gitood_pop $w.stat_gitood_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_gitood_pop add command -label "Update" \ -command { git_checkout [workdir_list_files] } # For CVS files that need merging menu $w.stat_merge_pop $w.stat_merge_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_merge_pop add command -label "Diff" \ -command { comparediff [workdir_list_files] } $w.stat_merge_pop add command -label "CVS Annotate/Blame" \ -command { cvs_annotate $current_tagname [workdir_list_files] } $w.stat_merge_pop add command -label "Browse the Log Diagram" \ -command { cvs_branches [workdir_list_files] } # For CVS files that are modified menu $w.stat_cvsmod_pop $w.stat_cvsmod_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_cvsmod_pop add command -label "Diff" \ -command { comparediff [workdir_list_files] } $w.stat_cvsmod_pop add command -label "CVS Commit" \ -command { cvs_commit_dialog } $w.stat_cvsmod_pop add command -label "CVS Revert" \ -command { cvs_revert [workdir_list_files] } # For SVN files that are modified menu $w.stat_svnmod_pop $w.stat_svnmod_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_svnmod_pop add command -label "Diff" \ -command { comparediff [workdir_list_files] } $w.stat_svnmod_pop add command -label "SVN Commit" \ -command { svn_commit_dialog } $w.stat_svnmod_pop add command -label "SVN Revert" \ -command { svn_revert [workdir_list_files] } # For Git files that are modified menu $w.stat_gitmod_pop $w.stat_gitmod_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_gitmod_pop add command -label "Diff" \ -command { comparediff [workdir_list_files] } $w.stat_gitmod_pop add command -label "Git Commit" \ -command { git_commit_dialog } #$w.stat_gitmod_pop add command -label "Git Reset (Revert)" \ -command { git_reset [workdir_list_files] } # For CVS files that have been added but not commited menu $w.stat_cvsplus_pop $w.stat_cvsplus_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_cvsplus_pop add command -label "CVS Commit" \ -command { cvs_commit_dialog } # For SVN files that have been added but not commited menu $w.stat_svnplus_pop $w.stat_svnplus_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_svnplus_pop add command -label "SVN Commit" \ -command { svn_commit_dialog } # For Git files that have been added but not commited menu $w.stat_gitplus_pop $w.stat_gitplus_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_gitplus_pop add command -label "Git Commit" \ -command { git_commit_dialog } # For CVS files that have been removed but not commited menu $w.stat_cvsminus_pop $w.stat_cvsminus_pop add command -label "CVS Commit" \ -command { cvs_commit_dialog } # For SVN files that have been removed but not commited menu $w.stat_svnminus_pop $w.stat_svnminus_pop add command -label "SVN Commit" \ -command { svn_commit_dialog } # For Git files that have been removed but not commited menu $w.stat_gitminus_pop $w.stat_gitminus_pop add command -label "Git Commit" \ -command { git_commit_dialog } # For CVS unmanaged files menu $w.stat_cvslocal_pop $w.stat_cvslocal_pop add command -label "Edit" \ -command { workdir_edit_file [workdir_list_files] } $w.stat_cvslocal_pop add command -label "Delete" \ -command { workdir_delete_file [workdir_list_files] } $w.stat_cvslocal_pop add command -label "CVS Add" \ -command { cvs_add [workdir_list_files] } # For CVS files with conflicts menu $w.cvs_conf_pop $w.cvs_conf_pop add command -label "Merge using TkDiff" \ -command { cvs_reconcile_conflict [workdir_list_files] } $w.cvs_conf_pop add command -label "CVS Annotate/Blame" \ -command { cvs_annotate $current_tagname [workdir_list_files] } $w.cvs_conf_pop add command -label "Browse the Log Diagram" \ -command { cvs_branches [workdir_list_files] } # For SVN files with conflicts menu $w.svn_conf_pop $w.svn_conf_pop add command -label "Merge using TkDiff" \ -command { svn_reconcile_conflict [workdir_list_files] } $w.svn_conf_pop add command -label "Mark resolved" \ -command { svn_resolve [workdir_list_files] } $w.svn_conf_pop add command -label "CVS Annotate/Blame" \ -command { svn_annotate $current_tagname [workdir_list_files] } $w.svn_conf_pop add command -label "Browse the Log Diagram" \ -command { svn_branches [workdir_list_files] } # For Git files with conflicts menu $w.git_conf_pop $w.git_conf_pop add command -label "Merge using TkDiff" \ -command { git_reconcile_conflict [workdir_list_files] } $w.git_conf_pop add command -label "Stage resolved conflict" \ -command { git_add [workdir_list_files] } #gen_log:log T "LEAVE" } # Pick an icon for the file status. There are way too many of these. proc DirCanvas:choose_icon {w f rtype} { global DirList global incvs insvn inrcs ingit # Up-to-date # The file is identical with the latest revision in the repository for the # branch in use # Locally Modified # You have edited the file, and not yet committed your changes. # Locally Added # You have added the file with add, and not yet committed your changes. # Locally Removed # You have removed the file with remove, and not yet committed your changes # Needs Checkout # Someone else has committed a newer revision to the repository. The name # is slightly misleading; you will ordinarily use update rather than # checkout to get that newer revision. # Needs Patch # Like Needs Checkout, but the CVS server will send a patch rather than the # entire file. Sending a patch or sending an entire file accomplishes # the same thing. # Needs Merge # Someone else has committed a newer revision to the repository, and you # have also made modifications to the file. # Unresolved Conflict # This is like Locally Modified, except that a previous update command gave # a conflict. You need to resolve the conflict as described in section # Conflicts example. # Unknown # CVS doesn't know anything about this file. For example, you have created # a new file and have not run add. switch -glob -- $DirList($w:$f:status) { "" { set DirList($w:$f:icon) paper set DirList($w:$f:popup) paper_pop } " " { set DirList($w:$f:icon) dir set DirList($w:$f:popup) svndir_pop } " Up-to-date" { set DirList($w:$f:icon) dir_ok set DirList($w:$f:popup) svndir_pop } " Property Modified" { set DirList($w:$f:icon) dir_mod set DirList($w:$f:popup) svndir_pop } " Not managed*" { set DirList($w:$f:icon) dir set DirList($w:$f:popup) svndir_pop } " Added" { set DirList($w:$f:icon) dir_plus set DirList($w:$f:popup) svndir_pop } " Removed" { set DirList($w:$f:icon) dir_minus set DirList($w:$f:popup) svndir_pop } " " { set DirList($w:$f:icon) link set DirList($w:$f:popup) paper_pop } "" { set DirList($w:$f:icon) paper set DirList($w:$f:popup) paper_pop } " Not managed by SVN" { set DirList($w:$f:icon) link set DirList($w:$f:popup) paper_pop } " Up-to-date" { set DirList($w:$f:icon) link_ok set DirList($w:$f:popup) stat_svnok_pop } " Up-to-date/Locked" { set DirList($w:$f:icon) link_okol set DirList($w:$f:popup) stat_svnok_pop } " Up-to-date/HaveLock" { set DirList($w:$f:icon) link_okml set DirList($w:$f:popup) stat_svnok_pop } " Modified" { set DirList($w:$f:icon) link_mod set DirList($w:$f:popup) stat_svnok_pop } " Modified/Locked" { set DirList($w:$f:icon) link_modol set DirList($w:$f:popup) stat_svnok_pop } " Modified/HaveLock" { set DirList($w:$f:icon) link_modml set DirList($w:$f:popup) stat_svnok_pop } " Added*" { set DirList($w:$f:icon) link_plus set DirList($w:$f:popup) stat_svnok_pop } "" { set DirList($w:$f:icon) dir switch -- $rtype { "CVS" { set DirList($w:$f:popup) incvs_folder_pop } default { set DirList($w:$f:popup) folder_pop } } } "" { regexp {} $DirList($w:$f:status) null vcs set DirList($w:$f:icon) dir set DirList($w:$f:popup) folder_pop # What VCS controls the folder? Determines the icon switch -- $vcs { "CVS" { set DirList($w:$f:icon) cvsdir set DirList($w:$f:popup) cvsrelease_pop } "SVN" { set DirList($w:$f:icon) svndir } "GIT" { set DirList($w:$f:icon) gitdir } "RCS" { set DirList($w:$f:icon) rcsdir } } # Are we in that VCS now? Determines the popop menu switch -- $rtype { "CVS" { set DirList($w:$f:popup) cvsdir_pop } "SVN" { set DirList($w:$f:popup) svndir_pop } "GIT" { set DirList($w:$f:popup) gitdir_pop } "RCS" { set DirList($w:$f:popup) folder_pop } } } "Up-to-date" { set DirList($w:$f:icon) stat_ok switch -- $rtype { "CVS" { set DirList($w:$f:popup) stat_cvsok_pop if {[string match "*-kb*" $DirList($w:$f:option)]} { set DirList($w:$f:icon) stat_kb } } "SVN" { set DirList($w:$f:popup) stat_svnok_pop } "GIT" { set DirList($w:$f:popup) stat_gitok_pop } default { set DirList($w:$f:popup) paper_pop } } } "Up-to-date/HaveLock" { set DirList($w:$f:icon) stat_okml set DirList($w:$f:popup) stat_svnok_pop } "Up-to-date/Locked" { set DirList($w:$f:icon) stat_okol set DirList($w:$f:popup) stat_svnok_pop } "Missing*" { set DirList($w:$f:icon) stat_ex switch -- $rtype { "CVS" { set DirList($w:$f:popup) stat_cvsood_pop } "SVN" { set DirList($w:$f:popup) stat_svnood_pop } } } "Needs Checkout" { # Prepending ./ to the filename prevents tilde expansion if {[file exists ./$f]} { set DirList($w:$f:icon) stat_ood } else { set DirList($w:$f:icon) stat_ex } set DirList($w:$f:popup) stat_cvsood_pop } "Needs Patch" { set DirList($w:$f:icon) stat_ood set DirList($w:$f:popup) stat_cvsood_pop } " Out-of-date" { set DirList($w:$f:icon) dir_ood switch -- $rtype { "CVS" { set DirList($w:$f:popup) stat_cvsood_pop } "SVN" { set DirList($w:$f:popup) stat_svnood_pop } "GIT" { set DirList($w:$f:popup) stat_gitood_pop } } } "Out-of-date" { set DirList($w:$f:icon) stat_ood switch -- $rtype { "CVS" { set DirList($w:$f:popup) stat_cvsood_pop } "SVN" { set DirList($w:$f:popup) stat_svnood_pop } "GIT" { set DirList($w:$f:popup) stat_gitood_pop } } } "Needs Merge" { set DirList($w:$f:icon) stat_merge set DirList($w:$f:popup) stat_merge_pop } "Locally Modified" { set DirList($w:$f:icon) stat_mod set DirList($w:$f:popup) stat_cvsmod_pop } "Modified*" { set DirList($w:$f:icon) stat_mod set DirList($w:$f:popup) stat_svnmod_pop } "Locally Modified/HaveLock" { set DirList($w:$f:icon) stat_modml set DirList($w:$f:popup) stat_cvsmod_pop } "Locally Modified/Locked" { set DirList($w:$f:icon) stat_modol set DirList($w:$f:popup) stat_cvsmod_pop } "Locally Added" { set DirList($w:$f:icon) stat_plus if {[string match "*-kb*" $DirList($w:$f:option)]} { set DirList($w:$f:icon) stat_cvsplus_kb } set DirList($w:$f:popup) stat_cvsplus_pop } "Added, moved*" { set DirList($w:$f:icon) stat_plus_minus set DirList($w:$f:popup) stat_svnplus_pop } "Added, missing" { set DirList($w:$f:icon) stat_ex set DirList($w:$f:popup) stat_gitplus_pop } "Added*" { set DirList($w:$f:icon) stat_plus switch -- $rtype { "SVN" { set DirList($w:$f:popup) stat_svnplus_pop } "GIT" { set DirList($w:$f:popup) stat_gitplus_pop } } } "Modified, unstaged" { set DirList($w:$f:icon) stat_mod_red set DirList($w:$f:popup) stat_gitmod_pop } "Modified, staged" { set DirList($w:$f:icon) stat_mod_green set DirList($w:$f:popup) stat_gitmod_pop } "Removed, moved*" { set DirList($w:$f:icon) stat_plus_minus set DirList($w:$f:popup) stat_svnminus_pop } "Removed*" { set DirList($w:$f:icon) stat_minus switch -- $rtype { "SVN" { set DirList($w:$f:popup) stat_svnminus_pop } "GIT" { set DirList($w:$f:popup) stat_gitminus_pop } } } "Locally Removed" { set DirList($w:$f:icon) stat_minus set DirList($w:$f:popup) stat_cvsminus_pop } "*Renamed*" { set DirList($w:$f:icon) stat_plus_minus } "*onflict*" { set DirList($w:$f:icon) stat_conf switch -- $rtype { "CVS" { set DirList($w:$f:popup) cvs_conf_pop } "SVN" { set DirList($w:$f:popup) svn_conf_pop } "GIT" { set DirList($w:$f:popup) git_conf_pop } } } "Not managed*" { set DirList($w:$f:icon) stat_ques set DirList($w:$f:popup) stat_local_pop } "RCS Up-to-date" { set DirList($w:$f:icon) stat_ok set DirList($w:$f:popup) rcs_pop } "RCS Up-to-date/HaveLock" { set DirList($w:$f:icon) stat_okml set DirList($w:$f:popup) rcs_pop } "RCS Up-to-date/Locked" { set DirList($w:$f:icon) stat_okol set DirList($w:$f:popup) rcs_pop } "RCS Modified" { set DirList($w:$f:icon) stat_mod set DirList($w:$f:popup) rcs_pop } "RCS Modified/HaveLock" { set DirList($w:$f:icon) stat_modml set DirList($w:$f:popup) rcs_pop } "RCS Modified/Locked" { set DirList($w:$f:icon) stat_modol set DirList($w:$f:popup) rcs_pop } "RCS Needs Checkout" { set DirList($w:$f:icon) stat_ex set DirList($w:$f:popup) rcs_pop } "RCS Needs Checkout/HaveLock" { set DirList($w:$f:icon) stat_oodml set DirList($w:$f:popup) rcs_pop } default { set DirList($w:$f:icon) paper set DirList($w:$f:popup) paper_pop } } } tkrev_9.6.1/tkrev/mkindex0000775000175000017500000000111514703543272016001 0ustar dorothyrdorothyr#!/bin/sh #-*-tcl-*- # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} puts "making tclIndex" auto_mkindex . \ annotate.tcl \ branch_diagram.tcl \ cvs.tcl \ dialog.tcl \ diff.tcl \ dircanvas.tcl \ errors.tcl \ exec.tcl \ filebrowse.tcl \ gen_log.tcl \ git.tcl \ help.tcl \ cvs_import.tcl \ cvs_subimport.tcl \ joincanvas.tcl \ load_images.tcl \ menubar.tcl \ modbrowse.tcl \ modules.tcl \ preferences.tcl \ rcs.tcl \ style_params.tcl \ svn_import.tcl \ svn.tcl \ tkrev.tcl \ tkrev_def.tcl \ tooltips.tcl \ ui_misc.tcl \ vendor_merge.tcl \ workdir.tcl puts "done" exit tkrev_9.6.1/tkrev/filebrowse.tcl0000664000175000017500000001312415015446517017265 0ustar dorothyrdorothyr# # Tcl library for TkRev # # # Sets up a dialog to browse the contents of a module. # proc browse_files {module} { global filenames global modval global checkout_version global cvsglb global colorglb gen_log:log T "ENTER ($module)" set browser 0 if {$module == ""} { cvsfail "Please select a module!" .modbrowse return } gen_log:log D "[array names modval]" if {$module ni [array names modval]} { cvsfail "$module is not a CVS module" .modbrowse return } # Find the list of file names. find_filenames $module if {! [info exists filenames($module)]} { cvsfail "There are no files in this module!" .modbrowse return } # # Create the browser window. # incr browser set filebrowse ".filebrowse$browser" toplevel $filebrowse frame $filebrowse.top ;#-relief raised -borderwidth 2 frame $filebrowse.buttons ;#-relief raised -borderwidth 2 frame $filebrowse.srch ;#-relief raised -borderwidth 2 pack $filebrowse.top -side top -fill x pack $filebrowse.buttons -side bottom -fill x pack $filebrowse.srch -side bottom -fill x label $filebrowse.top.verlbl -text "Version / Tag " -anchor w entry $filebrowse.top.verent -relief sunken -textvariable checkout_version button $filebrowse.srch.srchbtn -text Search \ -command "search_listbox $filebrowse.list" entry $filebrowse.srch.srchent -width 20 -textvariable cvsglb(searchstr) bind $filebrowse.srch.srchent "search_listbox $filebrowse.list" pack $filebrowse.top.verlbl -side left pack $filebrowse.top.verent -side right -fill x -expand y pack $filebrowse.srch.srchbtn -side left pack $filebrowse.srch.srchent -side right -fill x -expand y # # Create buttons # button $filebrowse.view -image Fileview \ -command "module_fileview $filebrowse $module" button $filebrowse.log -image Log \ -command "module_filelog $filebrowse $module 0" button $filebrowse.branches -image Branches \ -command "module_filelog $filebrowse $module 1" button $filebrowse.tag -image Tags \ -command "module_tagview $filebrowse $module" button $filebrowse.quit -text "Close" \ -padx 0 -pady 0 \ -command "destroy $filebrowse; exit_cleanup 0" pack $filebrowse.view \ $filebrowse.log \ $filebrowse.branches \ $filebrowse.tag \ -in $filebrowse.buttons -side left -ipadx 1 -ipady 1 -fill x -expand 1 pack $filebrowse.quit \ -in $filebrowse.buttons -side left -ipadx 0 -ipady 0 -fill both -expand 1 set_tooltips $filebrowse.view \ {"View the selected file"} set_tooltips $filebrowse.log \ {"See the revision log of the selected file"} set_tooltips $filebrowse.branches \ {"See the branch diagram of the selected file"} set_tooltips $filebrowse.tag \ {"List the tags of the selected file"} # # Create a scroll bar and a list box. # ttk::scrollbar $filebrowse.scroll -command "$filebrowse.list yview" listbox $filebrowse.list \ -yscrollcommand "$filebrowse.scroll set" -relief sunken \ -font $colorglb(listboxfont) \ -width 40 -height 25 -setgrid yes pack $filebrowse.scroll -side right -fill y pack $filebrowse.list -side left -fill both -expand 1 # # Window manager stuff. # wm title $filebrowse "Files in $module" wm minsize $filebrowse 5 5 # # Fill the list. # foreach file $filenames($module) { if {[info exists modval($module)]} { set module $modval($module) } regsub "^$module/" $file "" file $filebrowse.list insert end $file } search_listbox_init gen_log:log T "LEAVE" } proc filepath {module filename} { # Prepend a path to the filename if needed global modval global module_dir global cvscfg global cvs gen_log:log T "ENTER ($filename $module)" regsub -all {\$} $filename {\$} file # set global module variable - branch_diagram may need it set commandline \ "$cvs -d $cvscfg(cvsroot) rdiff -s -D 01/01/1971 \"$file\"" gen_log:log C $commandline set ret [catch {exec {*}$commandline} view_this] gen_log:log D "\"$view_this\"" if {! $ret} { gen_log:log T "LEAVE (fine the way we are) ($file)" return $file } if {[info exists modval($module)]} { gen_log:log D "modval $module \"$modval($module)\"" set module_dir $modval($module) #set file "$module_dir/[file tail $file]" set file "$module_dir/$file" gen_log:log T "LEAVE (prepend modval) ($file)" return $file } set file "$module/$file" gen_log:log T "LEAVE (default) ($file)" return $file } proc module_filelog {toplevelname module {graphic {0}} } { # Open the logbrowser from the file list gen_log:log T "ENTER ($toplevelname $module $graphic)" set listname $toplevelname.list foreach item [$listname curselection] { set v [$listname get $item] set f [filepath $module $v] cvs_filelog "$f" $toplevelname $graphic } gen_log:log T "LEAVE" } proc module_fileview {toplevelname module} { # View a file from the file list gen_log:log T "ENTER ($toplevelname $module)" set listname $toplevelname.list foreach item [$listname curselection] { set v [$listname get $item] set f [filepath $module $v] cvs_fileview_checkout [$toplevelname.top.verent get] "$f" } gen_log:log T "LEAVE" } proc module_tagview {toplevelname module} { # List the tags of a file from the filelist gen_log:log T "ENTER ($toplevelname $module)" set listname $toplevelname.list foreach item [$listname curselection] { set v [$listname get $item] set f [filepath $module $v] view_output::new "$f Tags" [cvs_gettaglist "$f" $toplevelname] } gen_log:log T "LEAVE" } tkrev_9.6.1/tkrev/cvs.tcl0000664000175000017500000024303115030415106015704 0ustar dorothyrdorothyr# # Tcl Library for TkRev # # # Contains procedures used in interaction with CVS. # proc cvs_notincvs {} { cvsfail "This directory is not in CVS." .workdir } # Create a temporary directory # cd to that directory # run the CVS command in that directory # # returns: the current wd (ERROR) or the sandbox directory (OK) proc cvs_sandbox_runcmd {command output_var} { global cvscfg global cwd upvar $output_var view_this # Big note: the temp directory fed to a remote servers's command line # needs to be seen by the server. It can't cd to an absolute path. # In addition it's fussy about where you are when you do a checkout -d. # Best avoid that altogether. gen_log:log T "ENTER ($command $output_var)" set pid [pid] if {! [file isdirectory $cvscfg(tmpdir)]} { gen_log:log F "MKDIR $cvscfg(tmpdir)" file mkdir $cvscfg(tmpdir) } cd $cvscfg(tmpdir) gen_log:log F "CD [pwd]" if {! [file isdirectory cvstmpdir.$pid]} { gen_log:log F "MKDIR cvstmpdir.$pid" file mkdir cvstmpdir.$pid } cd cvstmpdir.$pid gen_log:log F "CD [pwd]" gen_log:log C "$command" set ret [catch {exec {*}$command} view_this] gen_log:log T "RETURN $cvscfg(tmpdir)/cvstmpdir.$pid" return $cvscfg(tmpdir)/cvstmpdir.$pid } # cvs_sandbox_filetags # assume that the sandbox contains the checked out files # return a list of all the tags in the files proc cvs_sandbox_filetags {mcode args} { global cvscfg global cvs set pid [pid] set cwd [pwd] gen_log:log T "ENTER ($mcode $args)" set filenames [join $args] set command "$cvs log" cd [file join $cvscfg(tmpdir) cvstmpdir.$pid $mcode] foreach f $filenames { append command " \"$f\"" } gen_log:log C "$command" set ret [catch {exec {*}$command} view_this] if {$ret} { cd $cwd cvsfail $view_this .merge gen_log:log T "LEAVE ERROR" return $keepers } set view_lines [split $view_this "\n"] foreach line $view_lines { if {[string index $line 0] == "\t" } { regsub -all {[\t ]*} $line "" tag append keepers "$tag " } } cd $cwd gen_log:log T "LEAVE" return $keepers } proc cvs_workdir_status {} { global cvscfg global cvs global Filelist gen_log:log T "ENTER" # We mostly get the information we need from cvs -n -q status. But for # lockers, we need cvs log. For editors, we need the separate cvs editors # command. If the server isn't local, we need the log to get the author, too. set cmd(cvs_status) [exec::new "$cvs -n -q status -l"] set status_lines [split [$cmd(cvs_status)\::output] "\n"] if {$cvscfg(showeditcol)} { set cmd(cvs_get_log) [exec::new "$cvs log -N -l"] set cvslog_lines [split [$cmd(cvs_get_log)\::output] "\n"] } if {$cvscfg(showdatecol) && ! [string match {:local:*} $cvscfg(cvsroot)] } { if {! [info exists cmd(cvs_get_log)]} { set cmd(cvs_get_log) [exec::new "$cvs log -N -l"] set cvslog_lines [split [$cmd(cvs_get_log)\::output] "\n"] } } if {$cvscfg(econtrol) && $cvscfg(showeditcol)} { set cmd(cvs_editors) [exec::new "$cvs -n -q editors -l"] set editors_lines [split [$cmd(cvs_editors)\::output] "\n"] } if {[info exists cmd(cvs_status)]} { $cmd(cvs_status)\::destroy catch {unset cmd(cvs_status)} } # get cvs status in current directory only, reading lines that include # Status: or Sticky Tag:, putting each file's info (name, status, and tag) # into an array. foreach logline $status_lines { if {[string match "File:*" $logline]} { regsub -all {\t+} $logline "\t" logline set line [split [string trim $logline] "\t"] gen_log:log D "$line" # Clean up the file name regsub {File:\s+} [lindex $line 0] "" filename regsub {^no file } $filename {} filename regsub {\s*$} $filename "" filename regsub {Status: } [lindex $line 1] "" status set Filelist($filename:status) $status # Don't set editors to null because we'll use its presence # or absence to see if we need to re-read the repository when # we ask to map the editors column } elseif {[string match "*Working revision:*" $logline]} { regsub -all {\t+} $logline "\t" logline set line [split [string trim $logline] "\t"] gen_log:log D "$line" set revision [lindex $line 1] regsub {New .*} $revision "New" revision set date [lindex $line 2] # The date field is not supplied to remote clients. set Filelist($filename:date) $date set Filelist($filename:wrev) $revision set Filelist($filename:status) $status } elseif {[string match "*Sticky Tag:*" $logline]} { regsub -all {\t+} $logline "\t" logline set line [split [string trim $logline] "\t"] gen_log:log D "$line" set tagline [lindex $line 1] set t0 [lindex $tagline 0] set t1 [lrange $tagline 1 end] set stickytag "" if { $t0 == "(none)" } { set stickytag " on trunk" } elseif {[string match "(branch:*" $t1 ]} { regsub {\(branch: (.*)\)} $t1 {\1} t1 set stickytag " on $t0" } elseif {[string match "(revision:*" $t1 ]} { set stickytag " $t0" } set Filelist($filename:stickytag) "$revision $stickytag" } elseif {[string match "*Sticky Options:*" $logline]} { regsub -all {\t+} $logline "\t" logline set line [split [string trim $logline] "\t"] gen_log:log D "$line" set option [lindex $line 1] set Filelist($filename:option) $option } } if {[info exists cmd(cvs_editors)]} { set filename "" set editors "" $cmd(cvs_editors)\::destroy catch {unset cmd(cvs_editors)} foreach logline $editors_lines { set line [split $logline "\t"] gen_log:log D "$line" set ell [llength $line] # ? files will show up in cvs editors output under certain conditions if {$ell < 5} { continue } set f [lindex $line 0] if {$f == {}} { #if there is no filename, then this is a continuation line append editors ",[lindex $line 1]" } else { set filename $f set editors [lindex $line 1] set Filelist($filename:editors) $editors set file_editors($filename) $editors } gen_log:log D "$filename editors: $editors" } } if {[info exists cmd(cvs_get_log)]} { set filename {} set date {} $cmd(cvs_get_log)\::destroy catch {unset cmd(cvs_get_log)} foreach line $cvslog_lines { if {[string match "Working file: *" $line]} { gen_log:log D "$line" regsub "Working file: " $line "" filename } elseif {[string match "*locked by:*" $line]} { gen_log:log D "$line" if {$filename != {}} { set p [lindex $line 4] set r [lindex $line 1] set p [string trimright $p {;}] gen_log:log D " $filename $p\($r\)" append file_lockers($filename) "$p\($r\)" } } elseif {[string match "date:*" $line]} { #The date line also has the name of the author set parts [split $line ";"] foreach p $parts { set eqn [split $p ":"]; set eqname [string trim [lindex $eqn 0]] set eqval [string trim [join [lrange $eqn 1 end] ":"]] switch -exact -- $eqname { {date} { # Sometimes the date has a timezone and sometimes not. # In that case it's the 3rd field set date [lrange $eqval 0 1] # Sometimes it's separated by slashes and sometimes by hyphens regsub -all {/} $date {-} Filelist($filename:date) set Filelist($filename:date) } {author} { set file_authors($filename) $eqval } } } } } } foreach a [array names Filelist *:status] { regsub {:status$} $a "" f set Filelist($f:editors) "" # Format the date if {[info exists Filelist($f:date)]} { #gen_log:log D "Filelist($f:date) \"$Filelist($f:date)\"" if {! [catch {set newdate [clock scan "$Filelist($f:date)" -format "%Y-%m-%d %H:%M:%S"]}] } { set Filelist($f:date) [clock format $newdate -format $cvscfg(dateformat)] } } #gen_log:log D " Filelist($f:date) $Filelist($f:date)" # String the authors, editors, and lockers into one field if {[info exists file_authors($f)]} { set Filelist($f:editors) $file_authors($f) } if {[info exists file_lockers($f)]} { append Filelist($f:editors) " lock:$file_lockers($f)" } if {[info exists file_editors($f)]} { append Filelist($f:editors) " editors:$file_editors($f)" } } gen_log:log T "LEAVE" } # This deletes a file from the directory and the repository, # asking for confirmation first. proc cvs_remove_file {args} { global cvs global incvs gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] # Unix-remove the files set success 1 foreach file $filelist { file delete -force -- $file gen_log:log F "DELETE $file" if {[file exists $file]} { set success 0 } } if {$success == 0} { cvsfail "Remove $file failed" .workdir return } # cvs-remove them set command "$cvs remove" foreach f $filelist { append command " \"$f\"" } set cmd(cvscmd) [exec::new "$command"] auto_setup_dir $cmd(cvscmd) gen_log:log T "LEAVE" } # This removes files recursively. proc cvs_remove_dir {args} { global cvs global incvs global cvscfg gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] if {$filelist == ""} { cvsfail "Please select a directory!" .workdir return } else { set mess "This will remove the contents of these directories:\n\n" foreach file $filelist { append mess " $file\n" } } set v [viewer::new "CVS Remove directory"] set awd [pwd] foreach file $filelist { if {[file isdirectory $file]} { set awd [pwd] cd $file gen_log:log F "CD [pwd]" rem_subdirs $v cd $awd gen_log:log F "CD [pwd]" set commandline "$cvs remove \"$file\"" $v\::do "$commandline" 1 status_colortags $v\::wait $v\::clean_exec } } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # This sets the edit flag for a file, asking for confirmation first. proc cvs_edit {args} { global cvs global incvs global cvscfg gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] foreach file $filelist { regsub -all {\$} $file {\$} file set commandline "$cvs edit \"$file\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$ret != 0} { view_output::new "CVS Edit" $view_this } } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # Needs stdin as there is sometimes a dialog if file is modified # (defaults to no) proc cvs_unedit {args} { global cvs global incvs global cvscfg gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] foreach file $filelist { # Unedit may hang asking for confirmation if file is not up-to-date regsub -all {\$} $file {\$} file set commandline "$cvs -n update \"$file\"" gen_log:log C "$commandline" catch {exec {*}$commandline} view_this # Its OK if its locally added if {([llength $view_this] > 0) && ![string match "A*" $view_this] } { gen_log:log D "$view_this" cvsfail "File $file is not up-to-date" .workdir gen_log:log T "LEAVE -- cvs unedit failed" return } set commandline "$cvs unedit \"$file\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$ret != 0} { view_output::new "CVS Edit" $view_this } } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc cvs_history {allflag mcode} { global cvs global cvscfg set all "" gen_log:log T "ENTER ($allflag $mcode)" if {$allflag == "all"} { set all "-a" } if {$mcode == ""} { set commandline "$cvs -d $cvscfg(cvsroot) history $all" } else { set commandline "$cvs -d $cvscfg(cvsroot) history $all -n $mcode" } # FIXME: If $all, it would be nice to process the output set v [viewer::new "CVS History"] $v\::do "$commandline" gen_log:log T "LEAVE" } # This adds a file to the repository. proc cvs_add {binflag args} { global cvs global cvscfg global incvs gen_log:log T "ENTER ($binflag $args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] if {$filelist == ""} { set mess "This will add all new files" } else { set mess "This will add these files:\n\n" foreach file $filelist { append mess " $file\n" } } set command "$cvs add $binflag" if {$filelist == ""} { append filelist [glob -nocomplain $cvscfg(aster) .??*] } else { foreach f $filelist { append command " \"$f\"" } } set cmd(cvscmd) [exec::new "$command"] auto_setup_dir $cmd(cvscmd) gen_log:log T "LEAVE" } # This starts adding recursively at the directory level proc cvs_add_dir {binflag args} { global cvs global cvscfg global incvs gen_log:log T "ENTER ($binflag $args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] if {$filelist == ""} { cvsfail "Please select a directory!" .workdir return 1 } else { set mess "This will recursively add these directories:\n\n" foreach file $filelist { append mess " $file\n" } } set v [viewer::new "CVS Add directory"] set awd [pwd] foreach file $filelist { if {[file isdirectory $file]} { set commandline "$cvs add \"$file\"" $v\::do "$commandline" $v\::wait $v\::clean_exec cd $file gen_log:log F "CD [pwd]" add_subdirs $binflag $v } } cd $awd gen_log:log F "[pwd]" if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc add_subdirs {binflag v} { global cvs global cvscfg gen_log:log T "ENTER ($binflag $v)" set plainfiles {} foreach child [glob -nocomplain $cvscfg(aster) .??*] { if {[file isdirectory $child]} { if {[regexp -nocase {^CVS$} [file tail $child]]} { gen_log:log D "Skipping $child" continue } set commandline "$cvs add \"$child\"" $v\::do "$commandline" $v\::wait $v\::clean_exec set awd [pwd] cd $child gen_log:log F "CD [pwd]" add_subdirs $binflag $v cd $awd gen_log:log F "CD [pwd]" } else { lappend plainfiles $child } } if {[llength $plainfiles] > 0} { # LJZ: get local ignore file filter list set ignore_file_filter $cvscfg(ignore_file_filter) if { [ file exists ".cvsignore" ] } { set fileId [ open ".cvsignore" "r" ] while { [ eof $fileId ] == 0 } { gets $fileId line append ignore_file_filter " $line" } close $fileId } # LJZ: ignore files if requested in recursive add if { $ignore_file_filter != "" } { foreach item $ignore_file_filter { # for each pattern if { $item != "*" } { # if not "*" while { [set idx [lsearch $plainfiles $item]] != -1 } { # for each occurence, delete catch { set plainfiles [ lreplace $plainfiles $idx $idx ] } } } } } # LJZ: any files left after filtering? if {[llength $plainfiles] > 0} { set commandline "$cvs add $binflag $plainfiles" $v\::do "$commandline" $v\::wait } } gen_log:log T "LEAVE" } proc rem_subdirs { v } { global cvs global incvs global cvscfg gen_log:log T "ENTER ($v)" set plainfiles {} foreach child [glob -nocomplain $cvscfg(aster) .??*] { if {[file isdirectory $child]} { if {[regexp -nocase {^CVS$} [file tail $child]]} { gen_log:log D "Skipping $child" continue } set awd [pwd] cd $child gen_log:log F "CD [pwd]" rem_subdirs $v cd $awd gen_log:log F "CD [pwd]" } else { lappend plainfiles $child } } if {[llength $plainfiles] > 0} { foreach file $plainfiles { gen_log:log F "DELETE $file" file delete -force -- $file if {[file exists $file]} {cvsfail "Remove $file failed" .workdir} } } gen_log:log T "LEAVE" } # This views a specific revision of a file in the repository. # For files checked out in the current sandbox. proc cvs_fileview_update {revision filename} { global cvs global cvscfg gen_log:log T "ENTER ($revision $filename)" if {$revision == {}} { set commandline "$cvs -d $cvscfg(cvsroot) update -p \"$filename\"" set v [viewer::new "$filename"] $v\::do "$commandline" 0 } else { set commandline "$cvs -d $cvscfg(cvsroot) update -p -r $revision \"$filename\"" set v [viewer::new "$filename Revision $revision"] $v\::do "$commandline" 0 } gen_log:log T "LEAVE" } # This looks at a revision of a file from the repository. # Called from Repository Browser -> File Browse -> View # For files not currently checked out proc cvs_fileview_checkout {revision filename} { global cvs global cvscfg gen_log:log T "ENTER ($revision)" if {$revision == {}} { set commandline "$cvs -d $cvscfg(cvsroot) checkout -p \"$filename\"" set v [viewer::new "$filename"] $v\::do "$commandline" } else { set commandline "$cvs -d $cvscfg(cvsroot) checkout -p -r $revision \"$filename\"" set v [viewer::new "$filename Revision $revision"] $v\::do "$commandline" } gen_log:log T "LEAVE" } # cvs log. Called from "Log" in the Reports menu. # Uses cvscfg(recurse) proc cvs_log {detail args} { global cvs global cvscfg gen_log:log T "ENTER ($detail $args)" if {$args == "."} { set args "" } set filelist [join $args] set command "$cvs log -N" set flags "" if {! $cvscfg(recurse)} { set flags "-l" } # If verbose, output it as is if {$detail eq "verbose"} { foreach f $filelist { append command " \"$f\"" } if {[llength $filelist] <= 1} { set title "CVS log $filelist ($detail)" } else { set title "CVS log ($detail)" } set v [viewer::new "$title"] $v\::do "$command" 0 rcslog_colortags return } # Otherwise, we still do a verbose log but we only print some things if {$detail eq "summary"} { foreach f $filelist { append command " \"$f\"" } set v [viewer::new "CVS log ($detail)"] set logcmd [exec::new "$command"] set log_lines [split [$logcmd\::output] "\n"] foreach logline $log_lines { # Beginning of a file's record if {[string match "Working file:*" $logline]} { $v\::log "==============================================================================\n" patched $v\::log "$logline\n" patched } elseif {[string match "----------------------------" $logline]} { $v\::log "$logline\n" patched } elseif {[string match "revision *" $logline]} { $v\::log "$logline" } elseif {[string match "date:*" $logline]} { regsub {;\s+state.*$} $logline {} info $v\::log " $info\n" } } } elseif {$detail eq "latest"} { foreach f $filelist { append command " \"$f\"" } set v [viewer::new "CVS log ($detail)"] set logcmd [exec::new "$command"] set log_lines [split [$logcmd\::output] "\n"] set br 0 while {[llength $log_lines] > 0} { set logline [join [lrange $log_lines 0 0]] set log_lines [lrange $log_lines 1 end] # Beginning of a file's record if {[string match "Working file:*" $logline]} { $v\::log "$logline\n" patched while {[llength $log_lines] > 0} { set log_lines [lrange $log_lines 1 end] set logline [join [lrange $log_lines 0 0]] #gen_log:log D " ! $logline !" # Reason to skip if {[string match "*selected revisions: 0" $logline]} { $v\::log "No revisions on branch\n" $v\::log "==============================================================================\n" patched #set br 0 break } # Beginning of a revision if {[string match "----------------------------" $logline]} { #gen_log:log D " !! $logline !!" #$v\::log "$logline\n" while {[llength $log_lines] > 0} { set log_lines [lrange $log_lines 1 end] set logline [join [lrange $log_lines 0 0]] #gen_log:log D " $logline" if { [string match "========================*" $logline] || [string match "--------------*" $logline]} { $v\::log "==============================================================================\n" patched set br 1 break } else { $v\::log "$logline\n" } } } # If we broke out of the inside loop, break out of this one too if {$br == 1} {set br 0; break} } } } } gen_log:log T "LEAVE" } # called from the branch browser proc cvs_log_rev {rev filename} { global cvs gen_log:log T "ENTER ($rev $filename)" set title "CVS log" set commandline "$cvs log -N" if {$rev ne ""} { append commandline " -r:$rev" append title " -r:$rev" } append commandline " \"$filename\"" append title " $filename" set logcmd [viewer::new "$title"] $logcmd\::do "$commandline" 0 rcslog_colortags gen_log:log T "LEAVE" } # annotate/blame. Called from workdir proc cvs_annotate {revision args} { global cvs gen_log:log T "ENTER ($revision $args)" set filelist [join $args] if {$revision == "trunk"} { set revision "" } if {$revision != ""} { set revflag "-r$revision" } else { set revflag "" } if {$filelist == ""} { cvsfail "Annotate:\nPlease select one or more files !" .workdir gen_log:log T "LEAVE (Unselected files)" return } foreach f $filelist { annotate::new $revflag "$f" "cvs" } gen_log:log T "LEAVE" } # annotate/blame. Called from branch_diagram proc cvs_annotate_r {revision filename} { global cvs gen_log:log T "ENTER ($revision $filename)" if {$revision != ""} { # We were given a revision set revflag "-r$revision" } else { set revflag "" } annotate::new $revflag "$filename" "cvs_r" gen_log:log T "LEAVE" } # Commit changes to the repository. # The parameters work differently here -- args is a list. The first # element of args is a list of file names. This is because I can't # use eval on the parameters, because comment contains spaces. proc cvs_commit {revision comment args} { global cvs global cvscfg global incvs gen_log:log T "ENTER ($revision $comment $args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] # changed the message to be a little more explicit. -sj set commit_output "" if {$filelist == ""} { set mess "This will commit your changes to ** ALL ** files in" append mess " and under this directory." } else { foreach file $filelist { append commit_output "\n$file" } set mess "This will commit your changes to:$commit_output" } append mess "\n\nAre you sure?" set commit_output "" if {[cvsconfirm $mess .workdir] != "ok"} { return 1 } set revflag "" if {$revision != ""} { set revflag "-r $revision" } if {$cvscfg(use_cvseditor)} { # Starts text editor of your choice to enter the log message. # This way a template in CVSROOT can be used. update idletasks set commandline "$cvscfg(terminal) $cvs commit -R $revflag" foreach f $filelist { append commandline " \"$f\"" } gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$ret} { cvsfail $view_this .workdir gen_log:log T "LEAVE ERROR ($view_this)" return } } else { if {$comment == ""} { cvsfail "You must enter a comment!" .commit return 1 } set v [viewer::new "CVS Commit"] regsub -all "\"" $comment "\\\"" comment set commandline "$cvs commit -R $revflag -m \"$comment\"" foreach f $filelist { append commandline " \"$f\"" } # Lets not show stderr as it does a lot of "examining" $v\::do "$commandline" 0 $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # This tags a file in a directory. proc cvs_tag {tagname force b_or_t updflag args} { global cvs global cvscfg global incvs gen_log:log T "ENTER ($tagname $force $b_or_t $updflag $args)" if {! $incvs} { cvs_notincvs return 1 } if {$tagname == ""} { cvsfail "Please enter a tag name!" .workdir return 1 } set filelist [join $args] set command "$cvs tag" if {$b_or_t == "branch"} { append command " -b" } if {$force == "yes"} { append command " -F" } append command " $tagname" foreach f $filelist { append command " \"$f\"" } # In new dialog, this isn't supposed to happen, but let's check anyway if {$b_or_t == "branch" && $force == "yes"} { cvsfail "Moving a branch tag isn't allowed" .workdir return } # If it refuses to tag, it can exit with 0 but still put out some stderr set v [viewer::new "CVS Tag"] $v\::do "$command" 1 $v\::wait if {$updflag == "yes"} { # update so we're on the branch set command "$cvs update -r $tagname" foreach f $filelist { append command " \"$f\"" } $v\::do "$command" 0 status_colortags $v\::wait } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } # This updates the files in the current directory. proc cvs_update {tagname k no_tag recurse prune d dir args} { global cvs global cvscfg global incvs gen_log:log T "ENTER (tagname=$tagname k=$k no_tag=$no_tag recurse=$recurse prune=$prune d=$d dir=$dir args=$args)" # Because this is called from an eval, the args aren't a list set filelist {} foreach a $args { append filelist $a } # # cvs update [-APCdflRp] [-k kopt] [-r rev] [-D date] [-j rev] # set commandline "$cvs update" if { $k == "Normal" } { set kmsg "\nUsing normal (text) mode." } elseif { $k == "Binary" } { set kmsg "\nUsing binary mode (-kb)." append commandline " -kb" } if { $tagname == "HEAD" } { append mess "\nYour local files will be updated to the" append mess " latest main trunk (head) revision (-A)." append commandline " -A" } if {$recurse == "local"} { append commandline " -l" } else { append mess "\nIf there is a local sub-directory which has" append mess " become empty through deletion of its contents," if { $prune == "prune" } { append mess " it will be deleted (-P).\n" append commandline " -P" } else { append mess " it will remain.\n" } append mess "\nIf there is a sub-directory in the repository" append mess " that is not here in your local directory," if { $d == "Yes" } { append mess " it will be checked out at this time (-d).\n" if {$dir ne " "} { append mess "($dir only)\n" } append commandline " -d \"$dir\"" } else { append mess " it will not be checked out.\n" } } if { $tagname ne "BASE" && $tagname ne "HEAD" } { append mess "\nYour local files will be updated to the" append mess " tagged revision (-r $tagname)." append mess " If a file does not have the tag," if { $no_tag eq "Remove" } { append mess " it will be removed from your local directory.\n" append commandline " -r $tagname" } elseif { $no_tag == "Get_head" } { append mess " the head revision will be retrieved.\n" append commandline " -f -r $tagname" } } if {$filelist eq ""} { set filemsg "\nYou are about to download from" append filemsg " the repository to your local" append filemsg " filespace the files which" append filemsg " are different in the repository," if {$recurse == "local"} { append filemsg " in this directory only.\n" } else { append filemsg " recursing the sub-directories.\n" } } else { append filemsg "\nYou are about to download from" append filemsg " the repository to your local" append filemsg " filespace these files if they" append filemsg " have changed:\n" foreach f $filelist { append commandline " \"$f\"" #regsub -all {\s+} $f {\ } ftext append filemsg "\n\t$f" } } append filemsg "\nIf you have made local changes, they will" append filemsg " be merged into the new local copy.\n" set mess "$filemsg $mess $kmsg" append mess "\n\nAre you sure?" if {[cvsconfirm $mess .workdir] eq "ok"} { set co_cmd [viewer::new "CVS Update"] $co_cmd\::do "$commandline" 0 status_colortags auto_setup_dir $co_cmd } gen_log:log T "LEAVE" } # Do what was setup in the "Update with Options" dialog proc cvs_opt_update {} { global cvsglb gen_log:log T "ENTER" set command "cvs_update" if { $cvsglb(updatename) == "" } { set tagname "BASE" } else { set tagname $cvsglb(updatename) } if { $cvsglb(get_all_dirs) == "No" } { set cvsglb(getdirname) "" } if { $cvsglb(getdirname) == "" } { set dirname " " } else { set dirname $cvsglb(getdirname) } if { $cvsglb(tagmode_selection) == "Keep" } { set tagname "BASE" } elseif { $cvsglb(tagmode_selection) == "Trunk" } { set tagname "HEAD" } append command " $tagname" append command " {$cvsglb(norm_bin)} {$cvsglb(action_notag)} {$cvsglb(update_recurse)} {$cvsglb(update_prune)} {$cvsglb(get_all_dirs)}" append command " \"$dirname\"" set filenames [workdir_list_files] foreach f $filenames { append command " \"$f\"" } gen_log:log C "$command" eval "$command" gen_log:log T "LEAVE" } # join (merge) a chosen revision of local file to the current revision. proc cvs_merge {parent from since frombranch args} { global cvs global cvscfg gen_log:log T "ENTER (\"$from\" \"$since\" \"$frombranch\" \"$args\")" gen_log:log D "mergetrunkname $cvscfg(mergetrunkname)" # Bug # 3434817 # there's an annoying bug in merging: the ending revision is ignored. # Example: there are revisions 1.1, 1.2, 1.3, 1.4 and 1.5 (HEAD). You are on # a branch made from rev 1.1 and want to merge revisions 1.2 to 1.4. When you # click in the merge diagram left mouse on 1.4, right mouse on 1.2 and click # Diff it will correctly use the following command: # /usr/bin/tkdiff -r "1.4" -r "1.2" "Filename.ext" # However, when you leave the revision selection as-is and click the Merge # the following command is used: # cvs update -d -j1.2 -jHEAD Filename.ext # Obviously the second "-j" parameter is wrong, there should have been "-j1.4". #set realfrom "$frombranch" #if {$frombranch eq $cvscfg(mergetrunkname)} { #set realfrom "HEAD" #} set filelist [join $args] set mergetags [assemble_mergetags $frombranch] set curr_tag [lindex $mergetags 0] set fromtag [lindex $mergetags 1] set totag [lindex $mergetags 2] if {$since == {}} { set mess "Merge revision $from\n" } else { set mess "Merge the changes between revision\n $since and $from" append mess " (if $since > $from the changes are removed)\n" } append mess " to the current revision ($curr_tag)" if {[cvsalwaysconfirm $mess $parent] != "ok"} { return } set commandline "$cvs update -d" # Do the update here, and defer the tagging until later if {$since == {}} { append commandline " -j$from" } else { append commandline " -j$since -j$from" } foreach f $filelist { append commandline " \"$f\"" } set v [viewer::new "CVS Join"] $v\::do "$commandline" 1 status_colortags $v\::wait if {[winfo exists .workdir]} { if {$cvscfg(auto_status)} { setup_dir } } else { workdir_setup } dialog_merge_notice cvs $from $frombranch $fromtag $totag $filelist gen_log:log T "LEAVE" } # Commit and tag a merge proc cvs_merge_tag_seq {from frombranch totag fromtag args} { global cvs global cvscfg gen_log:log T "ENTER (\"$from\" \"$totag\" \"$fromtag\" $args)" set filelist [join $args] set realfrom "$frombranch" if {$frombranch eq $cvscfg(mergetrunkname)} { set realfrom "HEAD" } # Do an update first, to make sure everything is OK at this point set commandline "$cvs -n -q update" foreach f $filelist { append commandline " \"$f\"" } gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] set logmode [expr {$ret ? {E} : {D}}] view_output::new "CVS Check" $view_this gen_log:log $logmode $view_this if {$ret} { set mess "CVS Check shows errors which would prevent a successful\ commit. Please resolve them before continuing." if {[cvsalwaysconfirm $mess .workdir] != "ok"} { return } } # Do the commit set commandline "$cvs commit -m \"Merge from $from\"" foreach f $filelist { append commandline " \"$f\"" } set v [viewer::new "CVS Commit and Tag a Merge"] $v\::log "$commandline\n" $v\::do "$commandline" 1 $v\::wait # Tag if desired if {$cvscfg(auto_tag) && $totag != ""} { # First, the "from" file that's not in this branch (needs -r) set commandline "$cvs tag -F -r$realfrom $totag" foreach f $filelist { append commandline " \"$f\"" } $v\::log "$commandline\n" $v\::do "$commandline" 1 $v\::wait } if {$cvscfg(auto_tag) && $fromtag != ""} { # Now, the version that's in the current branch set commandline "$cvs tag -F $fromtag" foreach f $filelist { append commandline " \"$f\"" } $v\::log "$commandline\n" $v\::do "$commandline" 1 $v\::wait } catch {destroy .reminder} if {$cvscfg(auto_status)} { setup_dir } } # cvs status. Called from "Status" in the Reports menu. # Uses cvscfg(recurse) proc cvs_status {detail args} { global cvs global cvscfg gen_log:log T "ENTER ($detail $args)" if {$args == "."} { set args "" } set filelist [join $args] set flags "" if {! $cvscfg(recurse)} { set flags "-l" } # support verious levels of verboseness. set command "$cvs -Q status $flags" foreach f $filelist { append command " \"$f\"" } set statcmd [exec::new "$command"] set raw_status [$statcmd\::output] $statcmd\::destroy if {$detail == "verbose"} { view_output::new "CVS Status ($detail)" $raw_status } else { set cooked_status "" set stat_lines [split $raw_status "\n"] foreach statline $stat_lines { if {[string match "*Status:*" $statline]} { gen_log:log D "$statline" if {$detail == "terse" && \ [string match "*Up-to-date*" $statline]} { continue } else { regsub {\s+no file } $statline { } statline regsub {^File:\s+} $statline {} statline regsub {Status:\s+} $statline " " statline regsub {Locally Removed} $statline " Locally Removed" statline # FIXME why do the tabs disappear? #regsub {\s+} $statline "\t" statline append cooked_status "$statline\n" } } } view_output::new "CVS Status ($detail)" $cooked_status } busy_done .workdir.main gen_log:log T "LEAVE" } # called from the "Check Directory" button in the workdir and Reports menu proc cvs_check {} { global cvs global cvscfg gen_log:log T "ENTER ()" busy_start .workdir.main set title "CVS Directory Check" set flags "" if {$cvscfg(recurse)} { append title " (recursive)" } else { append flags "-l" append title " (toplevel)" } set commandline "$cvs -n -q update $flags" set check_cmd [viewer::new $title] $check_cmd\::do $commandline 1 status_colortags busy_done .workdir.main gen_log:log T "LEAVE" } # Check out a cvs module from the module browser proc cvs_checkout { cvsroot prune kflag revtag date target mtag1 mtag2 module } { global cvs global incvs insvn inrcs ingit gen_log:log T "ENTER ($cvsroot $prune $kflag $revtag $date $target $mtag1 $mtag2 $module)" set dir [pwd] if {[file pathtype $target] eq "absolute"} { set tgt $target } else { set tgt "$dir/$target" } set mess "This will checkout\n\ $cvsroot/$module\n\ to directory\n\ $tgt\n\ Are you sure?" if {[cvsconfirm $mess .modbrowse] == "ok"} { if {$revtag != {}} { set revtag "-r \"$revtag\"" } if {$date != {}} { set date "-D \"$date\"" } if {$target != {}} { set target "-d \"$target\"" } if {$mtag1 != {}} { set mtag1 "-j \"$mtag1\"" } if {$mtag2 != {}} { set mtag2 "-j \"$mtag2\"" } set v [viewer::new "CVS Checkout"] $v\::do "$cvs -d \"$cvsroot\" checkout $prune\ $revtag $date $target\ $mtag1 $mtag2\ $kflag \"$module\"" } gen_log:log T "LEAVE" return } # This looks at the revision log of a file. It's called from filebrowse.tcl, # so we can't do operations such as merges. proc cvs_filelog {filename parent {graphic {0}} } { global cvs global cvsglb global cwd gen_log:log T "ENTER ($filename $parent $graphic)" set pid [pid] set filetail [file tail $filename] set commandline "$cvs -d $cvsglb(root) checkout \"$filename\"" gen_log:log C "$commandline" set ret [cvs_sandbox_runcmd "$commandline" cmd_output] if {$ret == $cwd} { cvsfail $cmd_output $parent cd $cwd gen_log:log T "LEAVE -- cvs checkout failed" return } if {$graphic} { # Log canvas viewer ::cvs_branchlog::new "CVS,rep" $filename } else { set commandline "$cvs -d $cvsglb(root) log \"$filename\"" set logcmd [viewer::new "CVS log $filename"] $logcmd\::do "$commandline" 0 rcslog_colortags $logcmd\::wait } cd $cwd gen_log:log T "LEAVE" } # This exports a new module (see man cvs and read about export) into # the target directory. proc cvs_export { cvsroot kflag revtag date target module } { global cvs global incvs insvn inrcs ingit gen_log:log T "ENTER ($cvsroot $kflag $revtag $date $target $module)" set dir [pwd] if {[file pathtype $target] eq "absolute"} { set tgt $target } else { set tgt "$dir/$target" } set mess "This will export\n\ $cvsroot/$module\n\ to directory\n\ $tgt\n\ Are you sure?" if {[cvsconfirm $mess .modbrowse] == "ok"} { if {$revtag != {}} { set revtag "-r \"$revtag\"" } if {$date != {}} { set date "-D \"$date\"" } if {$target != {}} { set target "-d \"$target\"" } set v [::viewer::new "CVS Export"] set cwd [pwd] $v\::do "$cvs -d \"$cvsroot\" export\ $revtag $date $target $kflag \"$module\"" } gen_log:log T "LEAVE" return } # This creates a patch file between two revisions of a module. If the # second revision is null, it creates a patch to the head revision. # If both are null the top two revisions of the file are diffed. proc cvs_patch { cvsroot module difffmt revtagA dateA revtagB dateB outmode outfile } { global cvs global tcl_version gen_log:log T "ENTER ($cvsroot $module $difffmt \"$revtagA\" \"$dateA\" \"$revtagB\" \"$dateB\" $outmode $outfile)" lassign {{} {}} rev1 rev2 if {$revtagA != {}} { set rev1 "-r \"$revtagA\"" } elseif {$dateA != {}} { set rev1 "-D \"$dateA\"" } if {$revtagB != {}} { set rev2 "-r \"$revtagB\"" } elseif {$dateA != {}} { set rev2 "-D \"$dateB\"" } if {$rev1 == {} && $rev2 == {}} { set rev1 "-t" } set commandline "$cvs -d \"$cvsroot\" patch $difffmt $rev1 $rev2 \"$module\"" if {$outmode == 0} { set v [viewer::new "CVS Patch"] $v\::do "$commandline" 0 patch_colortags } else { set e [exec::new "$commandline"] set patch [$e\::output] gen_log:log F "OPEN $outfile" if {[catch {set fo [open $outfile w]}]} { cvsfail "Cannot open $outfile for writing" .modbrowse return } if {$tcl_version >= 9.0} {chan configure $fo -profile tcl8} puts $fo $patch close $fo gen_log:log F "CLOSE $outfile" } gen_log:log T "LEAVE" return } # Simple diff for the workdir browser proc cvs_diff {} { global cvs gen_log:log T "ENTER" set commandline "$cvs diff" set v [viewer::new "CVS Diff"] $v\::do "$commandline" 0 patch_colortags gen_log:log T "LEAVE" return } # This finds the current CVS version number. proc cvs_version {} { global cvs global cvsglb gen_log:log T "ENTER" set cvsglb(cvs_version) "" set commandline "$cvs -v" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} output] if {$ret} { cvsfail $output return } foreach infoline [split $output "\n"] { if {[string match "Concurrent*" $infoline]} { set lr [split $infoline] set species [lindex $lr 3] regsub -all {[()]} $species {} species set version [lindex $lr 4] gen_log:log D "species $species version $version" } } gen_log:log D "Split: $species $version" regsub -all {\s*} $version {} version gen_log:log D "De-whitespaced: $species $version" set cvsglb(cvs_type) $species set cvsglb(cvs_version) $version gen_log:log T "LEAVE" } proc cvs_reconcile_conflict {args} { global cvscfg global cvs global tcl_version gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select some files to merge first!" return } foreach file $filelist { # Make sure its really a conflict - tkdiff will bomb otherwise regsub -all {\$} $file {\$} filename set commandline "$cvs -n -q update \"$filename\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} status] set logmode [expr {$ret ? {E} : {D}}] gen_log:log $logmode "$status" gen_log:log F "OPEN $file" set f [open $file] if {$tcl_version >= 9.0} {chan configure $f -profile tcl8} set match 0 while { [eof $f] == 0 } { gets $f line if { [string match "<<<<<<< *" $line] } { set match 1 break } } gen_log:log F "CLOSE $file" close $f if { [string match "C *" $status] } { # If its marked "Needs Merge", we have to update before # we can resolve the conflict gen_log:log C "$commandline" set commandline "$cvs update \"$file\"" set ret [catch {exec {*}$commandline} status] set logmode [expr {$ret ? {E} : {D}}] gen_log:log $logmode "$status" } elseif { $match == 1 } { # There are conflict markers already, dont update ; } else { cvsfail "$file does not appear to have a conflict." .workdir continue } # Invoke tkdiff with the proper option for a conflict file set tkdiff_command "$cvscfg(tkdiff) -conflict -o \"$filename\" \"$filename\"" gen_log:log C "$tkdiff_command" catch {exec {*}$tkdiff_command &} view_this } gen_log:log T "LEAVE" } proc cvs_gettaglist {filename parent} { global cvs global cvscfg global cwd set keepers "" set pid [pid] gen_log:log T "ENTER ($filename)" set filetail [file tail $filename] set commandline "$cvs -d $cvscfg(cvsroot) checkout \"$filename\"" # run a command, possibly creating the sandbox to play in set ret [cvs_sandbox_runcmd $commandline cmd_output] if {$cwd == $ret} { cvsfail $cmd_output $parent cd $cwd gen_log:log T "LEAVE ERROR ($cmd_output)" return $keepers } set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$ret} { cvsfail $view_this $parent cd $cwd gen_log:log T "LEAVE ERROR" return $keepers } set view_lines [split $view_this "\n"] set c 0 set l [llength $view_lines] foreach line $view_lines { if {[string match "symbolic names:" $line]} { gen_log:log D "line $c $line" for {set b [expr {$c + 1}]} {$b <= $l} {incr b} { set nextline [lindex $view_lines $b] if {[string index $nextline 0] == "\t" } { set nextline [string trimleft $nextline] gen_log:log D "$nextline" append keepers "$nextline\n" } else { gen_log:log D "$nextline - quitting" break } } } incr c } if {$keepers == ""} { set keepers "No Tags" } cd $cwd gen_log:log T "LEAVE" return "$keepers" } proc cvs_release {delflag args} { global cvs global cvscfg gen_log:log T "ENTER ($args)" set filelist [join $args] foreach directory $filelist { if {! [file isdirectory $directory]} { cvsfail "$directory is not a directory" .workdir return } # We're in the level above the directory to be released, so we don't necessarily # know its root read_cvs_dir "$directory/CVS" gen_log:log D "$directory: CVSROOT=$cvscfg(cvsroot)" set commandline "$cvs -d $cvscfg(cvsroot) -n -q update \"$directory\"" gen_log:log C "$commandline" set ret [catch {exec {*}$commandline} view_this] if {$view_this != ""} { view_output::new "CVS Check" $view_this set mess "\"$directory\" is not up-to-date." append mess "\nRelease anyway?" if {[cvsconfirm $mess .workdir] != "ok"} { return } } set commandline "$cvs -d $cvscfg(cvsroot) -Q release $delflag \"$directory\"" set ret [catch {exec {*}$commandline} view_this] gen_log:log C "$commandline" if {$ret != 0} { view_output::new "CVS Release" $view_this } } if {$cvscfg(auto_status)} { setup_dir } gen_log:log T "LEAVE" } proc cvs_rtag { cvsroot mcode b_or_t force oldtag newtag } { # # This tags a module in the repository. # Called by the tag commands in the Repository Browser # global cvs gen_log:log T "ENTER ($cvsroot $mcode $b_or_t $force $oldtag $newtag)" set command "$cvs -d \"$cvsroot\" rtag" if {$force == "remove"} { if {$oldtag == ""} { cvsfail "Please enter an Old tag name!" .modbrowse return 1 } append command " -d \"$oldtag\" \"$mcode\"" } else { if {$newtag == ""} { cvsfail "Please enter a New tag name!" .modbrowse return 1 } if {$b_or_t == "branch"} { append command " -b" } if {$force == "yes"} { append command " -F" } if {$oldtag != ""} { append command " -r \"$oldtag\"" } append command " \"$newtag\" \"$mcode\"" } set v [::viewer::new "CVS Rtag"] $v\::do "$command" gen_log:log T "LEAVE" } # dialog for cvs commit - called from workdir browser proc cvs_commit_dialog {} { global incvs global cvsglb global cvscfg global colorglb gen_log:log T "ENTER" if {! $incvs} { cvs_notincvs gen_log:log T "LEAVE" return } # If marked files, commit these. If no marked files, then # commit any files selected via listbox selection mechanism. # The cvsglb(commit_list) list remembers the list of files # to be committed. set cvsglb(commit_list) [workdir_list_files] # If we want to use an external editor, just do it if {$cvscfg(use_cvseditor)} { cvs_commit "" "" $cvsglb(commit_list) return } if {[winfo exists .commit]} { destroy .commit } toplevel .commit #grab set .commit frame .commit.top -borderwidth 8 frame .commit.vers frame .commit.down -relief groove -borderwidth 2 pack .commit.top -side top -fill x pack .commit.down -side bottom -fill x pack .commit.vers -side top -fill x label .commit.lvers -text "Specify Revision (-r) (usually ignore)" \ -anchor w entry .commit.tvers -relief sunken -textvariable version pack .commit.lvers .commit.tvers -in .commit.vers \ -side left -fill x -pady 3 frame .commit.comment pack .commit.comment -side top -fill both -expand 1 label .commit.comment.lcomment -text "Your log message" -anchor w button .commit.comment.history -text "Log History" \ -command history_browser text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ -bg $colorglb(textbg) -fg $colorglb(textfg) -exportselection 1 \ -wrap word -borderwidth 2 -setgrid yes # Explain what it means to "commit" files message .commit.message -justify left -aspect 500 -relief groove -bd 2 \ -text "This will commit changes from your \ local, working directory into the repository, recursively. \ For any local (sub)directories or files that are on a branch, \ your changes will be added to the end of that branch. \ This includes new or deleted files as well as modifications. \ For any local (sub)directories or files that have \ a non-branch tag, a branch will be created, and \ your changes will be placed on that branch. (CVS bug.) \ \ For all other (sub)directories, your changes will be \ added to the end of the main trunk." pack .commit.message -in .commit.top -padx 2 -pady 5 button .commit.ok -text "OK" \ -command { #grab release .commit wm withdraw .commit set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.apply -text "Apply" \ -command { set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list) commit_history $cvsglb(commit_comment) } button .commit.clear -text "ClearAll" \ -command { set version "" .commit.comment.tcomment delete 1.0 end } button .commit.quit \ -command { #grab release .commit wm withdraw .commit } .commit.ok configure -text "OK" .commit.quit configure -text "Close" grid columnconf .commit.comment 1 -weight 1 grid rowconf .commit.comment 1 -weight 1 grid .commit.comment.lcomment -column 0 -row 0 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew grid .commit.comment.history -column 0 -row 1 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 # Fill in the most recent commit message .commit.comment.tcomment insert end [string trimright $cvsglb(commit_comment)] wm title .commit "Commit Changes" wm minsize .commit 1 1 gen_log:log T "LEAVE" } # This changes a binary flag to ASCII proc cvs_ascii { args } { global cvs global incvs gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] gen_log:log D "Changing sticky flag" set command "$cvs admin -kkv" foreach f $filelist { append command " \"$f\"" } set cmd(cvscmd) [exec::new "$command"] auto_setup_dir $cmd(cvscmd) gen_log:log T "LEAVE" } # This converts an ASCII file to binary proc cvs_binary {args} { global cvs global incvs gen_log:log T "ENTER ($args)" if {! $incvs} { cvs_notincvs return 1 } set filelist [join $args] gen_log:log D "Changing sticky flag" set command "$cvs admin -kb" foreach f $filelist { append command " \"$f\"" } set cmd(cvscmd) [exec::new "$command"] auto_setup_dir $cmd(cvscmd) gen_log:log T "LEAVE" } # Revert a file to checked-in version by removing the local # copy and updating it proc cvs_revert {args} { global incvs global cvsglb global cvs gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { set mess "This will revert (discard) your changes to ** ALL ** files in this directory" } else { foreach file $filelist { append revert_output "\n$file" } set mess "This will revert (discard) your changes to:$revert_output" } append mess "\n\nAre you sure?" if {[cvsconfirm $mess .workdir] != "ok"} { return 1 } gen_log:log D "Reverting $filelist" # update -C option appeared in 1.11 set versionsplit [split $cvsglb(cvs_version) {.}] set major [lindex $versionsplit 1] set command "$cvs update" if {$major < 11} { gen_log:log F "DELETE $filelist" file delete $filelist } else { append command " -C" } foreach f $filelist { append command " \"$f\"" } set cmd(cvscmd) [exec::new "$command"] auto_setup_dir $cmd(cvscmd) gen_log:log T "LEAVE" } # Reads a CVS "bookkeeping" directory proc read_cvs_dir {dirname} { global module_dir global cvscfg global cvsglb global cvs global current_tagname gen_log:log T "ENTER ($dirname)" if {$cvsglb(cvs_version) == ""} { cvs_version } set current_tagname "trunk" if {[file isdirectory $dirname]} { if {[file isfile [file join $dirname Repository]]} { gen_log:log F "OPEN CVS/Repository" set f [open [file join $dirname Repository] r] gets $f module_dir close $f gen_log:log D " MODULE $module_dir" if {[file isfile [file join $dirname Root]]} { gen_log:log F "OPEN CVS/Root" set f [open [file join $dirname Root] r] gets $f cvscfg(cvsroot) close $f # On a PC, the cvsroot can be like C:\DosRepository. # This makes that workable. regsub -all {\\} $cvscfg(cvsroot) {\\\\} cvscfg(cvsroot) gen_log:log D " cvsroot: $cvscfg(cvsroot)" } if {[file isfile [file join $dirname Tag]]} { gen_log:log F "OPEN CVS/Tag" set f [open [file join $dirname Tag] r] gets $f current_tagname close $f # T = branch tag, N = non-branch, D = sticky date set current_tagname [string range $current_tagname 1 end] gen_log:log D " BRANCH TAG $current_tagname" } } else { cvsfail "Repository file not found in $dirname" .workdir return 0 } } else { cvsfail "$dirname is not a directory" .workdir return 0 } set cvsglb(vcs) cvs set cvsglb(root) $cvscfg(cvsroot) gen_log:log T "LEAVE (1)" return 1 } # For the module browser. Reads CVSROOT/modules proc parse_cvsmodules {cvsroot} { global cvs global modval global modtitle global cvscfg gen_log:log T "ENTER ($cvsroot)" # Clear the arrays catch {unset modval} catch {unset modtitle} # We have to use cvs to access the modules file set cvscfg(cvsroot) $cvsroot set command "$cvs -d \"$cvsroot\" checkout -p CVSROOT/modules" set cmd(cvs_co) [exec::new $command] if {[info exists cmd(cvs_co)]} { set cat_modules_file [$cmd(cvs_co)\::output] $cmd(cvs_co)\::destroy catch {unset cmd(cvs_co)} } # Unescape newlines, compress repeated whitespace, and remove blank lines regsub -all {(\\\n|[ \t])+} $cat_modules_file " " cat_modules_file regsub -all {\n\s*\n+} $cat_modules_file "\n" cat_modules_file foreach line [split $cat_modules_file "\n"] { if {[string index $line 0] == {#}} { #gen_log:log D "Comment: $line" if {[string index $line 1] == {D} || [string index $line 1] == {M}} { set text [split $line] set dname [lindex $text 1] set modtitle($dname) [lrange $text 2 end] #gen_log:log D "Directory: {$dname} {$modtitle($dname)}" } } else { set text [split $line] set modname [lindex $text 0] set modstring [string trim [join [lrange $text 1 end]]] # A "#D ..." or "#M ..." entry _always_ overrides this default if {! [info exists modtitle($modname)]} { set modtitle($modname) $modstring } # Remove flags except for -a. Luckily alias modules can't have # any other options. regsub -- {^((-l\s*)|(-[ioestud]\s+((\\\s)|\S)+\s*))+} \ $modstring {} modstring if {$modname != ""} { set modval($modname) $modstring } } } gen_log:log T "LEAVE" } # Organizes cvs modules into parents and children proc cvs_modbrowse_tree { mnames node } { global cvscfg global cvsglb global modval global modtitle global dcontents #global Tree gen_log:log T "ENTER ($mnames $node)" if {! [info exists cvscfg(aliasfolder)]} { set cvscfg(aliasfolder) false } set tv ".modbrowse.treeframe.pw" foreach mname [lsort $mnames] { gen_log:log D "{$mname} {$modval($mname)}" set dimage "mod" # The descriptive title of the module. If not specified, modval is used. set title $modval($mname) if {[info exists modtitle($mname)]} { set title $modtitle($mname) gen_log:log D "* modtitle($mname) {$title}" } if {[string match "-a *" $modval($mname)]} { # Its an alias module regsub {\-a } $modtitle($mname) "Alias for " title # If we want all the aliases in a folder, do this if {$cvscfg(aliasfolder)} { gen_log:log D "path=Aliases/$mname pathtop=Aliases pathroot=/Aliases" if {! [$tv exists "AliasTop"]} { gen_log:log D "Making Aliases" gen_log:log D "$tv insert {} end -id AliasTop -image adir -values {Aliases Aliases}" $tv insert {} end -id AliasTop -image "adir" -values [list Aliases Aliases] } gen_log:log D "$tv insert AliasTop end -id $mname -image amod -values {$mname $title}" $tv insert AliasTop end -id $mname -image "amod" -values [list "$mname" "$title"] } else { # Otherwise, it just goes in the list gen_log:log D "$tv insert {} end -id $mname $mname -image amod -values {$mname $title}" $tv insert {} end -id $mname $mname -image "amod" -values [list "$mname" "$title"] } continue } elseif {[string match "* *" $modval($mname)]} { # The value isn't a simple path gen_log:log D "Found spaces in modval($mname) $modval($mname)" } elseif {[string match "*/*" $modval($mname)]} { gen_log:log D "Set image to dir because $modval($mname) contains a slash" set dimage dir set path $modval($mname) if {[llength $modval($mname)] > 1} { regsub { &\S+} $path {} path } set pathitems [file split $path] set pathdepth [llength $pathitems] set pathtop [lindex [file split $path] 0] set pathroot [file join $node $pathtop] set pathroot "$pathroot" if {[info exists modtitle($pathtop)]} { set title $modtitle($pathtop) gen_log:log D "* Using pathtop * modtitle($pathtop) {$title}" } elseif {[info exists modtitle($path)]} { set title $modtitle($path) gen_log:log D "* Using path * modtitle($path) {$title}" } else { gen_log:log D "* No modtitle($path)" } gen_log:log D "path=$path pathtop=$pathtop pathroot=$pathroot" if {! [$tv exists $pathroot]} { gen_log:log D "1 Making $pathtop for something with a \"/\" in its module name" if {[info exists modval($pathtop)]} { set dimage mdir } gen_log:log D "$tv insert {} end -id $pathroot -image dir -values {$pathtop $title}" $tv insert {} end -id "$pathroot" -image dir -values [list "$pathtop" "$title"] } set col0_width [expr {($pathdepth + 1) * ($cvsglb(mod_iconwidth) * 2)}] # FIXME: we want to trigger this when a folder is opened #$tv column #0 -width $col0_width set pathroot "" for {set i 1} {$i < $pathdepth} {incr i} { set newnode [lindex $pathitems $i] set pathroot [file join $pathroot [lindex $pathitems [expr {$i -1} ]]] set newpath [file join "/" $pathroot $newnode] set namepath [string range $newpath 1 end] if {[info exists modtitle($namepath)]} { set title $modtitle($namepath) } elseif {[info exists modtitle($newnode)]} { set title $modtitle($newnode) } elseif {[info exists modtitle($mname)]} { set title $modtitle($mname) } if {! [info exists dcontants($pathroot)]} { set modvalpath [file join "/" $modval($mname)] regsub { &\S+} $modvalpath {} modvalpath if {$modvalpath == $newpath} { set newnode $mname } lappend dcontents($pathroot) $newnode if {[info exists modval($newnode)]} { gen_log:log D "3 Making $newnode as a leaf" set dimage mod } else { gen_log:log D "2 Making $newnode as an intermediate node" set dimage dir } if {! [$tv exists $newpath]} { gen_log:log D "$tv insert /$pathroot end -id $newpath -image $dimage -values {$newnode $title}" $tv insert "/$pathroot" end -id $newpath -image $dimage -values [list "$newnode" "$title"] } } } # If we got here we just did a leaf, so break out and dont put it # at the toplevel too. continue } set treepath [file join $node $mname] if {[info exists dcontents($treepath)]} { gen_log:log D " Already handled $treepath" continue } if {[info exists modval($mname)] && ($dimage != "amod")} { set dimage mdir } gen_log:log D "$tv insert {} end -id $mname -image mod -values {$mname $title}" $tv insert {} end -id $mname -image mod -values [list "$mname" "$title"] } # Move the Aliases to the top if {[$tv exists AliasTop]} { gen_log:log D "$tv detach AliasTop" $tv detach AliasTop gen_log:log D "$tv move AliasTop {} 0" $tv move AliasTop {} 0 } update idletasks gather_mod_index gen_log:log T "LEAVE" } proc cvs_lock {do files} { global cvs if {$files == {}} { cvsfail "Please select one or more files!" .workdir return } switch -- $do { lock { set commandline "$cvs admin -l $files"} unlock { set commandline "$cvs admin -u $files"} } set lock_cmd [::exec::new "$commandline"] auto_setup_dir $lock_cmd } # Sends directory "." to the directory-merge tool # Find the bushiest file in the directory and diagram it. # Called from the workdir browser proc cvs_directory_merge {} { global cvscfg global cvs global incvs gen_log:log T "ENTER" if {! $incvs} { cvs_notincvs return 1 } set files [glob -nocomplain -types f -- .??* *] regsub -all {\$} $files {\$} files set commandline "$cvs -d $cvscfg(cvsroot) log $files" gen_log:log C "$commandline" catch {exec {*}$commandline} raw_log set log_lines [split $raw_log "\n"] foreach logline $log_lines { if {[string match "Working file:*" $logline]} { set filename [lrange [split $logline] 2 end] set nbranches($filename) 0 continue } if {[string match "total revisions:*" $logline]} { set nrevs($filename) [lindex [split $logline] end] continue } if { [regexp {^\t[-\w]+: .*\.0\.\d+$} $logline] } { incr nbranches($filename) } } set bushiestfile "" set mostrevisedfile "" set nbrmax 0 foreach br [array names nbranches] { if {$nbranches($br) > $nbrmax} { set bushiestfile $br set nbrmax $nbranches($br) } } set nrevmax 0 foreach br [array names nrevs] { if {$nrevs($br) > $nrevmax} { set mostrevisedfile $br set nrevmax $nrevs($br) } } gen_log:log F "Bushiest file \"$bushiestfile\" has $nbrmax branches" gen_log:log F "Most Revised file \"$mostrevisedfile\" has $nrevmax revisions" # Sometimes we don't find a file with any branches at all, so bushiest # is empty. Fall back to mostrevised. All files have at least one rev. if {[string length $bushiestfile] > 0} { set filename $bushiestfile } else { set filename $mostrevisedfile } ::cvs_branchlog::new "CVS,dir" "$filename" gen_log:log T "LEAVE" } # Sends files to the CVS branch browser one at a time. Called from # workdir browser proc cvs_branches {args} { global cvs gen_log:log T "ENTER ($args)" set filelist [join $args] if {$filelist == ""} { cvsfail "Please select one or more files!" .workdir return } foreach file $filelist { ::cvs_branchlog::new "CVS,loc" "$file" } gen_log:log T "LEAVE" } namespace eval ::cvs_branchlog { variable instance 0 proc new {how filename} { variable instance set my_idx $instance incr instance namespace eval $my_idx { set my_idx [uplevel {concat $my_idx}] set filename [uplevel {concat $filename}] set how [uplevel {concat $how}] variable filename variable command variable cmd_log variable lc variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable revmergefrom variable tags variable revbranches variable branchrevs variable logstate variable sys variable loc variable cwd gen_log:log T "ENTER [namespace current]" set sys_loc [split $how {,}] set sys [lindex $sys_loc 0] set loc [lindex $sys_loc 1] switch -- $sys { # loc is "loc" (local, i.e. workdir), "rep" (repository), or "dir" (joincanvas) CVS { if {$loc eq "dir"} { # Invoking the joincanvas set newlc [joincanvas::new $filename $how [namespace current]] } else { set newlc [branch_diagram::new $filename $how [namespace current]] } } RCS { set newlc [branch_diagram::new $filename "RCS,loc" [namespace current]] } } # ln is the namespace, lc is the canvas set ln [lindex $newlc 0] set lc [lindex $newlc 1] proc abortLog { } { variable cmd_log variable lc catch {$cmd_log\::abort} busy_done $lc pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal } proc reloadLog { } { global cvs global logcfg global cvsglb variable filename variable command variable cmd_log variable lc variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable revmergefrom variable revtags variable revbtags variable revbranches variable branchrevs variable logstate variable sys variable loc gen_log:log T "ENTER" catch { $lc.canvas delete all } catch { unset revwho } catch { unset revdate } catch { unset revtime } catch { unset revlines } catch { unset revstate } catch { unset revcomment } catch { unset revmergefrom } catch { unset revtags } catch { unset revbtags } catch { unset revbranches } catch { unset branchrevs } set cwd [pwd] switch -- $sys { # loc is "loc" (local, i.e. workdir), "rep" (repository), or "dir" (mergecanvas) CVS { if {$loc eq "dir"} { set command "$cvs log \"$filename\"" } else { set command "$cvs " if {$loc eq "rep"} { append command " -d $cvsglb(root) " # FIXME: Refresh won't work in the temp sandbox so for now # disable the button $lc.refresh configure -state disabled } append command " log" if {! $logcfg(show_branches)} { append command " -b" } } append command " \"$filename\"" } RCS { set command "rlog \"$filename\"" } } pack forget $lc.close pack $lc.stop -in $lc.down.closefm -side right $lc.stop configure -state normal busy_start $lc set logstate {R} set cmd_log [::exec::new $command {} 0 [namespace current]::parse_cvslog] # wait for it to finish so our arrays are all populated $cmd_log\::wait $cmd_log\::destroy pack forget $lc.stop pack $lc.close -in $lc.down.closefm -side right $lc.close configure -state normal [namespace current]::cvs_sort_it_all_out gen_log:log T "LEAVE" return } proc parse_cvslog { exec logline } { # # Splits the rcs file up and parses it using a simple state machine. # global module_dir global inrcs global logcfg variable filename variable lc variable ln variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable revmergefrom variable revtags variable revbtags variable revbranches variable branchrevs variable logstate variable revkind variable rnum variable rootbranch variable revbranch #gen_log:log T "ENTER ($exec $logline)" #gen_log:log D "$logline" if {$logline != {}} { switch -exact -- $logstate { {R} { # Look for the first text line which should give the file name. if {[string match {RCS file: *} $logline]} { # I think the whole path to the "RCS file" from the log isn't # really what we want here. More like module_dir, so we know # what to feed to cvs rdiff and rannotate. set fname [string range $logline 10 end] set fname [file tail $fname] if {[string range $fname end-1 end] == {,v}} { set fname [string range $fname 0 end-2] } set fname [file join $module_dir $fname] if {$inrcs && [file isdirectory RCS]} { set fname [file join RCS $fname] } $ln\::ConfigureButtons $fname } elseif {[string match {Working file: *} $logline]} { # If we care about a working copy we need to look # at the name of the working file here. It may be # different from what we were given if we were invoked # on a directory. #if {$localfile != "no file"} { set localfile [string range $logline 14 end] #} } elseif {$logline == "symbolic names:"} { # FIXME: old RCS can have a tag on this line set logstate {T} } } {T} { # Any line with a tab leader is a tag if { [string index $logline 0] == "\t" } { set parts [split $logline {:}] set tagstring [string trim [lindex $parts 0]] set rnum [string trim [lindex $parts 1]] set parts [split $rnum {.}] if {[expr {[llength $parts] & 1}] == 1} { set parts [linsert $parts end-1 {0}] set rnum [join $parts {.}] } if {[lindex $parts end-1] == 0} { # Branch tag if {$logcfg(show_branches)} { set rnum [join [lreplace $parts end-1 end-1] {.}] set revkind($rnum) "branch" set revbranch($tagstring) $rnum set rbranch [join [lrange $parts 0 end-2] {.}] set rootbranch($tagstring) $rbranch lappend revbtags($rnum) $tagstring lappend revbranches($rbranch) $rnum } } else { # Ordinary symbolic tag lappend revtags($rnum) $tagstring # Is it possible that this tag is the only surviving # record that this revision ever existed? if {[llength $parts] == 2} { # A trunk revision but not necessarily 1.x because CVS allows # the first part of the revision number to be changed. We have # to assume that people always increase it if they change it # at all. lappend branchrevs(trunk) $rnum } else { if {$logcfg(show_branches)} { set rbranch [join [lrange $parts 0 end-1] {.}] lappend branchrevs($rbranch) $rnum } } # Branches for this revision may have already been created # during tag parsing foreach "revwho($rnum) revdate($rnum) revtime($rnum) revlines($rnum) revstate($rnum) revcomment($rnum)" \ {{} {} {} {} {dead} {}} \ { break } } } else { if {$logline == "description:"} { set logstate {S} } } } {S} { # Look for the line that starts a revision message. if {$logline == "----------------------------"} { set logstate {V} } } {V} { if {! [string match "revision *" $logline] } { # Did they put just the right number of dashes in the comment # to fool us? set logstate {L} } else { # Look for a revision number line set rnum [lindex [split $logline] 1] set parts [split $rnum {.}] set revkind($rnum) "revision" if {[llength $parts] == 2} { # A trunk revision but not necessarily 1.x because CVS allows # the first part of the revision number to be changed. We have # to assume that people always increase it if they change it # at all. lappend branchrevs(trunk) $rnum } else { lappend branchrevs([join [lrange $parts 0 end-1] {.}]) $rnum } # Branches for this revision may have already been created # during tag parsing foreach "revwho($rnum) revdate($rnum) revtime($rnum) revlines($rnum) revstate($rnum) revcomment($rnum)" \ {{} {} {} {} {} {}} \ { break } set logstate {D} } } {D} { # Look for a date line. This also has the name of the author. set parts [split $logline ";"] foreach p $parts { set eqn [split $p ":"]; set eqname [string trim [lindex $eqn 0]] set eqval [string trim [join [lrange $eqn 1 end] ":"]] switch -exact -- $eqname { {date} { set revdate($rnum) [lindex $eqval 0] set revtime($rnum) [lindex $eqval 1] gen_log:log D "date $revdate($rnum)" gen_log:log D "time $revtime($rnum)" } {author} { set revwho($rnum) $eqval } {lines} { set revlines($rnum) $eqval } {state} { set revstate($rnum) $eqval } {mergepoint} { set revmergefrom($rnum) $eqval gen_log:log D "mergefrom $revmergefrom($rnum)" } } } set logstate {L} } {L} { # See if there are branches off this revision if {[string match "branches:*" $logline]} { foreach br [lrange $logline 1 end] { set br [string trimright $br {;}] lappend revbranches($rnum) $br } } elseif {$logline == {----------------------------}} { set logstate {V} } elseif {$logline ==\ {=============================================================================}} { set logstate {X} } else { append revcomment($rnum) $logline "\n" } } {X} { # ignore any further lines } } } if {$logstate == {X}} { gen_log:log D "********* Done parsing *********" } return [list {} $logline] } proc cvs_sort_it_all_out {} { global cvscfg global module_dir variable filename variable sys variable lc variable ln variable revwho variable revdate variable revtime variable revlines variable revstate variable revcomment variable revmergefrom variable revtags variable revbtags variable revbranches variable branchrevs variable logstate variable rnum variable rootbranch variable revbranch variable revkind gen_log:log T "ENTER" if {[llength [array names revkind]] < 1} { cvsfail "Log empty. Check error status of cvs log command" $lc.close invoke return } set revkind(1) "root" foreach r [lsort -dictionary [array names revkind]] { gen_log:log D "revkind($r) $revkind($r)" } # Sort the revision and branch lists and remove duplicates foreach r [array names branchrevs] { set branchrevs($r) \ [lsort -unique -decreasing -dictionary $branchrevs($r)] #gen_log:log D "branchrevs($r) $branchrevs($r)" } # Create a fake revision to be the trunk branchtag set revbtags(1) "trunk" set branchrevs(1) $branchrevs(trunk) foreach r [array names revbranches] { set revbranches($r) \ [lsort -unique -dictionary $revbranches($r)] #gen_log:log D "revbranches($r) $revbranches($r)" } # Find out where to put the working revision icon (if anywhere) # FIXME: we don't know that the log parsed was derived from the # file in this directory. Maybe we should check CVS/{Root,Repository}? # Maybe this check should be done elsewhere? if {$sys != "rcs" && $filename != "no file"} { gen_log:log F "Reading CVS/Entries" set basename [file tail $filename] if {![catch {open [file join \ [file dirname $filename] {CVS}\ {Entries}] \ {r}} entries]} \ { foreach line [split [read $entries] "\n"] { # What does the entry for an added/deleted file look like? set parts [split $line {/}] if {[lindex $parts 1] == $basename} { set rnum [lindex $parts 2] if {[string index $rnum 0] == {-}} { # File has been locally removed and cvs removed but not # committed. set revstate(current) {dead} set rnum [string range $rnum 1 end] } else { set revstate(current) {Exp} } set root [join [lrange [split $rnum {.}] 0 end-1] {.}] gen_log:log D "root $root" set tag [string range [lindex $parts 5] 1 end] if {$rnum == {0}} { # A locally added file has a revision of 0. Presumably # there is no log and no revisions to show. # FIXME: what if this is a resurrection? lappend branchrevs(trunk) {current} } elseif {[info exists rootbranch($tag)] && \ $rootbranch($tag) == $rnum} { # The sticky tag specifies a branch and the branch's # root is the same as the source revision. Place the # you-are-here box at the start of the branch. lappend branchrevs($revbranch($tag)) {current} } else { if {[catch {info exists $branchrevs($root)}] == 0} { if {$rnum == [lindex $branchrevs($root) 0]} { # The revision we are working on is the latest on its # branch. Place the you-are-here box on the end of the # branch. set branchrevs($root) [linsert $branchrevs($root) 0\ {current}] } else { # Otherwise we will place it as a branch off the # revision. if {![info exists revbranches($rnum)]} { set revbranches($rnum) {current} } else { set revbranches($rnum) [linsert $revbranches($rnum)\ 0 {current}] } } } } # We may have added a "current" branch. We have to set all its # stuff or we'll get errors foreach {revwho(current) revdate(current) revtime(current) revlines(current) revcomment(current) branchrevs(current) revbtags(current)} \ {{} {} {} {} {} {} {}} \ { break } break } } close $entries } } gen_log:log D "" foreach a [array names branchrevs] { gen_log:log D "branchrevs($a) $branchrevs($a)" } gen_log:log D "" foreach a [array names revbranches] { gen_log:log D "revbranches($a) $revbranches($a)" } gen_log:log D "" foreach a [array names revbtags] { gen_log:log D "revbtags($a) $revbtags($a)" } gen_log:log D "" foreach a [array names revtags] { gen_log:log D "revtags($a) $revtags($a)" } # We only needed these to place the you-are-here box. catch {unset rootbranch revbranch} $ln\::DrawTree now } [namespace current]::reloadLog return [namespace current] } } } tkrev_9.6.1/tkrev/bitmaps/0000775000175000017500000000000015034253754016056 5ustar dorothyrdorothyrtkrev_9.6.1/tkrev/bitmaps/link_okml.png0000664000175000017500000000035014723165002020531 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE-<tRNS@fbKGDHtIME 27);IDATc``dA%E0CHPg !A(@0R`T > 8EǦIENDB`tkrev_9.6.1/tkrev/bitmaps/link_modol.png0000664000175000017500000000036114723165002020703 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEtRNS@fbKGD LtIME 27)DIDATc``dA%EKHPP0r0 Cـh 2h3@\ VޟEIENDB`tkrev_9.6.1/tkrev/bitmaps/modbrowse_svn.png0000664000175000017500000000120514723165002021441 0ustar dorothyrdorothyrPNG  IHDR(( H_ cHRMz&u0`:pQ<PLTEoooȔве歿ۖуɣ؅ʠهˮܻݧٛӏ鞴Ռͬ恝ȑϼ䦹؊!tRNS@fbKGDHtIME 27)IDAT8ݒV0&"\7P&*73)՟9_&w RzZ$B2ᑝ͙qXr8)WJp9ڨZ:G]t[IDATc` 26R2 q"V* ERCbnU #5tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/unedit.png0000664000175000017500000000060714723165002020047 0ustar dorothyrdorothyrPNG  IHDRW? cHRMz&u0`:pQ<cPLTE椤uuu111_i>>>lq}vz\dvt ggg___mmmJOZ^_artRNS@fbKGDHtIME 27)IDATӕI EՈ SjoCDb3LA2j]HYV̬e@`̏@\=3 ʖݾ>gRqc"#sL,ӱ^sm7l8O‘IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_ok.png0000664000175000017500000000037414723165002020224 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEqtRNS@fbKGD-tIME 27)-IDATc` RRR2 PqBg`AgB,ҒctEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_merge.png0000664000175000017500000000044214723165002020706 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEstRNS@fbKGD-tIME 27)MIDATc` RRR3 'R"*f"..`FK*a"dvAe LtutEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/link_ques.png0000664000175000017500000000034414723165002020547 0ustar dorothyrdorothyrPNG  IHDR  cHRMz&u0`:pQ< PLTE{AtRNS@fbKGDHtIME 27):IDATc` u```]6r Q@.C&P!d?@0 [IVIENDB`tkrev_9.6.1/tkrev/bitmaps/files.png0000664000175000017500000000043314723165002017656 0ustar dorothyrdorothyrPNG  IHDR'Ն cHRMz&u0`:pQ<bKGD#2tIME 26sXsIDAT(ϝ[ gMgAlBh%IRU!Z\Ʈ*?(]! r0u yr1sn3lkbCX;]׌?g93tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/import.png0000664000175000017500000000056314723165002020072 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<*PLTEooo܎HPQtRNS@fbKGD-tIME 27)IDATc``TE0STI @q1EJL)bD[T!0S%-sY^Tt޲@m >wn0Ul޽ Rb"r#e@r g (AtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/back.png0000664000175000017500000001036714723165002017463 0ustar dorothyrdorothyrPNG  IHDR zTXtRaw profile type exifxmP 0L8NJݠHE2CǙ_tFEŴf4iԑXv/YvV~:BKӘ?$Б Xg/"CAԂɁCaoem\ny6e DxY_ͪiCCPICC profilex}=HPOSED2T'" EjVL^MGbYWWAqvpRtK -bxsx>@fuMT".fb+B`ØeIRuOTwQg98 & ٴ aVUsq.Hu76өy0XhcYԈ#SXY+WYuZ#H`K BA%a#JN}C_"B9PZI/):_c5>v |Rf?Iз \\4e ٔ])HK3, yskHӬ7!0Vuwwߞ~Wra xiTXtXML:com.adobe.xmp .ȤbKGDC pHYs  tIME -l;IDAT8; 1EOYg3]ٌ})! nRwy7~4)'hc [4J w RɄ\&&`(z-F3dZF`=e,^tqO`*J/L=#4UIENDB`tkrev_9.6.1/tkrev/bitmaps/remove.png0000664000175000017500000000040414723165002020047 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEHB~0tRNS@fbKGDf |dtIME 27)%IDATc`* S La0DeA 6*_k&#tEXtcomment Imported from XPM image: EIENDB`tkrev_9.6.1/tkrev/bitmaps/branchtag.png0000664000175000017500000000047114723165002020507 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEE심3tRNS@fbKGD-tIME 26sXjIDATU΋ +h=g<o-[9 7Ͼf\bH6l5kmIv6DOK!Č.^[#k v1tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_mod.png0000664000175000017500000000044514723165002020174 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEJ){StRNS@fbKGDaf}tIME 26sXPIDATc``Fec#0KXQPPADCRC Ad3#0L36N3Čdcc3TFP׽XtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/loop-ball.png0000664000175000017500000000055114723165002020436 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<*PLTEkkk^^^H܎)%tRNS@fbKGDHtIME 27)IDATc`,F0$54)-M,1A,% S) 54,)@=44LC5 R8a.JqH ^6ݻ;\3::z(gB Jg*\Ā"y/ tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_rcs.png0000664000175000017500000000100314723165002020173 0ustar dorothyrdorothyrPNG  IHDR e cHRMz&u0`:pQ<PLTEgCZ1nbHY XX@\<|B`aQ.1q I)iY"*DPYVSK"`f瀚a`l$-a`lb 001簰 @fĶ 4g y1tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/link.png0000664000175000017500000000027714723165002017517 0ustar dorothyrdorothyrPNG  IHDR  & cHRMz&u0`:pQ<bKGD#2tIME 27)9IDAT;0ql4гȻB:%[QG^ vUHIENDB`tkrev_9.6.1/tkrev/bitmaps/branch.png0000664000175000017500000000050714723165002020013 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEEPJ]tRNS@fbKGDHtIME 26sXxIDATE 0D%XSH';$ES=%ܩY9,.5@jبe!o[/#DQc{OLg@Lna7G tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/folderopen.png0000664000175000017500000000101514723165002020706 0ustar dorothyrdorothyrPNG  IHDR(( H_ cHRMz&u0`:pQ<PLTE&&'ooo׸ƂG;saabZZZbbbkkk| tr{zqqpo}}|wзĶ|jdH}}}󎍄񭚔w༚ܘvYR0}{q߈~qyɂ&A2tRNS@fbKGDHtIME 26sXIDAT80N("hbI#)S /'!U~tToEtQɞuP72N/ɝ$Ԃ2;)]4S,rB hZˠZW]yt{`/a8rx Ml..25 ;AOY^o #0Da,D!r T}o` YIENDB`tkrev_9.6.1/tkrev/bitmaps/lightning.png0000664000175000017500000000041514723165002020537 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTE\$ZtRNS@fbKGDHtIME 27)]IDATu  .P ( 3I.//BVWI,َqcUCVOZ vMQFV}OggɌ䈐JB8t^hzw$ '.#! nM=.WOFo֓ʒORX07T~;Lk@4(jWŮy{hx\Km8Zf#),+''&;9.:]-hL1vaZzu_[lXv)P;+_䴱nHRUzfȸYA<ျ|\0Ҽ㧛@(1T:i Z?2\:A;T鲟uѵ&1NcP`ΛfL<6DNj,.v1,XְAtp'_A-IEb2Ytյ*6a*IV:ksT?/&ݶwFzr@0Uk̍G5]^gMV} Ao+'U0bs ANnFaT]$BQ=wctVe8A'LdL\GףSHrƒz3(y)lL)6277i(t41ʏ5ݛ9>y-MFV@tRNS@fbKGDHtIME 27)IDATx{\WA K0܀b1abA T` B@}"+ oޠXo - E_ZuK]nWWۭo[>g gdrf<;kT* txt +[nӰMv[ @e(B37P~fd/ ޼=zYY;H0,$OGQ\α"PkҤʹqS DđxPlذ sP!%fBT2f#}r btǒpjSSSK]Sc]S$FcSP:?AN膷Wo dt o[30 \2rt( e4tIy-+?F>կ^H{p;pmδgfgg6֭{Ha<5tǐ2Gw65ijIhjr<;m FoeoXEy\l_{yE͛s󢢢ӹyms85㘈+FA +5 yJKZ[K)k'gӹ!1*6fŭ߰eՇ~E?&89[ݎhHiIhjuC:-E@ "iKBޏ.`ܛ\/~x"Շ!*0!u"[r-zuCCt:M%xHM-&S޳sJBEQ.l p]&ޞy񣋁`E$PP$!01N1;kkuCK}:pߥa9 ]^o[#ds''i/~/~ F`Լ]kA)t.34tOOMLh :](WNO @<~@dp 3>x>†+#W(Y0Ё}8/e8975ii_]Vtie47\7^G. W;.s?Ԕ|Yܼ+#dd~?KvV###h(_ 8sgngSfgiJDWWU߾ߗ^;ԭC^d3:(Z:@r˅s} ]_<=B@ 7afK^I(Ԙ"%S䚛.xM-ɭI@[nݾ};.>>e C&smJrXnw'Mi&4\&ΨJuܘ:tq=$פ /פ6V>{woܹsƍYsrl gyg7*Ɲ;>dq(59#/8c6.=d:w2i{MbcҘi󶝣G}P}½[twCsfו|>.X܁"i,m v+v3=|Yۏ۴yC0e} C͂ vw-J@ݴꛣV[.^R>mX=挙3fϯh+QOۈпD`AХ66ݿ{[^foc ]l"J:@0.sph3'ʾ)z4`7Fʇe8A:;G vxxs^Lw;N{mjz1w3Avģ 8 3(i7";h ܽwt6vB'JZzzZ{eeee' .8~`Or4G,룣 vܺ^=0Ħ;9;ë9@qa>8vReD F;{ܜrGٱc>!NۘJh+h)L5qEcwgmIX>C,+h,jEEHF0m5ĈJMy|gj>;%d{K,mp,[ZRNRRZN"#hp!J)j$eŪ@U_}_ Xg9j֖6իmniAj;|y[[J #E2,*ZVIi ŠP|ukmz  vի+Zh WۖԚJJJDҔSL0Ʒ"[oi܌E< __a T4۸G9e$Sc21;>Kq^ٹj쯶ttS֎h0'uUUuN0!@4~>$.(ΎFnބ,lpbu8OޟZW[[.r/tZBK9R7KP3vdgeBbhlMjwʕ|-[eHyi︤Y>yJ^t 0vжfeFg5 w̳oQ G/;O0R9\qA~sx0cD%,>mۙ^Xښ0op<}}_7<r^${ zF 44#1vW$I~fD3{yqDb_ЭiRϓf4GqLi>0 :ƐoQS&{lEw>HkQ TS=y*411HBc4)/' {\A J&J85HЭyӝJEI Iø8@EAIzyJF*dta< K%J5&\fvV"92JpexJz F A=Iq#L ի5~{yL|6`T L_HB*I @ҕ{JB s>I a|J{z<`rU(3➞"?2*_SAׁ+CzzB2Bz Eqm4=HG"H J `$z!# Ǖ0%7ڠm%9#IDcKJ"BCmURҰ/W)JEJU8L"p}X; {.8 0@ ,8u^jv3 &!88T@+$U$8u)t4!njABp{&[S0)Puu )Z^7Z0 J4p7h3ꛧ(4* ON> ''TK7O %Kz SB7cIp._QX$ѐMuw;:ttwgPѓ*4@V΁$4Ì~sa4Ud0,d8 RP(Rf Z G6O$ \b6~H+GFFIedE\Mz[~}൑x`qǺVhI |IR~gӡp# >p-zX>`V8=B7+LRs C9@i&XΑJ-#+>Y7zd::h \S*1Xf %] RS*Tpb0 q C$a u]>.nEq4Vfي9vܸF wk%KKK3|g܉tEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/amod.png0000664000175000017500000000036114723165002017474 0ustar dorothyrdorothyrPNG  IHDR  cHRMz&u0`:pQ< PLTEooo333---݇bKGD LtIME 26sX/IDATc`@V90pZAʩq SXj  j/y LtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/conflict.png0000664000175000017500000000047114723165002020357 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEH.&tRNS@fbKGD-tIME 26sXjIDATm 0# &KV~ |b"hǓbH[#=&Eqn8RXf*&nRáQI7 o6' tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/mod.png0000664000175000017500000000042314723165002017332 0ustar dorothyrdorothyrPNG  IHDR  cHRMz&u0`:pQ<PLTEoooR#bKGD ٥tIME 27)BIDATc`@BP$RKq/ьf)@[{Z b0W4; -Q G +tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_ex.png0000664000175000017500000000042214723165002020221 0ustar dorothyrdorothyrPNG  IHDR  & cHRMz&u0`:pQ<bKGD@Xd tIME 27)jIDATӅP "K:ю:f&=\ 'lFbeaP 26RKr' [401t#.U>2bQFlE2O %tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_mod.png0000664000175000017500000000043414723165002020367 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEytRNS@fbKGD-tIME 27)JIDATc` RRR3 'k""f:"`khh*& B,@ +^tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/fileedit.png0000664000175000017500000000050314723165002020337 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<$PLTE&&'׸G;ntRNS@fbKGDHtIME 26sX_IDATc`dFe8[P".@b  #Xt2,2'D%$ L0)((p TԥQ&*.3nPm!QSHlcuztEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/wm_TkCVS.png0000664000175000017500000001330014723165002020206 0ustar dorothyrdorothyrPNG  IHDR@@iq cHRMz&u0`:pQ<bKGD IDATxy}?UU]]#͢6cb6l|;ǼmKsߟI>+ʗ' T^cx ed a6q&#i!J EBx)rs I\R2~o~ްcpBJS+J,k4ӤsHYXRf˦ Sյ7_".7n̊ XW4v< Xh#i<#U/bKZ P*U"rEB"ҀX!?Ǯz/E%U;P50U7v"%rZ{X 9=yT}>kQT~'4,.d0p h. n70Wulp_o5"Tߌ#{C00:Y`p4|5O?__U;JFt# hCF:S>[~!, & xYpO#Q|棟X~XXi'0MLѩkBgN{6h(UoraI5 [W=jsQ!o+ &`ՎDbPU%OQtJ_eNReW zPzaTغUU_)v$"`SD(#jqt@7phG0GeP\LW9/PAZR\cH.U;eT&P4 !I&Y^|a>$ :c 1bl]#1giB4z%C5{૳݀ztʘNyֽG;Tz#~a^_L.&bWCgtFBsD\"h1#Yۋu{?`>.or 6C>,)+1d'@ʡǑ Y,hm>/F&Gؿɋ[־cQr׬G.[NE y|$)J"f T栬Щg';^22ƠĿn۷$%w:F!%j~SN(YIcS hag 7ӑ/m1{>' eLs[D{~nג'Qq=Xd)ׄS{0p, 9Ab g 1~{у~XBL.֜>CGsh>h$BϪ~N%5<ß]>vT{Dgw}&b# 4~ſXsDCӈY&N)Yth.CĴyq>JK{rK+cds.O! ¨Z80 (][)ȹ6Ҹ ej>II3L# $[?UA#}zqLdY>_Ƿ/ 0 Oz"{K2Tźh+,Nh =R; v.RQeqN--#a-+ X#\!D1tdg;7+T={Z5(gS&m}-,_(lH\7 b 3?p?vcȥz#yu}4 H\gjaŨ`̫ O=D^haYqf燇8q'(OND:R"J у `I vQ+I+UŐ.d>o^񑛮EG(eS]%MJ)pKdiqD[56P>Ձ#yl;7kE0Md%Aw}f*"T='҉HM0u}c{ Dz4/9U{YˮLuٕUp0_S қX`MM?kf2H) hASK=Xg\lV۞>v3x qۇ[8( YEf18DT J MQ8y[7pU]_X%*1ǥ $)?]:/a` T1MC4 ~|c RC>y3Zk38TEq!l$%m )ILh/(ڤ&->UQYt+{֠<ҋ kЈ.X  3@HrID <\ghhXpDGV D[37˚@;O%ayDcײfBzkrR.=k[|'ԋTEU;%V49mr&'_1A2% >$=(#HBcgC \u\|ŢJ|St'h1 @UfF+ CAJ&)ٓ)BN(2P$7'HȐWA1qpYtE(:3Cj꣪ Ttx1 c9 cZjxTG `4w3H";m8ؙoY$"UV0Եl(hTa *NgO2}zNnS zr)f4`?/^6|X\gx?me-հR,Q')8"B=lnrEU zaU_KjedrN1\Ig-*>\m,ZA/ ƒDU7gyt X?|<<5iwg~+W,F1"fU *VzYQU[]D~tXEY7̶k3R'5w J-t,[" n"5asDs@z'30@6WdԸp#H*p1I"V;Sva(JMMb7$hnybDzOLg/vP@,RlUlA U*1UUQ]$Z&"\ώ9|vV_qNnܫ [%0teYȑt.u0bI*QTԊ dejzR[kK`IH c?~U%._Ɩ+#|eА)>~ p۷/ }^#w$?O2eUV qq\`SI(OeɖiTBa`LZP #Fdm3 쒳\\{~.Bj$Z6ZJODJ.gs6 :;DbsGZeR1"ftal(뇇?{wx&Q 'EBڒTB)W(ER@EP%4IWp۾wчmKӬ$GOqh0 Et˭7ƜR9|ܘY~&N T^QȻ.I9LQsۃOKu|_~/e@8D>o Xݝ`47oKwAw$}JD(9EC|g#;?UtDXDHHE G7y_Zw/ڟ|&a3t6Yx{Rb`0ˁo)Q;CjSgԇQ񺥲rݖLM (+E ULzs.woMB?xKjtEXtcommentCreated with The GIMP99%IENDB`tkrev_9.6.1/tkrev/bitmaps/dir_plus.png0000664000175000017500000000041414723165002020374 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEtRNS@fbKGDHtIME 26sX:IDATc``Fec#0KXQPPA D0 Fc20@ BLIVtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_mod_green.png0000664000175000017500000000043414723165002021547 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEJ)@PJHFtRNS@fbKGDhQtIME 27)JIDATc` RRR3 'k""f:"`khh*& B,@ +^tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/checkin.png0000664000175000017500000000052614723165002020163 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<$PLTE܋H tRNS@fbKGDatIME 26sXZIDATc`@p1*1!L%%c(SXIQ4 4oLzݻݻw@w @[ $g l.tEXtcomment Imported from XPM image: checkin.xpm%ZIENDB`tkrev_9.6.1/tkrev/bitmaps/newmerge.png0000664000175000017500000000044314723165002020366 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEBmtRNS@fbKGDHtIME 27)MIDATc` RJJJ #)i0 &#љH ]\\&sLP&H HLr|-{{tEXtcommentCreated with The GIMP99%IENDB`tkrev_9.6.1/tkrev/bitmaps/wm_help.png0000664000175000017500000000044314723165002020210 0ustar dorothyrdorothyrPNG  IHDR g cHRMz&u0`:pQ< PLTE)lǡDtRNS@fbKGDHtIME 27)TIDATc`P0``[ea_0?UjV3 X '=aBgpy0 htQtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/checkout_opts.png0000664000175000017500000000054414723165002021431 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<!PLTEƹH[tRNS@fbKGD-tIME 26sXlIDATc`@p1$2EC@L!S4TR VR 3 aLdD0;vtZ,9Kf *,1sB#j0A0Xg%_4t-tEXtcomment Imported from XPM image: update.xpmOIENDB`tkrev_9.6.1/tkrev/bitmaps/arrow_up.png0000664000175000017500000000041315033022232020400 0ustar dorothyrdorothyrPNG  IHDR K/osRGB,gAMA a cHRMz&u0`:pQ<bKGD̿ pHYs  tIME,(SIDATӥб 0 D7s}X' SDB}_WXncmlS"+ C#85y&tEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_plus_kb.png0000664000175000017500000000042014723165002021242 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEζtRNS@fbKGD-tIME 27)AIDATc` RRR2 A 8 )T@ A'Ad\ X ׼tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/difflines.png0000664000175000017500000000046414723165002020523 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEpa싢x tRNS@fbKGDHtIME 26sX_IDATm D4O _Lܠca`p!SUY&U`L(DR ("¾nd}TH*=4欗)oY>a8(FYtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/wm_blame.png0000664000175000017500000000042614723165002020341 0ustar dorothyrdorothyrPNG  IHDR Tg cHRMz&u0`:pQ<PLTEPqqFdtRNS@fbKGDHtIME 27)AIDAT(c`(( 0Fm%R n P$ A lz`D6PG1%BotEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/dir_ood.png0000664000175000017500000000036014723165002020172 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEyjtRNS@fbKGDhQtIME 26sX@IDATc``Fec#0KQPPA444544A(lll0qqqI6  IENDB`tkrev_9.6.1/tkrev/bitmaps/wm_says.png0000664000175000017500000000036214723165002020237 0ustar dorothyrdorothyrPNG  IHDR s cHRMz&u0`:pQ<bKGD#2tIME 27)GIDATHc`020000'_7 u ݺ Lzax,”xpr"r4 F`4 F`4 Pŕ+ G$tEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/loop-glasses.png0000664000175000017500000000064714723165002021173 0ustar dorothyrdorothyrPNG  IHDRW? cHRMz&u0`:pQ<BPLTEzzzHS'J<nb<~dEoOӾir$tRNS@fbKGD-tIME 27)IDATuQ D!$D댄ˌ)=*éǦY3MazMꊗUϺS[iq:Nh gLJ5,ਢ5:a!K 0ފEv$z~_xYBuH]v5sjIsZZ$?C tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_mod_red.png0000664000175000017500000000043414723165002021221 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEsQff$tRNS@fbKGDhQtIME 27)JIDATc` RRR3 'k""f:"`khh*& B,@ +^tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/refresh.png0000664000175000017500000000043714723165002020216 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEϕzzzHU܎ϕ(@OtRNS@fbKGDHtIME 27)fIDATc` @@2qqQ U *$LT R1ԀLe<*`ɔb&]@L00f) 58 4#6IENDB`tkrev_9.6.1/tkrev/bitmaps/adir.png0000664000175000017500000000045414723165002017476 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEoooooo333@gtRNS@fbKGDHtIME 26sXWIDAT% DѱWc$6@Hl /DVLk#y B)9n-dusl9WNsj#tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_svn.png0000664000175000017500000000101014723165002020210 0ustar dorothyrdorothyrPNG  IHDR e cHRMz&u0`:pQ<PLTEc3ͽ ;6䴦Ʒ*&pge]d\эHBފ_Wtkjbᐥ`XӔۓVOɛ51E?ʺICݩC> 捈}!UNؘD>40zpǿ yoȜFItRNS@fbKGD{ltIME 26sXIDAT]PEZA 6^_%7c0JAqn-RJҐU(r\! ZfV[zx2sDzq8O6/UvXtcx}.QDI qVtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/TkCVS_128.png0000664000175000017500000005410514723165002020105 0ustar dorothyrdorothyrPNG  IHDR>a cHRMz&u0`:pQ<bKGDV@ZWIDATxw\}sΝ޶l. QNQDZQeɔdKQ%NJ?Obq؉mɊ"ɖIQIJl"XA.>[f;ܙ3])JN{<{s{~#|.~Ab<˩ˍqZz tPG3hUl ^~]ވ_?oNfx{]N,)` 3+@ѱj[EFrspӝ5Llq r6d$ ldih#9ȩUr=fH4̜q6an=ϡGi=;7޻!Ý۷ ^ `!O3 $INO`5ͯ}g هlJ*P{o(VK~r]:]hkg] K Xkȳgr6?xOZj2x{O!FwXd`?6|y1A {w4,=/yFY.+ ǿ¡Ǿ33o17} šwr[n`fmxvo_w[c+کr)#4O|.o Ÿ=Ɇ2?z bQ%D(yqKǥ_SqӰiBߴ$k"}f(ܑ6uxjzm7z_#U,RTbx4J@ۍK/ZJ7oDDshTp՗3=S? ?m62dRi2%ԃC$a闺>Yx0vO5ɕ pU*M ui8q(ž.Kf?F8Źz=_ԃѻgeYTVܹ97fKH;p\-}xH=TV@ծڧ<2*?˩dѼk- "ܨzʱst ou /L~ T!ZڀשX(y,|Bnپ_zlI쁺PF_۸7\{<+%NeΞ<~{>~'?kzU -@t E2'_;GmO8s58.+ںᰒ o\~qf C2{ x~Nz(rK>,-Q ?3|m=#i߰ S͑A"&o4 kGc/`"n҆ZDnUH_  v0!NSĖ׮_.|x<?wƒ6{F6Gr̾]S* "ULEU0 nǡwQ(i >HN5DowpmƯA4z \SïY̾Rr@ 8r$8du{oLb8ct= uկth;&}I`AqX u71'Ʈ?5هlJ%vc#^%u8\}诲yno%HD%GA/ؾ|-_Mא4?/ǝЅ8ʵ{YgvgY(~qxZd0 psf˳$S~>z̏?>\ρ5mJ_8>+/#_XTF]{}lOM_A#6gK:KG.~X̓{8{qx-.xHo~?E|- c|{9פKinC|`b-{Z\8*\=S뾏S;l&7 #BrȐ.]zI G#敏?@n[u 8-1Ow>Ij1"vHo-]]}p߾lt 3e.Z.Q)%ɥ#q_S92kn`|_Evy}>}ϾIpHsϼF7 Ζ07md`U.ɽG u4cI:(Xdm:|j](õ\GkW"|ӽT"!à|c׮&i5B f=_5=v>"l^c.q4 l2mhs,!@L.mDe>I7| {}.ѓ1ڂ.hmM_^#nxF'QǏPioE|>w]GEy5VU:}sTʉ ͦm{716f>_ka傐љ8E@|9YU>З̀C| .BNXX"2# "Vo>Y=&*HkyJs% Fu~XBWh٣g1OLC.QTKU"2"JtDRr %Kf1GGqj1DBj2FS4 H$W,O5& n?f _G[",K}.I2;6>8JvUKr{?y~3lO*p8?<:F[Gg4 ݼx{p?m*/G#(MqfGͧ|~R/@mC ޸bGd!%D"`D$<)?HW)I"c PVYZ$ qUq{ȾLw9J/^VsCW?s;?B*gb|ʇzl1cStF|c'$yp@\bV}TfxdhA揋-Vٔ h,? !ݲR%%䋨Ε$ᨩ(ķ\wܼ6%ƀeAKdt4L 2?wP ![ѥ fY,(ezA^Yd"[/Ugpffΐ>2P;̺][m]İLhG;~_5`1M)d,Z3uf0QVc~= ˈL(Oܻ"0 Y.tϕџ5W+UuIJ4 _bwnk'JPxf23iOG?B9s)"i:z3۞y qKfYwu,]'k!6t,j¥Ȩ(P  o;ì{#=X*p66+S%jQϕ"#|y߃< / :B"#_4);g#/SpXƑwq#Y֞N"s$VI8@v"Ps9$1q#y׃#Bpp|MTp y=eSU 3·#=mo}gkCVlc#wh?}L̾Gt|'ܷzixk1?Dns8@~KgP%ɉlJN EPM 3dW+D !ky5\ Xڂ:CTg]N}u8;7_7RY#z茆*w_7~(u[Jԛ_6'FsEr4yϗ#ΛW]z(q'>O9>PSEv|x4' :}uAY c݁-  FmXSSȎS%Eiz2E0CAdbtug>3Ehu P0ۏsc>OꏞfRr_Ϝ`"g?'zujwc)_$JfQw gPxm*̙&eVQeqx=E7 +j$ـ-@hVk̷?+(Χ[^t{xGW}e`>$5fncx3?KNk!WF[гY#cf O+o1:W({ RcXUP0%t{k1)ٿ4:/f"T5%55P>:#C=lYu|.l)}Oʜ/2UoxxMŤ-'_x#qU!l70oj|?'ObR O`-<}'ϣ.m*y8$ CU- 52ӞNK_o,Ubs4_ X]w*lH1erZ3C>d!/+f-&6bh9j)29`TGA\RWgUR;;!R9U"_xf8j% OdM3E'`$.XW=N,!lNNNZ,kFu<%)P| p1k^SB \DY/+#zF6F,Pyn,VBO cg*hd3bEgVjAeNΰdwx#gٱQ΍6/|5elp )_~ܲkBU<)"4TF wE!P::_&?47|scMR\>ˣEǶx 5h$!+DvFqk\+f9Ɓn7]׏)Re!8@+CL BǙ&Vna*]B2ϙwH^.:s?!JYp u3=g̱/ /CC߻ .4R"(Z 4cU]p%tIFI|ft#v޽x3_Da%-je>n?;vkpO-WB5~%NhE "#ݔX̗0Xr^DI8`3_0}̟:lU0ϻofF'HM)*.YB$huphRE8_}7 uPʗV]ѨrfNkv$?|ǚ۱ Ƒ\Lc|˳buț8'tNӜT%9X}ۻV.7%*EE SAI TLt:D$S0y2継 N!2a d T"77Džӧp2}!_E{VPBTs9JT/dFI4LHRMVoYP}$j:_٩9ȅlkTIQ`6n|/|+,wx)o0rk&dSQذOS5o 3 ᢄCPe P-EW+'UUpZX5|ϚwlZcSΧԖF!ؚ@B?>nEɓ|kg9#7 0Lr9k|XPVuf˷n_d (U G+]z.n߹n:;)acOЖ;G Ly]_4۶o7-ILOOFb1;-qI=Ĺc|u$ #S/ l+SpZȄko-HsNfѦwLVJ8`1V̓Ip09q\X_~f6o%Y̯JfP* *){ -v`4]0ZuE.`6b)QCU-/D{XFˎ`MSYNzL$d?i~2Ԓ.hΜGt IPY*xC -]%(nT G_|{mJk3/q-y_MQQMjV!?ӋaZ6HPm$0TUgA`6[A+rݽfG(ZHT<DžEfy"[kIRQ+|b_}7jO޷kߍؖos?wyt(G?~Prv:\ gi%.QCg9xEUK(Z ~/gYp;VXFY8nǁ72>+~6lڶܖygQ9NOOs{r Z` 0%KHo.+Z* D9>KQcdύsd&Zz>hvY#x'6& E̊BF r %VJhڇ6!U܁-~[nU㨪lTN|iNW|/Bm}jWőX1Z]6mϾlZςiW N:cIN|C+Xm Q]E,F;6VP k滰<pgoXyYKs>Чl;r`Ӌv{|X3hF{oӱٞB)Kjf "U]:42Yn7\܁Wq3R W4<ն0iyKY"Ղ kZ `gxS)Μ?Ontw/[N8 cQYnp0ɖʤ9D*ը .Œu7mٳ )7,(b{.I Y;5 Tp.Nf:&0*)9ʆ#): ؓGP0\<"ޱ šʞ-G, NlꢌT(Ҹd (L8tre]t67_]k/]V 8~h޶hܺ 'w ./;+ T d+AcHB7:߻evtq;N=zQ6/7{EY Y5]+q8ѱVP4)@[z^TDD"҅*K%<0،SN-cǵ;3"? ju#JDK+hj׬wr #WM+`-V1/}a=x^( nk(||4* ׉T+p欪bY-:kG~(k) 3졃c8t_o`ªZ$Y(Ju9s)P(y},ED%syN9U(;w[c/uJ "&eM0[Wraƪi}d33,ܵrFzx)[#$qX[XYH@$`,'y5LaJ*~Nyl7է:NBx4Ӂ+h j&7uo!AGM/$jNӤ~g^8T]@*jc*oهI"J5:ScK/t2RK e 7&-࣫ ec٣1%',Nx ֶv-\-=.C}|\a"Yg!,ˈU\9$PEA2eo_Ù L\eBXõw~6k%Ӧj=^v$W$In5[BWW[1&Q),1[@$B糧?cY  dVHMKg LLҵnU+-t R.,[W Y\"bkVJ5c2! +T-f N3P£x\3bVhS+fM9܎J 2@+`*8+hLjŋ%j̭EDӴUsK{e MQ1TۏFaR*)Aq`v:}TNYK# [AJbJ}woPp.,rkÂv]2#}-h-P_ 0QR9?A r'X/*(bs(r0uymEq;-URJX>^>9 I(*F>`T+5\m|TkEWpnb4 @%^FVnAe~|%-oBl^eH^Tի'Mt$I(Q"hU7W8K !_TX^DTfZ09Pb$ƦGZ( b_*|tzqH*j`r 4F-&( T KB/V(U"ZI F>:=v0d*&SvnE?Z*Ls'f) BӔr  --" X"gx 5k_MV^XF2qFPlfiM eF'皶{]mY?dӋE&kjˆ/0-E۽0EwoŌ5S8L UG-qP&UU* h5xr@oUJV0Z A"q(E%qB8rYkUݖ2|袌R)rd20՚1\'82Oj!j+|?R_zZMKH,brz .{Q+V7ֳM 8OI4XDPtكl- $`?,.^)C7%L✏5dZ),R8 [/6~CP1dJ*f1v縷SY#Tި*wlYZn_8 UUN\K,֌:0(8."Hl<˳$>7MP*Mۜ\l 2&2HdeD Yf lFRJЪMEŨTmg2DA=-gBǗԶnmSS2vZ-1;@d!pjᲡk%F\@ɥ*V7AЪVZe`y/P׋KcTHr[ՠR̕@F]0V[P Um*9dUMX*Tj}5BSQ4 EQ<')kru2|"4v\mۯAv8}!dҰHCkn, #JmZ,'d1GEɥ-\,Tl-*)bJ赳}*o%a HFW*fӶdR1c'^ ]rȹ4D;64Ěk^BAV6QjMMGp:NR'.EAU4 *A7N"!&jZΣT\&\Bu L8s~U6:8r C+# b . {Ch!a\v1E7ah4 zT D R,RD JrĬ*Tt CF/0Q >Vt!8Et pER NtUcq!KPVԦ6c̅}]?dgE>{t^tCYd n؍[l?2x^@]BPʉjj|Ӂm0JijѶad Tt4<?Za:8̯J6̈́RTTZ IɅGјNTOPHU"a":49ԆPU0K1-IhN'@WT %RMшR?= ]9۾Vxy6vmȅ,E4m־:cewBGC6Y&T,ɦ<8jl>t'xr2񒆡8$[ٳ^f]?"K'TvK)%[Ƙ( 0YJkI9 ISTS]:R)kj:ˁT&j\N& Ѡ1kN'ZA,D'&)5 Km[_c;֔ogl6M:%Qlrf) 8#]xX2AB6-r UR 73{O=Hd-J)ljqr!,Y%aT}'RDFъ+#TJ:PWJh+UqEUӷr-+=yNnPɔ%|Uď(]Oh ն H'9- ~ x̿#t&[b VzFIpGD V0qyڼTDx2n_۷0x/-3@"n'oGtzqBZEeYX̢VY"5ywЇQ{)KdH\>SYWAk\` B.GLL,fblhЍQኴ>qBtS"^[cV/s1.ky5Vg?w\o E.aL^u|#%b bKPϏpW*,ַlĎӸTem=TI/{}|;Vci YQkCTr0b.ُOr.mYܚj:ko+䌪v^V #Sɖi%8>e߇(hS' i SZ D$'ne?~37ad]/{@RR3G-(MQ;Ibh>e鵭|[l;i1Js),NءR*|X|G1Ȗ!,rJhy=Bc>N|d,ߜ̓^O%,Uh[GЎFFtd-=fZC9f /gUra *E{*Lե[F_9Fqi Y4NjnXC<|g#VKT(R.eǚw^F: &7YF279N?CD2H )[Qyqr5l R%.]Mj2洶ԋFϠ ܥ,wO+<%4fb>aշ9Ku|_~>THƒdEl5Zfl~#}-TbⅾZpEG~/;޽~UCp>lF[BYO<Ÿ/lKNfރZ;Q2ǦVI8[Ph>vEwZ3F~C-vUJh\?Y `=LSg|>Nf |ޮ@f~J .OqXq4쏸l;"zMw?1LtA2u㛏/q{l9xmQp2YA}jz?~ym/d(Xh3{%V+\hЍ;賙V(u_ѱyCw7y~q>Ч0R3$OO|vs<ۺh|fa $I3Kxt]t5|!c9 ,YH"[`Nc4jsa9>_WOOinaWN15g#JmfWpZvq̪|g[(q%S]"J0Oxۋ>wwJHPU!M<,c/ma/~]!$#40N71/J\Th)L =8 (v\E_N`Bq^N.[QрLYpLMn>*<'̧H diw%s|jVfMف#wg)!@Dθ|{wx'-mCnC,X}Y]84`?;nh_>q k%IB9]5xZZ(։"r1T7Tl")aoSo[7jR<Maq=H%_=.""׳^!gUr2[x>^b>-l={q^_y^Mg} ۍ`>x óǹ>B9>t,i8waOφ0vG8RY[x<Ǔ,Afj$K}fj UhQ42}H$c^qsINL.io7V}"B}BL, )1\Z]7r͸@S@ͺF 9_B#DiWs nd2`\\+י>8Ke><~r j/afl7v"h$b%O/e'cVr_\g25^?dD<:}TYb{8hW-@ dceĻm .˅tu+'9t,Ɯ!n[l_.y Ԑ+/qǖo JjU' x<+OMOf>Gq8 ʭ}^q(U05mЭ _r? `4;;h.w޺48q% tP6D5 53TJz[ +yz`Ǯ]o؅IғI?"ùZԦRFbbV Z`])L]`f*,RtL/O?SG|),`"g_y+߲=NAlNū7n󛔳V>|}By;<&ߞ1O/%T_ЛTŽ?dP#^J2_W/-Gj;_y뎍[x&q?d\)M`sw'ږn=eR)]5f&7K/-#Gj®0%SR]Zօ;Dl؀F7Ckw9Q*d]/? ne{{_;%b<Ԧ E']VfhDP`zr #]+j**nj/JQMepU=C[V1| u'3U.>#`h֡ dt^w6L0Lv֘>Xҙαﺽk>o6ġ|ʩؚF{-.& sL|}» yƳn+p wͅ3}ST^ P^Cw/ݎepw?y4,oȭ=LҮBdҧbM< @(`;k2̲'yʎkh 30`O*|'hWX1Ǘ^-ýCvKflnbX5x])qPZuk`&QSAgǓ?bHS6{|Ud(x5 /MV0 ڷu^۵ W:y64QP2m&[́!\Iۺ]㸡ogh@-\Q?u#ʹ*@[Y\k/~潍6t X0KGO)U~ֻq8U0hjC-g)ԖGgC&Nkll:[kogZ7E2o.]q˘T/2*kfH5fxpj=7ŕ7d%J.ڷnBNgx~3sYdSӎ&r xVyGgYY#d1Cxq;ECi[B@!L!D[Olꁮ0_㑆w@LS7_Hex}Tr+Y?o<:W./~#x&qӖheMjLƄe`Ebs<"PvGS4]%RJ=GҪ)R5ZB]6#6:k/eV[6?prW3;vѳL WNg/UڿUW.:9^WJAM6I~5fPqN5PgS'&/ITH^{8XF/s~nfN~yFB-޿iwmL5wBlۯt/2 {p33ي&jM#Pd80axبY> ;\╝DTCG"֌ R NS~T mVbm}͸EwYtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_minus.png0000664000175000017500000000037614723165002020750 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEζtRNS@fbKGD-tIME 27)/IDATc` RRR2 PqqqBe``B, PIU|tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_cvs.png0000664000175000017500000000103614723165002020205 0ustar dorothyrdorothyrPNG  IHDR e cHRMz&u0`:pQ<PLTEXsR1X7̵hmN)ǯfվn`@ rQ0J)˴h{E|EW}_4xDQYj:o=Q[vX/uAR凼]k;Ut@xhI%tU.qނc6P/ŭdV5X8爿`sU-G\|_3sT.gH%b6WªbO.L+͵iGиkN,K)0% tRNS@fbKGDEWtIME 26sXIDAT]0gBBR]I81.c߸W'D"X3K788VH,3/pa;).>k9'¿+/*H&'(%~'#$/ـy ہ!-2j\n_6rjAc]74g6htRNS@fbKGDHtIME 26sXIDATmE0 233)>MqIo$ N\naO@  sH4OL3Y&bɊ@R.Âf &BFtfFX,WkC5$lw5rt *CzpIz#Wl/ɟVtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_kb.png0000664000175000017500000000034514723165002020205 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEqtRNS@fbKGD-tIME 27)8IDATc` RRR2 A ˁBP)%0CIHiCa!o&IENDB`tkrev_9.6.1/tkrev/bitmaps/delete_red.png0000664000175000017500000000047714723165002020660 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<'PLTEzaa ::777OOOOKatRNS@fbKGDHtIME 26sXzIDATc`@PQl$jf2*AHLFfc cjdc 032:g*1Lm ff f1>0s2\l04ynΙ7@4)9u>IENDB`tkrev_9.6.1/tkrev/bitmaps/dir.png0000664000175000017500000000037414723165002017336 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTETtRNS@fbKGD-tIME 26sX-IDATc``Fec#0KXQPPA DR f{jtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_minus.png0000664000175000017500000000040714723165002020546 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEtRNS@fbKGDHtIME 26sX5IDATc``Fec#0KXQPPA D+444S MƽtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/mdir.png0000664000175000017500000000051314723165002017506 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<'PLTE싄ooorHStRNS@fbKGDHtIME 27)dIDATc``Fec#0K5DPPA,ٵbzY"qԊƆ b&U+;]+3g9bTs$eL)Hk0h1!ݼ;tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/locked.png0000664000175000017500000000047614723165002020024 0ustar dorothyrdorothyrPNG  IHDRW? cHRMz&u0`:pQ<?PLTEzzzggg999%%%ɆBBBK:,ҩy *ctRNS@fbKGDHtIME 27)aIDATӵQk~xwJ-#w}wYPJH ="Rô'a88 dZKf.no6.Ջ|kܺ'B7gZ JaIENDB`tkrev_9.6.1/tkrev/bitmaps/arrow_dn.png0000664000175000017500000000042315033022232020356 0ustar dorothyrdorothyrPNG  IHDR K/osRGB,gAMA a cHRMz&u0`:pQ<bKGD$3 pHYs  tIME L[IDATӕ @D[UYv Uk3[ i]Ne@5Ls-K5k1$TwX`7V` .u迯]!S5IENDB`tkrev_9.6.1/tkrev/bitmaps/edit.png0000664000175000017500000000065614723165002017510 0ustar dorothyrdorothyrPNG  IHDRW? cHRMz&u0`:pQ<PLTEͺ䨨<866T9gK FFaNWW]A'YYƌwxffm^_dmmmggguJOZr6PtRNS@fbKGD-tIME 26sXIDATӕ0PjkAd+0-Oާ&3'Dˎ)=cc$zcwq7)5כf`'LPf`6=XMb')%QU7M]vJu큐~tqRjOǞ. ^IENDB`tkrev_9.6.1/tkrev/bitmaps/export.png0000664000175000017500000000035214723165002020075 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEH{AtRNS@fbKGD-tIME 26sX:IDATc`@@e B..tc GBML m&0A0L( ~%LIENDB`tkrev_9.6.1/tkrev/bitmaps/fileview.png0000664000175000017500000000040014723165002020360 0ustar dorothyrdorothyrPNG  IHDR'Ն cHRMz&u0`:pQ<bKGD#2tIME 26sXXIDAT(ϽA 0gK?6L/*St/\uVp>BnUĞ!&1 1фbO=ee357n!MtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_modml.png0000664000175000017500000000037314723165002020722 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEZ+{tRNS@fbKGDHtIME 27)HIDATc` 26R2! q"!eBii`FXZZ**# % 1!o MIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_ok.png0000664000175000017500000000040514723165002020022 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEftRNS@fbKGDHtIME 26sX3IDATc``Fec#0KXQPPA D;4K r cHRMz&u0`:pQ<$PLTEsQ}fOHtRNS@fbKGD-tIME 26sXdIDATc`@p1*1!L%%c(SXI4 4+h )5!pjqVìcZRٵj7TXrժ$a@a GT-tEXtcomment Imported from XPM image: update.xpmOIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_plus_minus.png0000664000175000017500000000040614723165002022005 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE $zKtRNS@fbKGDHtIME 27)4IDATc` RRR2 'b82R! M StEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/check.png0000664000175000017500000000044214723165002017631 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<$PLTEHGtRNS@fbKGD-tIME 26sX`IDATc`  20(@X.A`cZI$f %7QfRE`&UvlJZ0u Be\(wqN6aTqȭIENDB`tkrev_9.6.1/tkrev/bitmaps/dirbranch.png0000664000175000017500000000051014723165002020504 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEEooomtRNS@fbKGD-tIME 26sXvIDAT] 0 `70@"+ʐ-)xU@`}C2%V7(+BtŮaz|wٜ=[.:XhLɧ9 L\pd)?˔\tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/backdir.png0000664000175000017500000000047614723165002020162 0ustar dorothyrdorothyrPNG  IHDR/j cHRMz&u0`:pQ<PLTEoooHܸLtRNS@fbKGDHtIME 26sXcIDATE 0@A@t nP5n]_K ZVGT9FuBa$-)'˪Evn#kqȏR.ܕ\ ]" TMotEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/modbrowse_git.png0000664000175000017500000000117314723165002021422 0ustar dorothyrdorothyrPNG  IHDR(( H_ cHRMz&u0`:pQ<PLTETooo{N1P3xȿ\@I*yO1jRQ3P3xyQ4O1W;K,P2K-bHN/wxJ,M/v}v|P2dKwwQ3H)X;wZ?^DL.xR5W:N0zQ4yʱtRNS@fbKGD?>c0utIME 27) IDAT8ݑR0EIx*j{kf`68/38xޟ"JF& CmiYW(յDbsSmAJ uw{oC;GHkX suaL/W#wcFǧYqb+{x(~ kF7xjErZ(DUm2 cHRMz&u0`:pQ<$PLTEH~|btRNS@fbKGDޕztIME 26sXdIDATc`@p1*1!L%%c(SXI4 4+h )5!pjqVìcZRٵj7TXrժ$a@a GT-tEXtcomment Imported from XPM image: update.xpmOIENDB`tkrev_9.6.1/tkrev/bitmaps/modbrowse.png0000664000175000017500000000051514723165002020556 0ustar dorothyrdorothyrPNG  IHDR((~Х^ cHRMz&u0`:pQ<!PLTEooo.YtRNS@fbKGDHtIME 27)IDAT(c` ( @t " +Ach,.HE T%"$+uD%-s * LmSImI`y$H{YKI3W 'E-uD%q9>F7ZIENDB`tkrev_9.6.1/tkrev/bitmaps/stat_conf.png0000664000175000017500000000046014723165002020534 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE.2tRNS@fbKGD-tIME 27)XIDATc` RRR3 A ''[J"*f9")a [JJ!H$4--,UR*RWI B,۪L>*ptEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/rdiff.png0000664000175000017500000000045514723165002017652 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<!PLTEpaM'tRNS@fbKGDHtIME 27)nIDATc`A8@00\ 1*.L!AAS04M"X^!ʋ!4 (" eu\ llll9SA::f΂Z(8s S%)IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_okml.png0000664000175000017500000000034714723165002020555 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEmwEtRNS@fbKGDHtIME 27)7IDATc` 26R2 "#RR11!* 1IENDB`tkrev_9.6.1/tkrev/bitmaps/delete.png0000664000175000017500000000055414723165002020022 0ustar dorothyrdorothyrPNG  IHDR'Ն cHRMz&u0`:pQ<bKGDS/tIME 26sXIDAT(ύ10 EQJ#[.С =Q֮ll*&!|+F}'; On:zKE,Fxaf٦ Y1~5sp(R1UU*8`XGvR^f%w+d3b؀SVF\vvr܄jB ?πvgtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/annotate.png0000664000175000017500000000042214723165002020363 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEH싫7ntRNS@fbKGD-tIME 26sX@IDATc`@T|LAaAA QAAac ࢂf(@ B1E H& Yp$6K?'tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/wm_trace.png0000664000175000017500000000045114723165002020355 0ustar dorothyrdorothyrPNG  IHDR g cHRMz&u0`:pQ< PLTE)lǡDtRNS@fbKGDHtIME 27)ZIDATӝб @Pƽ@q"&W^!!U=ʑ;{03 1983u_7xP8ҍS1gĕtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_modol.png0000664000175000017500000000037314723165002020724 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE tRNS@fbKGDHtIME 27)HIDATc` 26R2! q"!eBii`FXZZ**# % 1!o MIENDB`tkrev_9.6.1/tkrev/bitmaps/dir_git.png0000664000175000017500000000060414723165002020175 0ustar dorothyrdorothyrPNG  IHDR e cHRMz&u0`:pQ<iPLTEvZ.u ӘZj3 ;$c cHRMz&u0`:pQ<PLTEzg{rtRNS@fbKGD-tIME 26sX:IDATc` 0 `c ba28 `2\\ 1*..PHL<>1 _aRL-~opH'%VQB,-V"IIrT~]ʦ @Φ7Plĺ&C%qnnhpnVz5._{+ tIENDB`tkrev_9.6.1/tkrev/bitmaps/folder_new.png0000664000175000017500000000042714723165002020703 0ustar dorothyrdorothyrPNG  IHDR cHRMz&u0`:pQ< PLTEooogtRNS@fbKGD-tIME 26sXKIDATc`F fZHr $]AkUjh?dh8 @߿ ֪UV0`,C/tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/TkRev_128.png0000664000175000017500000002330614723165002020205 0ustar dorothyrdorothyrPNG  IHDR cHRMz&u0`:pQ<PLTEpou~āDŽimgnlkiʼnœȠ{r˗οԽҽîIJʵӸğ|ʻʱƻǞ̭̲νмηr]QzĴųĪŮhCֻkџʯŌwnʚѩibY㪑}pͽ{ofȧŷŴμmkQ*m_xjWkSmtYa5y])~_DaBwJl:uYIxsϯ׷t`ogxS^8iAhKwV+YSMeǟjavX=jM9}`J}[{^ռзԐwdsgN}ZFgXmoQ7xjG4(~|vOyS0cNBT?3@3/Z?0|YcO5xYnO0iF.]DrϺɽE0HDBڹ, Ἔ{ȗxhWjQ§W@(7ӫk`㸛~h ogicЯЪwiUǨ¹թذv_xltYNpP+\;&ʱ˦vϦeLFҖztuZ3}ɲ|`U#OB9]F˭Ѻӿ·j*r/^&S<U3%kQ$Cw>fL%/ Q0v,bI"1BuU/[C"2&fKI3j*34Ғ7ۙ6ǔ49P~"?#Pހ=7JeD* ૄ2459|U=t  TlXB8H>Fd#$~L Fh"{AA>d D3YkXxDP(Zl5r`Id|LQJ@ J%Z.at*_ `ˈѶQA|_W7Lrdb&@a#$Ʒw8iw'-Ce# d( 4( K8 G jw=E}G':,V K2z2$Є=ↄLm!^OKKd` 4ǀ[7?T9M [@$ŦɅ  R/­īknOVe:4oQJz32@2 h

0# :'Z0`ئ DnT:iC`pЂL4)v9~4#Б#>eDe ,zGr*F("8s@tSpd>ɐK!C h}Lan| |_0}V4Q:윊^B5H@DIJGM{nRjVL(b"" QB :l>RN>KHp I R@ԳO|1zJ̌ԙS&Fs G=D 3J)Sa@ 6wȐ!-A@W@ꌌE:q[;*Nc1`kI$+`xz9 :T&TpZ̢#=7tPV[iF0Maac6DOWFCʈ`Zbs%cFpzʲe']S'|wfg_QsR}\4XsύH˙.3WHN6s'AN:+e볘x4j!/V $hAA`uq0ρpf2q3wvBR|BnP(tf|4 6`9dɕl~&g尌(ޢq̞?{ DAl;$Ԇ Xx#F>I2_h$۞;>+1z ш.SAj@y%$CPLB%ڀ(@-/((\2іRREGJe\#m ]=: 2ITUp$'[tɒe/.Y%+l!R_짼 Ai}tOۡ < 0eR ¢PVVrUƭY[\Qqk^^}r}FVBe4q50QC͇KغI } +6%R+z_.!;B/SQo_?GYU[_-޶ijGZB];xwמ1cF]JǛkd?KX r(!Q5&-پ}Wv鉣& `߹gAw2TVk6mQŜVMjym@PP|-`! 3R5G_|q~l؄7!M;dZcjx;!7Dg#HU=˅lξlN@HAFh4ꇜrUG[l?~ԩ'wl\z{N$]M-n掆}V,y9!HΦ=nv=f3":3==: ڈ%)ǬCZ[+W.\+:ڊBwʜLQ_GT)N~##T,.dx8;݉drBP_{z6[<*-@D! @_˗8e׌өW>45qTu;;1IN^|}}^AUڅ;Tmnؼb55֕ˊ m%srz:8gI'}x뇗wvKuccg"sɓ{X0rQq "`WT\j,U9j5&_]as9=#V1P.]Jl\_5Mu׮]y$7>zWEYefJdžGb8ELFFzzB&9?=~ Rk2c/ψI*LK=:];rsIWnܸxwVWWǷư9||Az`k%Y6T4_ڜȊIJ*.]Zwsݡ͇Rtyw>iv^Ws{>fb}XSd uDjTeﵾ\ё;Ab3Mͱ#.H=?qOXqxMunQz5f@`RIU&(+ `pjmox:&4:a禖k9j7?1>?+'#õ¶^}~W X/1tԨ1b[ TsXgZ3Jd@XN?zyȔ>략ܹS#͕mfKv kX="$:oI`dta-3zis~vVޣG.]zg_<t~^_TTSS~kngGlfљ@y>Z,QL+c]Hz[@(at=9WLMuzLGd%p  9qiDMyn_;YD3+W_n#ƼZFgh-07\^~lnSY2FX,xc[v>uJ밈.?5okX"" 3gSߓJrAp <$'4 ;j,y:$39|G g-,/+]"2l -b14wz4qS,VAWAAc-hM9=}==#F$#pJ~lnGђ{]Ń۟uDy"rdhp؋+Vu_K;: A1vTl\؎>w. $uTFD˕mBksEF8͑RiKҭPPb 7͉?* ,5{+++Uf3mɍnz ٮ\_l7,,dXbF@Z~H@c曮Ү3gvr 2MD4_gy)W[D$&xsLRwWN96Q<7>%ʒ^n//z AxX0a:bf<;ݙ2p+N܎9jG+L-]֨nw\)T`gH A]RR|rw̬@fP¢BBC&gWlzR#}'ON=1dx0hpNX!51Lj$tt$hR`_@b##@H t qs?XMGeݣ׬[L³=m6ՕPi9 5=l@nTWsi}$@*"Bhοs҃}9yzV:nhzJP` D Iw XV $44ّ5s {KqǪm*Z덞< kL OFl@*UP[2(`N%Ml_ܜt@`KKuO8eS|xݱi2H3:?e'AJ~MJ!Pv qjtFg(歯1~ bf;Kv?s#՜phש5ԨJa&jyB>~ XsOI֘fx=6۵ Wfק`/zo߹0-sm7.勤[asLhrJ~F#;#tH!Ur @zaZ)37o}bɽ;wy~#śbYŪ(kpr2g4vIkH,2jA -9 J_! vD:ҽs?ln^MK_}˻w|\¶3Em[(.nh(Z@beOD'NLxbLɩbm, l饯?O}7.ϝ{֭.1c 'm۶3ϜYtG{*v(3w T(%թZ Lp {ԫ-,6~~9|Nնk9szKrǶAںށTU?Ѳ W>qI@qcvf/ۙ5.>G*>S67.QY8|`J:.QKY3 ?zlfGWRf'7N=qc۶mݺlMN~6u4>H}OAMC )t%زB\A(~7^m;p‚7emm9%EoX|)SY_@RTԑ?Аg 3 EE͘cuZ[<ޱq㎪׬q`ǎڮ[VxţmqդSU)@gpY2mjhh>|6-p7xEG>-NMF}yX{ !p ]:6k>WtzڣV-T[rʣFyI$>SdGzF#U9\Y Я@W/YgF-Ա[ήRgSh` Fg)}U C lիFoTQА+ !g9C3C$U4`v@CjGdz6".PAGbG04$4aQUdz^ jI~Y ͸IXR|)n 9(o>cA8)#WdjX8ө0|FGcJX @>HQ_qqrZ~.o``F!Od 4V숇|)8 A P L4Ȋr1.*5;_#,X<߷~K#//e>yG^*#ZC$߁@ldc@-pPS, ;p4$FaOhUI_KC&[AQq8> V>+*;V(M?/~ B8@/ T|wWBnV|8{"W8}4馜I֥c3Z@>3D%;}<Adx 'J!p*BclAQ1'B$boʰ <6+T*|>"o?sd#3&Fvj3-_5l6OQtSML zkGt"a w̓WN#t%vyVLx303aY">|ޞDl2BO@l3xխ(9(T`05 %kӛ_, ML;)G0pӿ'M6 %\AO*%ְZRqZ?#hNJXYl^{ nUF#@sZwY&FW:8SReRf#?`FI+Y7!zv=frIJ$f`{>h~k8.&%hjMV.+ܤ2`׷6D?OD;ջxoOtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/wm_TkSVN.png0000664000175000017500000001346315015446517020243 0ustar dorothyrdorothyrPNG  IHDR00WsRGB,gAMA a cHRMz&u0`:pQ<bKGD pHYs  tIME ;~l wIDATh}Y%u̬[wYzfza  Pwdؔ!dG֛rt2eM"AŽ`03=w߭L?-^j˪:'ϟ'OCmbx"ZXl]"n[nXK rR|[ ԩ|ܵ׮5Xcbh 8fh&S8%XkFS\X,:n5ZL#DG;m- x%/k'!:ZT(rK"ԭ{dѫMl;Q\:eo3<7yF D)E? ךA& h'Jr,).WY'I ˰F q~4V(b?BPjhkaَʕ~C@g)AcceS g@dԶ`6J# [bÉٓρc% OB⹒*`VĮqP5`s8$N3,AHpr9|=9ZLt}Y:mY {Orvqy ϾM{EeDq1m@G%F޷JjW?[~c0|];RzkOK&E~4@ />˾1M6balrчY|+W8r %?;dQ6ǿ%Vx"W\&c&wMSHS8&z LU<s778wFGh>]&_^YCWP¿+닻pudĞ{4-{T3.SmZ!i*./| .]`1^ճz4kJN,ێ~Egzg3}m, }7NCRWɵ>lie#KC',1&+웬tcWW:5}Yf!N_G %)Ry&&Jv'QsEaw)Qm]ZZ"C.q}| nj῿7>YA{au2tJ$2Khb2:7]GoƅM)Dpd8~D)IhLaCyLM!)^/^;EH!q2WVj{y  B)\$cɒB-/q4w)Na-x&c4ŚSrH"Ύi\\aY^啿O45r4L"AFf9C8J,rH)({XkcHҜo|g/8p.ڙ䶩G@EQ' ]L2Ƈ#2XYȮh]b@]Y 4)QE2Xdw癜)lstYn@:..'ז8_Ο?ץR}rN FU $ךtNcQ⡱%ɁGZv묬Ƭ 4Cr;hyIj_ݪU BmȆJ9f3K>ƩitH(*?}ػ lcs266{$&N,%t^.rwM$gXLLI (%YHL3ÅWߠ1-\Z|Cr6 UqD03c_1o2QI3=ns!,NUiH1\Zhzd݌AJ/c1Zȃ_|3;g{=μ>ed֧ԡv[S@kF- RZ%RI׹2 Z=}%Ն}wQr0Ha2p)ϸpu%coϿDOr2J $D"CZ-r܂`Hl))ȵ滔K.ADBF%ΉzkHX: 'Tu@'}orYN\JiVSfz?'vw\4ۯС]ؿkN?"J5Rܖs5%61J!A'9 Zð Q#rN+ؼ h:Kh ):!5A1s.c Gۛ"$I9ڰw"4J \ULy^d^QEɴw,D474Y8њJ/ammw/- e^K}0֢6475tOD[o^\I7Hqb_)9Q`X\Gls$Yn( 67c ߟJl}Mf~V܊b~Vsa)зh۫#rhǂM{U(3hc6!S7gzQqڼѣGkuA=PEa1LU#@g0J BB?.0F[sss3S cHRMz&u0`:pQ<PLTEجt ktRNS@fbKGD-tIME 27)MIDATc`@T|LAaAA,pQEEE(@D*ٌKTI& 4j03220̽.MtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/man.png0000664000175000017500000000030714723165002017327 0ustar dorothyrdorothyrPNG  IHDR5* cHRMz&u0`:pQ<PLTEKNtRNS@fbKGD-tIME 27)#IDATc````n``?@@ d~eٰ#qIENDB`tkrev_9.6.1/tkrev/bitmaps/add.png0000664000175000017500000000044614723165002017310 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<PLTEHB~0tRNS@fbKGDf |dtIME 26sXGIDATc``Lec8SPPHB*.Ɔ@ 2ECC]\CCQ t$&5Q#tEXtcomment Imported from XPM image: EIENDB`tkrev_9.6.1/tkrev/bitmaps/tag.png0000664000175000017500000000042014723165002017323 0ustar dorothyrdorothyrPNG  IHDR cHRMz&u0`:pQ< PLTEHh{tRNS@fbKGD-tIME 27)GIDATc`aF0)"Y$ch(Z ⥮ Sd֪`$ $&"`YƬ)` ] `XPVL+ TtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/link_modml.png0000664000175000017500000000036614723165002020706 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE싄\tRNS@fbKGD LtIME 27)FIDATEA 0  \.BSIeG@#Q^ \+a:vΦib |IENDB`tkrev_9.6.1/tkrev/bitmaps/newmerge_simple.png0000664000175000017500000000040614723165002021736 0ustar dorothyrdorothyrPNG  IHDR cHRMz&u0`:pQ< PLTE>tRNS@fbKGDHtIME 27)3IDATc`@ V200H$;w$CC{@:tEXtcommentCreated with The GIMP99%IENDB`tkrev_9.6.1/tkrev/bitmaps/dir_ques.png0000664000175000017500000000036414723165002020372 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEtRNS@fbKGDHtIME 26sXDIDATc``Fec#0KXQPPA DCC ``0΀J"" *^@IENDB`tkrev_9.6.1/tkrev/bitmaps/stat_okol.png0000664000175000017500000000034714723165002020557 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEdtRNS@fbKGDHtIME 27)7IDATc` 26R2 "#RR11!* 1IENDB`tkrev_9.6.1/tkrev/bitmaps/wm_branch.png0000664000175000017500000000056514723165002020522 0ustar dorothyrdorothyrPNG  IHDR Tg cHRMz&u0`:pQ<PLTE)l Y )lHtRNS@fbKGDHtIME 27)IDAT(}с @[8Ss(gavmKmDy<>Gd  lKp(BLTe͕1!r$M*T^#]MJs=9%x+>~y5O(y)+*/d37/ g? 1?q>tEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/tkrev/bitmaps/searchgif0000775000175000017500000000021314723165002017723 0ustar dorothyrdorothyr#!/bin/bash for png in `ls *.png` do #echo $png grep -q $png ../*.tcl if [[ $? != 0 ]]; then echo "$png is not used" fi done tkrev_9.6.1/tkrev/bitmaps/stat_ques.png0000664000175000017500000000041014723165002020557 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEζtRNS@fbKGD-tIME 27)9IDATc` RRR2 "3R@(B,!J %tEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/link_okol.png0000664000175000017500000000035014723165002020533 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTE:&tRNS@fbKGDhQtIME 27);IDATc``dA%E0CHPg !A(@0R`T > 8EǦIENDB`tkrev_9.6.1/tkrev/bitmaps/git_checkin.png0000664000175000017500000000052614723165002021026 0ustar dorothyrdorothyrPNG  IHDR> cHRMz&u0`:pQ<$PLTEgi}fOH 2tRNS@fbKGD-tIME 26sXZIDATc`@p1*1!L%%c(SXIQ4 4oLzݻݻw@w @[ $g l.tEXtcomment Imported from XPM image: checkin.xpm%ZIENDB`tkrev_9.6.1/tkrev/bitmaps/paper.png0000664000175000017500000000036114723165002017663 0ustar dorothyrdorothyrPNG  IHDR б cHRMz&u0`:pQ<tRNSv8bKGD@Xd tIME 27);IDATcd`haZ00001 S  @+@5C+z  rjtEXtcommentMade with GIMPVIENDB`tkrev_9.6.1/tkrev/bitmaps/link_mod.png0000664000175000017500000000037514723165002020355 0ustar dorothyrdorothyrPNG  IHDR R cHRMz&u0`:pQ<PLTEytRNS@fbKGD-tIME 27)MIDATE 0 Cь Bl M?=@: 512 && ! $errok} { cvsfail $errmsg . } # If we don't pop up an error dialog, let's at least try to show # what happened in the viewer window, if there is one if {$viewer != {}} { #$v_w.text insert end "\n$res" stderr if {[tell $procerr]} { seek $procerr 0 while {[gets $procerr erline] != -1} { $v_w.text insert end "$erline\n" stderr } } } ::exec::$my_idx\::abort } else { #gen_log:log D " Close OK" # Many CVS commands write stderr without err exit if {[tell $procerr]} { seek $procerr 0 while {[gets $procerr erline] != -1} { gen_log:log E "$erline" if {$show_stderr && $viewer != {}} { $v_w.text insert end "$erline\n" stderr } } } set ExecDone [list 0] #gen_log:log D " ExecDone $ExecDone" } catch {chan close $procerr} if {$viewer != {}} { pack forget $v_w.stop pack $v_w.close -in $v_w.bottom -side right -ipadx 15 -padx 20 $v_w.close configure -state normal } return } if {$filter ne ""} { # Send the line to the filter, which may return a tag set filtered_line [$filter [namespace current] $line] set texttag [lindex $filtered_line 0] set line [lindex $filtered_line 1] } gen_log:log S "STDOUT: $line" append data "$line\n" if {$viewer eq ""} { return } if {$filter ne ""} { if {$texttag != "noshow"} { $v_w.text insert end "$line\n" $texttag } } else { # disable until (1;32m) type codes are fixed #$viewer\::ansi_print "$line" $v_w.text insert end "$line\n" } #$v_w.text yview end } proc err_handler {} { variable errpos variable procerr variable errmsg variable viewer variable filter variable show_stderr variable v_w # When new stuff appears in the error output file, get it. There may # be more than one line. set errmsg "" if {[tell $procerr] != $errpos} { seek $procerr $errpos start while {[gets $procerr erline] != -1} { append errmsg "$erline\n" set errpos [tell $procerr] } gen_log:log E "$errmsg" if {$viewer != "" && $show_stderr == 1} { $v_w.text insert end "\n$errmsg" stderr } } } proc abort {} { variable procout variable procerr variable procid variable viewer variable v_w global tcl_platform #gen_log:log T "ENTER" # This does the trick but it wont work on windows if {![info exists procid]} { gen_log:log D "procid is not defined" return } catch "exec kill $procid" kres unset procid err_handler if {$viewer != {}} { pack forget $v_w.stop pack $v_w.close -in $v_w.bottom -side right -ipadx 15 -padx 20 $v_w.close configure -state normal } catch {chan close $procout} cres catch {chan close $procerr} cres gen_log:log D "$kres" #gen_log:log T "LEAVE" } proc destroy {} { if {[catch {namespace delete [namespace current]} err]} { puts "deleting [namespace current]" puts "$err" } } proc wait {} { variable ExecDone #gen_log:log T "ENTER" if {!$ExecDone} { vwait [namespace current]::ExecDone } #gen_log:log T "LEAVE" } proc output {} { variable data variable ExecDone #gen_log:log T "ENTER" if {!$ExecDone} { [namespace current]::wait } #gen_log:log T "LEAVE" return $data } proc run_exec {} { global cvscfg global tcl_version variable my_idx variable procout variable procerr variable procid variable errmsg variable command variable viewer variable filter variable v_w variable w chan configure stderr -blocking false -buffering line chan configure stdout -blocking false -buffering line # Set up the file we send the proc's stderr to set errordir [file join $cvscfg(tmpdir) "cvstmpdir.[pid]"] file mkdir $errordir set errorfile [file join $errordir "exec$my_idx"] set procerr [open $errorfile w+] # Here's where we do it gen_log:log C "$command" set procout [open "| $command 2>@$procerr" r] if {$tcl_version >= 9.0} {chan configure $procout -profile tcl8} set procid [pid $procout] # Dont ever do this. The whole thing depends on procout blocking #chan configure $procout -blocking false -buffering line fileevent $procout readable [list [namespace current]::out_handler $viewer $filter] flush $procerr fileevent $procerr readable [list [namespace current]::err_handler] # set buffering back to normal chan configure stdout -blocking true -buffering line catch {fileevent $procerr readable {} } } after 0 [list [namespace current]::run_exec] return [namespace current] } } } # This viewer kicks off an exec::new and display its output. # It can call a filter to process the output line in some way namespace eval ::viewer { variable instance 0 # # Set up a dialog containing a text box to view # the report of the command during execution. # proc new {title} { variable instance set my_idx $instance incr instance namespace eval $my_idx { global cvscfg variable my_idx [uplevel {concat $my_idx}] variable title [uplevel {concat $title}] variable w ".view$my_idx" variable log {} variable searchstr {} variable searchidx 1.0 variable v_e viewer_window $w $title [namespace current] proc do { command {show_stderr {1}} {filter {}} } { variable w variable v_e #gen_log:log T "ENTER (\"$command\" \"$show_stderr\" \"$filter\")" pack forget $w.close pack $w.stop -in $w.bottom -side right -ipadx 15 -padx 20 # Send the command to the execution module set v_e [::exec::new $command [namespace current] $show_stderr $filter] #gen_log:log T "LEAVE" } proc abort {} { variable v_e namespace inscope $v_e abort } proc wait {} { variable v_e namespace inscope $v_e wait } proc clean_exec {} { variable v_e catch {namespace inscope $v_e destroy} } proc destroy {} { variable v_e catch {namespace inscope $v_e destroy} if {[catch {namespace delete [namespace current]} err]} { puts "deleting [namespace current]" puts $err } } proc width {width} { variable w $w.text configure -width $width update idletasks } # Call this proc to write arbitrary text to the viewer, possibly # with a tag to color it proc log { text {texttag {}} } { variable w $w.text insert end $text $texttag #$w.text yview end } # A filter that detects ANSI color codes and changes them to tags proc ansi_print { line } { variable w global cvscfg # ANSI colors set ansi(30m) black set ansi(31m) red set ansi(32m) green set ansi(33m) brown set ansi(34m) blue set ansi(35m) magenta set ansi(36m) cyan set ansi(37m) white #set ansi(1\;30) darkgray #set ansi(1\;31) lightred #set ansi(1\;32) lightgreen #set ansi(1\;33) yellow #set ansi(1\;34) lightblue #set ansi(1\;35) lightpurple #set ansi(1\;36) lightcyan set ansi(m) none # Bold etc, which let's not do for now set ansi(1m) "" ;#bold set ansi(4m) "" ;#underline set ansi(5m) "" ;#blink set ansi(7m) "" ;#inverse set newline "" set ansicolor none set idx 0 while {$idx < [string length $line]} { set char [string index $line $idx] binary scan [encoding convertto ascii $char] c* x # If x=27, that's the escape if {$x == 27} { set char "^" incr idx set seq $idx set nextchar [string index $line $seq] binary scan [encoding convertto ascii $nextchar] c* y # If the next char isn't [, I don't know what this is if {$y != 91} { gen_log:log D "UNKNOWN ESCAPE $y ($nextchar)" continue } set code "" while {($y != 109) && ([expr {$idx - $seq}] < 5)} { set nextchar [string index $line $idx] binary scan [encoding convertto ascii $nextchar] c* y append code [string index $line $idx] incr idx } set code [string range $code 1 end] set ansicolor $ansi($code) } else { $w.text insert end $char $ansicolor incr idx } #gen_log:log D "$idx|$x| $char TAG=$ansicolor" } $w.text insert end "\n" } proc search {} { variable searchidx variable w set str [$w.bottom.entry get] set match [$w.text search -- $str $searchidx] if {[string length $match] > 0} { set length [string length $str] $w.text mark set insert $match $w.text tag add sel $match "$match + ${length}c" $w.text see $match set searchidx "$match + ${length}c" } } return [namespace current] } } } # A filter for output lines from CVS/SVN. # Returns the name of the tag to use when printing # the line in the text widget # This filter doesn't need its exec argument, but filters # must have it because some do need it proc status_colortags {exec line} { global cvscfg #gen_log:log T "ENTER ($exec \"$line\")" set tag default # First column: Says if item was added, deleted, or otherwise changed # Both CVS and SVN: # ' ' no modifications # 'A' Added # 'C' Conflicted # 'M' Modified # '?' item is not under version control # CVS: # 'P' Patched # 'U' Updated # 'R' Removed # SVN: # 'D' Deleted # 'I' Ignored # 'R' Replaced # 'X' an unversioned directory created by an externals definition # '!' item is missing (removed by non-svn command) or incomplete # '~' versioned item obstructed by some item of a different kind set mode [string index $line 0] set file [lrange $line 1 end] gen_log:log D "$line" gen_log:log D "mode \"$mode\" file $file" switch -exact -- $mode { "A" { set tag added } "C" { set tag conflict } "D" { set tag removed } "M" { set tag modified } "P" { set tag updated } "R" { set tag removed } "U" { set tag updated } "!" { set tag warning } "~" { set tag warning } "?" { set tag [expr {$cvscfg(status_filter) ? {noshow} : {unknown}}] } default { set tag default } } #gen_log:log T "LEAVE: $tag" return [list $tag "$line"] } # A filter to colorize diff (patch) output proc patch_colortags {exec line} { global cvscfg #gen_log:log T "ENTER ($exec \"$line\")" set tag default # Return the type of the line being output switch -regexp -- $line { { is new;} { set tag added } { changed from } { set tag modified } { is removed;} { set tag removed } {^\+} { set tag added } {^> } { set tag added } {^\-} { set tag removed } {^< } { set tag removed } {^@@ } { set tag yellow } {^Index} { set tag invert } {^diff } { set tag invert } {^commit } { set tag yellow } default { set tag default } } #gen_log:log T "LEAVE: $tag" return [list $tag "$line"] } # A filter to colorize an RCS log proc rcslog_colortags {exec line} { set tag default switch -glob -- $line { {=============*} { set tag invert } {RCS file:*} { set tag patched } {Working file:*} { set tag patched } {-------------*} { set tag patched } default { set tag default } } return [list $tag "$line"] } # A filter to truncate git log --graph output proc truncate_git_graph {exec line} { #gen_log:log D "$line" if {[regexp {^(.*DdDdD)(.*)} $line tmp diag tagbr]} { regsub {DdDdD$} $diag {} diag # Cut it off at 80 chars set diag [string range $diag 0 79] if {[string length $diag] < 80} { # or pad it out to 80 set diag [format "%-80s" $diag] } return [list "" "$diag $tagbr"] } else { #gen_log:log D " NO MATCH: $line" return [list "" "$line"] } } # This is a plain viewer that prints whatever text is sent to it. # Called directly with input gathered from an eval exec, not exec::new namespace eval ::view_output { variable instance 0 proc new {title text_to_display} { variable instance set my_idx $instance incr instance #gen_log:log T "ENTER ($title ...)" namespace eval $my_idx { global cvscfg variable my_idx [uplevel {concat $my_idx}] variable title [uplevel {concat $title}] variable text_to_display [uplevel {list $text_to_display}] variable w ".output$my_idx" variable searchstr {} variable searchidx 1.0 viewer_window $w $title [namespace current] foreach line $text_to_display { $w.text insert end "$line" } proc search {} { variable searchidx variable w set str [$w.bottom.entry get] set match [$w.text search -- $str $searchidx] if {[string length $match] > 0} { set length [string length $str] $w.text mark set insert $match $w.text tag add sel $match "$match + ${length}c" $w.text see $match set searchidx "$match + ${length}c" } } proc destroy {} { if {[catch {namespace delete [namespace current]} err]} { puts "deleting [namespace current]" puts "$err" } } } } } proc viewer_window {w title parent} { global cvscfg global colorglb global tcl_platform toplevel $w if { [tk windowingsystem] eq "x11" } { wm iconphoto $w Says } wm protocol $w WM_DELETE_WINDOW "$w.close invoke" text $w.text -setgrid yes -relief sunken -borderwidth 2 \ -bg $colorglb(textbg) -fg $colorglb(textfg) \ -exportselection 1 -height 30 \ -yscrollcommand "$w.scroll set" ro_textbindings $w.text # Configure the various tags foreach outputcolor [array names cvscfg outputColor,*] { regsub {^.*,} $outputcolor {} mode $w.text tag configure "$mode" -foreground $cvscfg($outputcolor) } # foreground of stderr tag is set to default red4 in tkrev_def. We need it to be # readable if the text background is dark. $w.text tag configure "stderr" -background gray85 $w.text tag configure "invert" -foreground $colorglb(textbg) -background $cvscfg(outputColor,patched) ttk::scrollbar $w.scroll -command "$w.text yview" frame $w.bottom button $w.bottom.srchbtn -text Search \ -command "$parent\::search" entry $w.bottom.entry -width 20 -textvariable searchstr bind $w.bottom.entry "$parent\::search" button $w.save -text "Save to File" \ -command "save_viewcontents $w" button $w.close -text "Close" \ -command "catch {$parent\::destroy}; destroy $w; exit_cleanup 0" button $w.stop -text "Stop" -bg red4 -fg white \ -activebackground red4 -activeforeground white \ -state [expr {$cvscfg(allow_abort) ? {normal} : {disabled}}] \ -command "$parent\::abort" pack $w.bottom -side bottom -fill x pack $w.scroll -side right -fill y pack $w.text -fill both -expand 1 pack $w.bottom.srchbtn -side left pack $w.bottom.entry -side left pack $w.save -in $w.bottom -side left -padx 25 pack $w.close -in $w.bottom -side right -ipadx 15 -padx 20 # Focus to activate text bindings focus $w wm title $w "$title" } tkrev_9.6.1/tkrev/tkrev.10000664000175000017500000012117415034126547015641 0ustar dorothyrdorothyr.TH tkrev 1 .SH NAME \fBtkrev\fP - a Tk/Tcl Graphical Interface to CVS, Subversion and Git .SH SYNOPSIS .PP \fBtkrev\fP [\fB-dir\fP \fIdirectory\fP] [\fB-root\fP \fIcvsroot\fP] [\fB-win workdir\fP|\fBmodule\fP|\fBmerge\fP] \fBtkrev\fP [\fB-log\fP|\fBblame\fP \fIfile\fP] \fBtkrev\fP \fBfile\fP - same as \fBtkrev -log\fP \fIfile\fP .SH DESCRIPTION .PP TkRev is a Tcl/Tk-based graphical interface to the CVS, Subversion and Git configuration management systems. It displays the status of the files in the current working directory, and provides buttons and menus to execute configuration-management commands on the selected files. Limited RCS functionality is also present. Git functionality is new in version 9. TkDiff is bundled in for browsing and merging your changes. TkRev also aids in browsing the repository. For Subversion, the repository tree looks like an ordinary file tree. For CVS, the CVSROOT/modules file is read. TkRev extends CVS with a method to produce a browsable, "user friendly" listing of modules. This requires special comments in the CVSROOT/modules file. See the \fBCVS Modules File\fP section for more guidance. .SH OPTIONS .PP TkRev accepts the following options .TP .B -d, --dir \fIdirectory\fP Start TkRev in the specified directory .TP .B -h, --help Print a usage message .TP .B -l, --log \fIfile\fP Invoke a log browser for the specified file .TP .B -b, --blame \fIfile\fP Invoke a blame (annotation) browser for the specified file .TP .B -v, --vcs \fIcvs|svn|git|rcs\fP Use the specified version control system .TP .B -r, --root \fIcvsroot\fP Use the specified repository root .TP .B -w, --win \fBworkdir\fP|\fBmodule\fP|\fBmerge\fP Start by displaying the directory browser (the default), the module browser, or the directory-merge tool. -win and -log are mutually exclusive. .PP .SS Examples Browse the modules located in CVSROOT /jaz/repository: % tkrev --win module --root /jaz/repository View the log of the file tstheap.c: % tkrev ---log tstheap.c .SH Current Directory Browser .PP The working directory browser shows the files in your local working copy, or "sandbox." It shows the status of the files at a glance and provides tools to help with most of the common version control operations you might do. At the top of the browser you will find: \fB*\fP The name of the current directory. You can change directories by typing in this field. Recently visited directories are saved in the picklist. \fB*\fP The relative path of the current directory in the repository. If it is not contained in the repository you may import it using the menu or toolbar button. \fB*\fP A Directory Tag name, if the directory is contained in the repository and it has been checked out against a particular branch or tag. In Subversion, the branch or tag is inferred from the URL based on the conventional trunk-branches-tags repository organization. \fB*\fP The repository location of the current directory - CVSROOT if it's under CVS control, the URL of the Subversion repository if it's under Subversion control, or the origin if it's controlled by Git. If not a version-controlled directory, it may default to the value of the $CVSROOT environment variable. The main part of the working directory browser is a list of the files in the current directory with an icon next to each showing its status. You select a file by clicking on its name or icon once with the left mouse button. Holding the Control key while clicking will add the file to the group of those already selected. You can select a contiguous group of files by holding the Shift key while clicking. You can also select a group of files by dragging the mouse with the middle or right button pressed to select an area. Selecting an item that's already selected de-selects that item. To unselect all files, click the left mouse button in an empty area of the file list. \fB*\fP The Date column (can be hidden) shows the modification time of the file is shown. The format of the date column may be specified with cvscfg(dateformat). The default format was chosen because it sorts the same way alphabetically as chronologically. If the directory belongs to a revision system, other columns are present. \fB*\fP The revision column shows which revision of the file is checked out, and whether it's on the trunk or on a branch. \fB*\fP The status column (can be hidden) shows the revision of the file spelled out in text. This information is mostly redundant to the icon in the file column. \fB*\fP The Editor/Author/Locker column (can be hidden) varies according to revision system. In Subversion, the author of the most recent checkin is shown. In CVS, it shows a list of people editing the files if your site uses "cvs watch" and/or "cvs edit". Otherwise, it will be empty. In RCS, it shows who, if anyone, has the file locked. The optional columns can be displayed or hidden using the Options menu. You can move into a directory by double-clicking on it. Double clicking on a file will load the file into a suitable editor so you can change it. A different editor can be used for different file types (see Configuration Files). .PP .SS File Status When you are in a directory that is under CVS, Subversion, or Git control, the file status will be shown by an icon next to each file. Checking the "Status Column" option causes the status to be displayed in text in its own column. Some possible statuses are: .TP .B Up-to-date The file is up to date with respect to the repository. .TP .B Locally Modified The file has been modified in the current directory since being checked out of the repository. .TP .B Locally Added The file has been added to the repository. This file will become permanent in the repository once a commit is made. .TP .B Locally Removed You have removed the file with remove, and not yet committed your changes. .TP .B Needs Checkout Someone else has committed a newer revision to the repository. The name is slightly misleading; you will ordinarily use update rather than checkout to get that newer revision. .TP .B Needs Patch Like Needs Checkout, but the CVS server will send a patch rather than the entire file. Sending a patch or sending an entire file accomplishes the same thing. .TP .B Needs Merge Someone else has committed a newer revision to the repository, and you have also made modifications to the file. .TP .B Unresolved Conflict This is like Locally Modified, except that a previous update command gave a conflict. You need to resolve the conflict before checking in. .TP .B ? The file is not contained in the repository. You may need to add the file to the repository by pressing the "Add" button. .TP .B [directory:CVS] A directory which has been checked out from a CVS repository. .TP .B [directory:SVN] A directory which has been checked out from a Subversion repository. In Subversion, directories are themselves versioned objects. .TP .B [directory:RCS] A directory which contains an RCS sub-directory or some files with the ,v suffix, presumably containing some files that are under RCS revision control. .TP .B [directory:GIT] A directory which has been cloned from a Git repository. .TP .B [directory] A directory not controlled by one of the supported revision control systems .PP .SS File Filters .TP .B Clean You can specify file matching patterns to instruct TkRev which files you wish to see. You can also specify patterns telling it which files to remove when you press the "Clean" button or select the \fBFile -> Cleanup\fP menu item. .TP .B Hide "Hide" works exactly the way a .cvsignore file works. That is, it causes non-CVS files with the pattern to be ignored. It's meant for hiding .o files and such. Any file under CVS control will be listed anyway. .TP .B Show "Show" is the inverse. It hides non-CVS files except for those with the pattern. .SS Buttons .TP .B Module Browser: The big button at the upper right opens the module browser opens a module browser window which will enable you to explore items in the repository even if they're not checked out. In CVS, this requires that there be entries in the CVSROOT/modules file. Browsing can be improved by using TkRev-specific comments in CVSROOT/modules. .TP .B Go Up: The button to the left of the entry that shows the current directory. Press it and you go up one level. .PP There are a number of buttons at the bottom of the window. Pressing on one of these causes the following actions: .TP .B Delete: Press this button to delete the selected files. The files will not be removed from the repository. To remove the files from the repository as well as delete them, press the "Remove" button instead. .TP .B Edit: Press this button to load the selected files in to an appropriate editor. .TP .B View: Press this button to view the selected files in a Tk text window. This can be a lot faster then Edit, in case your preferred editor is xemacs or something of that magnitude. .TP .B Refresh: Press this button to re-read the current directory, in case the status of some files may have changed. .TP .B Status Check: Shows, in a searchable text window, the status of all the files. By default, it is recursive and lists unknown (?) files. These can be changed in the Options menu. .TP .B Directory Branch Browser: For merging the entire directory. In Subversion, it opens the Branch Browser for "." In CVS, it chooses a "representative" file in the current directory and opens a graphical tool for directory merges. .TP .B Log (Branch) Browse: This button will bring up the log browser window for each of the selected files in the window. See the \fBBranch Diagram Browser\fP section. .TP .B Annotate: This displays a window in which the selected file is shown with the lines highlighted according to when and by whom they were last revised. In Subversion, it's also called "blame." .TP .B Diff: This compares the selected files with the equivalent files in the repository. A separate program called "TkDiff" (also supplied with TkRev) is used to do this. For more information on TkDiff, see TkDiff's help menu. .TP .B Merge Conflict: If a file's status says "Needs Merge", "Conflict", or is marked with a "C" in CVS Check, there was a difference which CVS needs help to reconcile. This button invokes TkDiff with the -conflict option, opening a merge window to help you merge the differences. .TP .B Check In: This button commits your changes to the repository. This includes adding new files and removing deleted files. When you press this button, a dialog will appear asking you for the version number of the files you want to commit, and a comment. You need only enter a version number if you want to bring the files in the repository up to the next major version number. For example, if a file is version 1.10, and you do not enter a version number, it will be checked in as version 1.11. If you enter the version number 3, then it will be checked in as version 3.0 instead. It is usually better to use symbolic tags for that purpose. If you use rcsinfo to supply a template for the comment, you must use an external editor. Set cvscfg(use_cvseditor) to do this. For checking in to RCS, an externel editor is always used. .TP .B Update: This updates your sandbox directory with any changes committed to the repository by other developers. .TP .B Update with Options: Allows you to update from a different branch, with a tag, with empty directories, and so on. .TP .B Add Files: Press this button when you want to add new files to the repository. You must create the file before adding it to the repository. To add some files, select them and press the Add Files button. The files that you have added to the repository will be committed next time you press the Check In button. It is not recursive. Use the menu \fBCVS -> Add Recursively\fP for that. .TP .B Remove Files: This button will remove files. To remove files, select them and press the Remove button. The files will disappear from the directory, and will be removed from the repository next time you press the Check In button. It is not recursive. Use the menu \fBCVS -> Remove Recursively\fP for that. .TP .B Tag: This button will tag the selected files. In CVS, the \fB-F (force)\fP option will move the tag if it already exists on the file. .TP .B Branch Tag: This button will tag the selected files, creating a branch. In CVS, the \fB-F (force)\fP option will move the tag if it already exists on the file. .TP .B Lock (CVS and RCS): Lock an RCS file for editing. If cvscfg(cvslock) is set, lock a CVS file. Use of locking is philosophically discouraged in CVS since it's against the "concurrent" part of Concurrent Versioning System, but locking policy is nevertheless used at some sites. One size doesn't fit all. .TP .B Unlock (CVS and RCS): Unlock an RCS file. If cvscfg(cvslock) is set, unlock a CVS file. .TP .B Set Edit Flag (CVS): This button sets the edit flag on the selected files, enabling other developers to see that you are currently editing those files (See "cvs edit" in the CVS documentation). .TP .B Reset Edit Flag (CVS): This button resets the edit flag on the selected files, enabling other developers to see that you are no longer editing those files (See "cvs edit" in the CVS documentation). As the current version of cvs waits on a prompt for "cvs unedit" if changes have been made to the file in question (to ask if you want to revert the changes to the current revision), the current action of tkrev is to abort the unedit (by piping in nothing to stdin). Therefore, to lose the changes and revert to the current revision, it is necessary to delete the file and do an update (this will also clear the edit flag). To keep the changes, make a copy of the file, delete the original, update, and then move the saved copy back to the original filename. .TP .B Close: Press this button to close the Working Directory Browser. If no other windows are open, TkRev exits. .SH Repository Browser .PP Operations that are performed on the repository instead of in a checked-out working directory are done with the Module Browser. The most common of these operations is checking out or exporting from the repository. The Module Browser can be started from the command line (tkrev -win module) or started from the main window by pressing the big button. Subversion repositories can be browsed like a file tree, and that is what you will see in the Module Browser. CVS repositories aren't directly browsable, but if the CVSROOT/modules file is maintained appropriately, TkRev can display the modules and infer tree structures if they are present. See the \fBCVS Modules File\fP section. Using the module browser window, you can select a module to check out. When you check out a module, a new directory is created in the current working directory with the same name as the module. .SS Tagging and Branching (cvs rtag) You can tag particular versions of a module or file in the repository, with plain or branch tags, without having the module checked out. .SS Exporting Once a software release has been tagged, you can use a special type of checkout called an export. This allows you to cleanly check out files from the repository, without all of the administrivia that CVS needs to have while working on the files. It is useful for delivery of a software release to a customer. .SS Importing TkRev contains a special dialog to allow users to import new files into the repository. In CVS, new modules can be assigned places within the repository, as well as descriptive names (so that other people know what they are for). When the Module Browser displays a CVS repository, the first column is a tree showing the module codes and directory names of all of the items in the repository. The icon shows whether the item is a directory (which may contain other directories or modules), or whether it is a module (which may be checked out from TkRev). It is possible for an item to be both a module and a directory. If it has a red ball on it, you can check it out. If it shows a plain folder icon, you have to open the folder to get to the items that you can check out. To select a module, click on it with the left mouse button. The right mouse button will perform a secondary selection, which is used only for Subversion diff and patch. To clear the selection, click on the item again or click in an empty area of the module column. There can only be one primary and one secondary selection. .SS Repository Browser Buttons The module browser contains the following buttons: .TP .B Who: CVS only. Shows which modules are checked out by whom. .TP .B Import: This item will import the contents of the current directory (the one shown in the Working Directory Browser) into the repository as a module. See the section titled Importing for more information. .TP .B File Browse: Displays a list of the selected module's files. From the file list, you can view the file, browse its revision history, or see a list of its tags. .TP .B Check Out: Checks out the current version of a module. A dialog allows you to specify a tag, change the destination, and so on. .TP .B Export: Exports the current version of a module. A dialog allows you to specify a tag, change the destination, and so on. Export is similar to check-out, except exported directories do not contain the CVS or administrative directories, and are therefore cleaner (but cannot be used for checking files back in to the repository). You must supply a tag name when you are exporting a module to make sure you can reproduce the exported files at a later date. .TP .B Tag: This button tags an entire module. .TP .B Branch Tag: This creates a branch of a module by giving it a branch tag. .TP .B Patch Summary: This item displays a short summary of the differences between two versions of a module. .TP .B Create Patch File: This item creates a Larry Wall format patch(1) file of the module selected. .TP .B Close: This button closes the Repository Browser. If no other windows are open, TkRev exits. .SH Branch Diagram Browser .PP The TkRev Log Browser window enables you to view a graphical display of the revision log of a file, including all previous versions and any branched versions. You can get to the log browser window in three ways, either by invoking it directly with \fBtkrev [-log]\fP \fIfilename\fP, by selecting a file in the main window of TkRev and pressing the Log Browse button, or by selecting a file in a list invoked from the module browser and pressing the Log Browse button. If the Log Browser is examining a checked-out file, the buttons for performing merge operations are enabled. .SS Log Browser Window The log browser window has three components. These are the file name and version information section at the top, the log display in the middle, and a row of buttons along the bottom. .SS Log Display The main log display is fairly self explanatory. It shows a group of boxes connected by lines indicating the main trunk of the file development (on the left hand side) and any branches that the file has (which spread out to the right of the main trunk). Each box contains the version number, author of the version, and other information determined by the menu Diagram -> Revision Layout. Constructing the branch diagram from Subversion is inefficient, so the Log Browser counts the tags when doing a Subversion diagram and pops up a dialog giving you a chance to skip the tag step if there are too many tags (where "many" arbitrarily equals 10.) .SS Version Numbers Once a file is loaded into the log browser, one or two version numbers may be selected. The primary version (Selection A) is selected by clicking the left mouse button on a version box in the main log display. The secondary version (Selection B) is selected by clicking the right mouse button on a version box in the main log display. Operations such as "View" and "Annotate" operate only on the primary version selected. Operations such as "Diff" and "Merge Changes to Current" require two versions to be selected. .SS Searching the Diagram You can search the canvas for tags, revisions, authors, and dates. The following special characters are used in the search pattern: * Matches any sequence of characters in string, including a null string. ? Matches any single character in string. [chars] Matches any character in the set given by chars. If a sequence of the form x-y appears in chars, then any character between x and y, inclusive, will match. \\x Matches the single character x. This provides a way of avoiding interpretation of the spacial characters in a pattern. If you only enter "foo" (without the quotes) in the entry box, it searches the exact string "foo". If you want to search all strings starting with "foo", you have to put "foo*". For all strings containing "foo", you must put "*foo*". .SS Log Browser Buttons The log browser contains the following buttons: .TP .B Refresh: Re-reads the revision history of the file .TP .B View: Pressing this button displays a Tk text window containing the version of the file at Selection A. .TP .B Annotate: This displays a window in which the file is shown with its lines highlighted according to when and by whom they were last revised. In Subversion, it's also called "blame." .TP .B Diff: Pressing this button runs the "tkdiff" program to display the differences between version A and version B. .TP .B Merge: To use this button, select a branch version of the file, other than the branch you are currently on, as the primary version (Selection A). The changes made along the branch up to that version will be merged into the current version, and stored in the current directory. Optionally, select another version (Selection B) and the changes will be from that point rather than from the base of the branch. The version of the file in the current directory will be merged, but no commit will occur. Then you inspect the merged files, correct any conflicts which may occur, and commit when you are satisfied. Optionally, TkRev will tag the version that the merge is from. It suggests a tag of the form "mergefrom_rev_date." If you use this auto-tagging function, another dialog containing a suggested tag for the merged-to version will appear. It's suggested to leave the dialog up until you are finished, then copy-and-paste the suggested tag into the "Tag" dialog. It is always a good practice to tag when doing merges, and if you use tags of the suggested form, the Branch Browser can diagram them. (Auto-tagging is not implemented in Subversion because, despite the fact that tags are "cheap," it's somewhat impractical to auto-tag single files. You can do the tagging manually, however.) .TP .B View Tags: This button lists all the tags applied to the file in a searchable text window. .TP .B Close: This button closes the Log Browser. If no other windows are open, TkRev exits. .PP .SS The Diagram Menu The Diagram Menu allows you to control what you see in the branch diagram. You can choose how much information to show in the boxes, whether to show empty revisions, and whether to show tags. You can even control the size of the boxes. If you are using Subversion, you may wish to turn the display of tags off. If they aren't asked for they won't be read from the repository, which can save a lot of time. .SH Directory Merge Tool for CVS .PP The Directory Merge Tool chooses a "representative" file in the current directory and diagrams the branch tags. It tries to pick the "bushiest" file, or failing that, the most-revised file. If you disagree with its choice, you can type the name of another file in the top entry and press Return to diagram that file instead. The main purpose of this tool is to do merges (cvs update -j rev [-j rev]) on the whole directory. For merging one file at a time, you should use the Log Browser. You can only merge to the line (trunk or branch) that you are currently on. Select a branch to merge from by clicking on it. Then press either the "Merge" or "Merge Changes" button. The version of the file in the current directory will be over-written, but it will not be committed to the repository. You do that after you've reconciled conflicts and decided if it's what you really want. .SS Merge Branch to Current: The changes made on the branch since its beginning will be merged into the current version. .SS Merge Changes to Current: Instead of merging from the base of the branch, this button merges the changes that were made since a particular version on the branch. It pops up a dialog in which you fill in the version. It should usually be the version that was last merged. .SH Importing New Modules .PP Before importing a new module, first check to make sure that you have write permission to the repository. Also you'll have to make sure the module name is not already in use. To import a module you first need a directory where the module is located. Make sure that there is nothing in this directory except the files that you want to import. Press the big "Repository Browser" button in the top part of the tkrev UI, or use CVS -> Import WD into Repository from the menu bar. In the module browser, press the Import button on the bottom, the one that shows a folder and an up arrow. In the dialog that pops up, fill in a descriptive title for the module. This will be what you see in the right side of the module browser. OK the dialog. Several things happen now. The directory is imported, the CVSROOT/module file is updated, your original directory is saved as directory.orig, and the newly created module is checked out. When it finishes, you should find the original Working Directory Browser showing the files in the newly created, checked out module. Here is a more detailed description of the fields in the Import Dialog. .TP .B Module Name: A name for the module. This name must not already exist in the repository. Your organization could settle on a single unambiguous code for modules. One possibility is something like: [project code]-[subsystem code]-[module code] .TP .B Module Path: The location in the repository tree where your new module will go. .TP .B Descriptive Title: A one-line descriptive title for your module. This will be displayed in the right-hand column of the browser. .TP .B Version Number: The current version number of the module. This should be a number of the form X.Y.Z where .Y and .Z are optional. You can leave this blank, in which case 1 will be used as the first version number. .PP Importing a directory into Subversion is similar but not so complicated. You use the SVN -> Import CWD into Repository menu. You need supply only the path in the repository where you want the directory to go. The repository must be prepared and the path must exist, however. .SH Importing to an Existing Module .PP Before importing to an existing module, first check to make sure that you have write permission to the repository. To import to an existing module you first need a directory where the code is located. Make sure that there is nothing in this directory (including no CVS directory) except the files that you want to import. Open up the Repository Browser by selecting \fBFile -> Browse Modules\fP from the menu bar. In the Repository Browser, select \fBFile -> Import To An Existing Module\fP from the menu bar. In the dialog that pops up, press the Browse button and select the name of an existing module. Press the OK to close this dialog box. Enter the version number of the code to be imported. OK the dialog. Several things happen now. The directory is imported, your original directory is saved as directory.orig, and the newly created module is checked out. When it finishes, you will find the original Working Directory Browser showing the original code. If you press the "Re-read the current directory" button you will see the results of the checked out code. Here is a more detailed description of the fields in the Import Dialog. .TP .B Module Name: A name for the existing module. Filled in by the use of the the Browse button .TP .B Module Path: The location in the repository tree where the existing module is. Filled in by the use of the Browse button. .TP .B Version Number: The current version number of the module to be imported. This should be a number of the form X.Y.Z where .Y and .Z are optional. You can leave this blank, in which case 1 will be used as the first version number. .SH Vendor Merge for CVS .PP Software development is sometimes based on source distribution from a vendor or third-party distributor. After building a local version of this distribution, merging or tracking the vendor's future release into the local version of the distribution can be done with the vendor merge command. The vendor merge command assumes that a separate module has already been defined for the vendor or third-party distribution with the use of the "Import To A New Module" and "Import To An Existing Module" commands. It also assumes that a separate module has already been defined for the local code for which the vendor merge operation is to be applied to. Start from an empty directory and invoke tkrev. Open up the Repository Browser by selecting \fBFile -> Browse Modules\fP from the menu bar. Checkout the module of the local code to be merged with changes from the vendor module. (Use the red icon with the down arrow) In the Repository Browser, after verifying that the Module entry box still has the name the module of the local code to which the vendor code is to be merged into, select File/Vendor Merge from the menu bar. In the Module Level Merge With Vendor Code window, press the Browse button to select the module to be used as the vendor module. OK the dialog. All revisions from the vendor module will be shown in the two scroll lists. Fill in the From and To entry boxes by clicking in the appropriate scroll lists. Ok the dialog. Several things happens now. Several screens will appear showing the output from cvs commands for (1)checking out temp files, (2)cvs merge, and (3)cvs rdiff. Information in these screens will tell you what routines will have merge conflicts and what files are new or deleted. After perusing the files, close each screen. (In the preceding dialog box, there was an option to save outputs from the merge and rdiff operations to files CVSmerge.out and CVSrdiff.out.) The checked out local code will now contain changes from a merge between two revisions of the vendor modules. This code will not be checked into the repository. You can do that after you've reconciled conflicts and decide if that is what you really want. A detailed example on how to use the vendor merge operation is provided in the PDF file vendor5readme.pdf. .SH FILES .PP There are two configuration files for TkRev. The first is stored in the directory in which the *.tcl files for TkRev are installed. This is called tkrev_def.tcl. You can put a file called site_def in that directory, too. That's a good place for site-specific things like tagcolours. Unlike tkrev_def.tcl, it will not be overwritten when you install a newer version of TkRev. Values in the site configuration files can be over-ridden at the user level by placing a .tkrev file in your home directory. Commands in either of these files should use Tcl syntax. In other words, to set a variable name, you should have the following command in your .tkrev file: set variablename value for example: set cvscfg(editor) "gvim" The following variables are supported by TkRev: .SS Startup .TP .B cvscfg(startwindow) Which window you want to see on startup. (workdir or module) .TP .B cvscfg(vcspref) When more than one revision control system is present in a directory, this specifies an order of precedence. The default order is {cvs svn git rcs} .SS GUI .TP .B tk scaling In case your display resolution is unusual, you can scale all the text to make the UI larger or smaller. For example tk scaling 1.9 would make it almost double size. .TP .B cvscfg(large_icons) If not zero, the UI icons will be displayed at double size .TP .B cvscfg(match_desktop) If true, tkrev will attempt to detect colors set by the desktop environment, whether gtk or CDE. It's turned off by default, because it's experimental, except for CDE which has been there since CDE was in general use. .SS CVS .TP .B cvscfg(cvsroot) If set, it overrides the CVSROOT environment variable. .SS Subversion If your SVN repository has a structure similar to trunk, branches, and tags but with different names, you can tell TkRev about it by setting variables in tkrev_def.tcl: set cvscfg(svn_trunkdir) "elephants" set cvscfg(svn_branchdir) "dogs" set cvscfg(svn_tagdir) "ducklings" The branch browser depends on the convention of having a trunk, branches, and tags structure to draw the diagram. These variables may give you a little more flexibility. .SS GIT .TP .B cvscfg(gitdetail) Set to true or false. If it's false (off) an individual Git log call to each file will be suppressed to save time. You won't see the hashtag or committer in that case. .TP .B cvscfg(gitmaxhist) For the branch visualizer. Tells how far back into the history to go. Default is 250 commits. .TP .B cvscfg(picklist_items) Maximum number of visited directories and repositories to save in the picklist history .SS Log browser .TP .B cvscfg(colourA), cvscfg(colourB) Hilight colours for revision-log boxes .TP .B cvscfg(tagdepth) Number of tags you want to see for each revision on the branching diagram before it says "more..." and offers a pop-up to show the rest .TP .B cvscfg(toomany_tags) Maximum number of tags in a Subversion repository to process and display .TP .B cvscfg(tagcolour,tagstring) Colors for marking tags. For example: set cvscfg(tagcolour,tkcvs_r6) Purple .SS Module browser .TP .B cvscfg(aliasfolder) In the CVS module browser, if true this will cause the alias modules to be grouped in one folder. Cleans up clutter if there are a lot of aliases. .SS User preferences .TP .B cvscfg(allfiles) Set this to false to see normal files only in the directory browser. Set it to true to see all files including hidden files. .TP .B cvscfg(auto_status) Set the default for automatic status-refresh of a version-controlled directory. Automatic updates are done when a directory is entered and after some operations. .TP .B cvscfg(auto_tag) Whether to tag the merged-from revision when using TkRev to merge different revisions of files by default. A dialog still lets you change your mind, regardless of the default. .TP .B cvscfg(confirm_prompt) Ask for confirmation before performing an operation(true or false) .TP .B cvscfg(dateformat) Format for the date string shown in the "Date" column, for example "%Y/%m/%d %H:%M" .TP .B cvscfg(cvslock) Set to true to turn on the ability to use cvs-admin locking from the GUI. .TP .B cvscfg(econtrol) Set this to true to turn on the ability to use CVS Edit and Unedit, if your site is configured to allow the feature. .TP .B cvscfg(editor) Preferred default editor .TP .B cvscfg(editors) String pairs giving the editor-command and string-match-pattern, for deciding which editor to use .TP .B cvscfg(editorargs) Command-line arguments to send to the default editing program. .TP .B cvscfg(mergetoformat), cvscfg(mergefromformat) Format for mergeto- and mergefrom- tags. The _BRANCH_ part must be left as-is, but you can change the prefix and the date format, for example "mergeto_BRANCH_%d%b%y". The date format must be the same for both. CVS rule: a tag must not contain the characters `$,.:;@' .TP .B cvscfg(recurse) Whether reports are recursive (true or false) .TP .B cvscfg(savelines) How many lines to keep in the trace window .TP .B cvscfg(status_filter) Filter out unknown files (status "?") from CVS Check and CVS Update reports. .TP .B cvscfg(use_cvseditor) Let CVS invoke an editor for commit log messages rather than having tkrev use its own input box. By doing this, your site's commit template (rcsinfo) can be used. .SS File filters .TP .B cvscfg(show_file_filter) Pattern for which files to list. Empty string is equivalent to the entire directory (minus hidden files) .TP .B cvscfg(ignore_file_filter) Pattern used in the workdir filter for files to be ignored .TP .B cvscfg(clean_these) Pattern to be used for cleaning a directory (removing unwanted files) .SS System .TP .B cvscfg(print_cmd) System command used for printing. lpr, enscript -Ghr, etc) .TP .B cvscfg(shell) What you want to happen when you ask for a shell .TP .B cvscfg(terminal) Command prefix to use to run something in a terminal window .SS Portability .TP .B cvscfg(aster) File mask for all files (* for Unix, *.* for windows) .TP .B cvscfg(null) The null device. /dev/null for Unix, nul for windows .TP .B cvscfg(tkdiff) How to start tkdiff. Example sh /usr/local/bin/tkdiff .TP .B cvscfg(tmpdir) Directory in which to do behind-the-scenes checkouts. Usually /tmp or /var/tmp) .SS Debugging .TP .B cvscfg(log_classes) Types of debug output in the trace window: C=commands, E=command stderr, S=command stdout, T=Function entry/exit, D=Debugging, F=File creation/deletion .TP .B cvscfg(logging) Logging (debugging) on or off .SH User Defined Menu .PP It is possible to extend the TkRev menu by inserting additional commands into the .tkrev or tkrev_def.tcl files. These extensions appear on an extra menu to the right of the TkRev Options menu. To create new menu entries on the user-defined menu, set the following variables: .TP .B cvsmenu(command) Setting a variable with this name to a value like "commandname" causes the CVS command "cvs commandname" to be run when this menu option is selected. For example, the following line: set cvsmenu(update_A) "update -A" Causes a new menu option titled "update_A" to be added to the user defined menu that will run the command "cvs update -A" on the selected files when it is activated. (This example command, for versions of CVS later than 1.3, will force an update to the head version of a file, ignoring any sticky tags or versions attached to the file). .TP .B usermenu(command) Setting a variable with this name to a value like "commandname" causes the command "commandname" to be run when this menu option is selected. For example, the following line: set usermenu(view) "cat" Causes a new menu option titled "view" to be added to the User defined menu that will run the command "cat" on the selected files when it is activated. .PP Any user-defined commands will be passed a list of file names corresponding to the files selected on the directory listing on the main menu as arguments. The output of the user defined commands will be displayed in a window when the command is finished. .SH CVS Modules File .PP If you haven't put anything in your CVSROOT/modules file, please do so. See the "Administrative Files" section of the CVS manual. Then, you can add comments which TkRev can use to title the modules and to display them in a tree structure. The simplest use of TkRev's "#D" directive is to display a meaningful title for the module: #D softproj Software Development Projects softproj softproj A fancier use is to organize the modules into a tree which will mimic their directory nesting in the repository when they appear in the module browser. For example, suppose we have a directory called "chocolate" which is organized like this: chocolate/ truffle/ cocoa3/ biter/ sniffer/ snuffler/ To display its hierarchy, as well as make the deepest directories more accessible by giving them module names, we could put this in the modules file: #D chocolate Top Chocolate #D chocolate/truffle Cocoa Level 2 #D chocolate/truffle/cocoa3 Cocoa Level 3 #D sniffer Chocolate Sniffer sniffer chocolate/truffle/cocoa3/sniffer #D snuff Chocolate Snuffler snuff chocolate/truffle/cocoa3/snuffler #D biter Chocolate Biter biter chocolate/truffle/cocoa3/biter When you are installing TkRev, you may like to add these additional lines to the modules file (remember to check out the modules module from the repository, and then commit it again when you have finished the edits). These extension lines commence with a "#" character, so CVS interprets them as comments. They can be safely left in the file whether you are using TkRev or not. "#M" is equivalent to "#D". The two had different functions in previous versions of TkRev, but now both are parsed the same way. .SH ENVIRONMENT .PP If you use CVS, you can set the CVSROOT environment variable to point to the location of your default CVS repository. The Module Browser will look for SVNROOT and GITROOT as well, although those have no meaning to SVN or Git respectively. If you like to set some color preferences in .Xdefaults or .Xresources, these can be used: tkrev*background: gray80 tkrev*foreground: black tkrev*Menu.background: gray65 tkrev*Menu.foreground: white tkrev*Button.background: gray75 tkrev*Button.foreground: black tkrev*Canvas.background: gray90 tkrev*Canvas.foreground: black tkrev*Text.background: gray90 tkrev*Text.foreground: black tkrev*Text.selectBackground: slateblue tkrev*Text.selectForeground: white tkrev*Menu.font: {Serif 12} tkrev*Button.font: {Serif 11} tkrev*Label.font: {Cantarell 10} tkrev*List.font: {Cantarell 10} tkrev*Text.font: {DejaVu Sans Mono 10} .SH SEE ALSO \fBtkdiff\fP online help, \fBcvs\fP, \fBsvn\fP, \fBgit<\fP tkrev_9.6.1/tkrev/tooltips.tcl0000664000175000017500000000626115034044006016771 0ustar dorothyrdorothyr# # tooltips version 0.1 # Paul Boyer # Science Applications International Corp. # # THINGS I'D LIKE TO DO: # 1. make a widget called "tooltip_button" which does it all # and takes name and helptext as arguments in addition to all # button args # 2. Keep visibility of tooltip always on top # 3. Must be a better way to maintain button presses than rebinding? # Because I don't want to explicitly handle all possible bindings # such as etc # 4. Allow for capability for status window at bottom of a frame # that gets the status of the selected icon ############################## # set_tooltips gets a button's name and the tooltip string as # arguments and creates the proper bindings for entering # and leaving the button proc set_tooltips { widget name } { global cvsglb bind $widget " catch { after 500 { internal_tooltips_PopUp %W $name } } \ cvsglb(tooltip_id) " bind $widget "internal_tooltips_PopDown" bind $widget "internal_tooltips_PopDown" } ############################## # internal_tooltips_PopUp is used to activate the tooltip window proc internal_tooltips_PopUp { wid name } { global cvsglb global colorglb # get rid of other existing tooltips catch { destroy .tooltips_wind } if {![winfo exists $wid]} { return } toplevel .tooltips_wind set size_changed 0 set X [winfo pointerx $wid] set Y [winfo pointery $wid] # add a slight offset to make tooltips fall below cursor set Y [expr { $Y + 20 }] # Now pop up the new widgetLabel wm overrideredirect .tooltips_wind 1 wm geometry .tooltips_wind +$X+$Y label .tooltips_wind.l \ -text $name \ -font TkTooltipFont \ -background $colorglb(tooltipbg) \ -foreground $colorglb(tooltipfg) pack .tooltips_wind.l # make invisible wm withdraw .tooltips_wind update idletasks set screenH [winfo screenheight .] set screenW [winfo screenwidth .] set reqW [winfo reqwidth .tooltips_wind] set reqH [winfo reqheight .tooltips_wind] # adjust for bottom of screen if { ($Y + $reqH) > $screenH } { set Y [expr { $Y - $reqH - 25 }] set size_changed 1 } # adjust for right border of screen # The following correction tests whether X + reqwidth goes off the right # side. But if it's a second screen, X is already > screenwidth even before # adding the reqwidth, so it will get backed up onto the wrong screen. I # don't know of a way to detect X relative to the actual multiple-screen # layout, so I'm skipping the correction until a better way is found. if { ($X < $screenW) && (($X + $reqW) > $screenW) } { set X [expr { $screenW - $reqW }] set size_changed 1 } # reset position if { $size_changed == 1 } { wm geometry .tooltips_wind +$X+$Y } # make visible wm deiconify .tooltips_wind # must explicitly raise windows on Mac if {[tk windowingsystem] eq "aqua"} { raise .tooltips_wind } # make tooltip dissappear after 5 sec set cvsglb(tooltip_id) [after 5000 { internal_tooltips_PopDown }] } proc internal_tooltips_PopDown { } { global cvsglb if {[info exists cvsglb(tooltip_id)]} { after cancel $cvsglb(tooltip_id) catch { destroy .tooltips_wind } } } tkrev_9.6.1/www/0000775000175000017500000000000015034253755014111 5ustar dorothyrdorothyrtkrev_9.6.1/www/index.html0000664000175000017500000001023715026336431016103 0ustar dorothyrdorothyr TkCVS Web Page

TkRev Version 9.4


TkCVS fishTkSVN fishTkRev Squid


Formerly TkCVS


Because who uses CVS anymore? Anyway, TkRev is a Tcl/Tk-based graphical interface to the CVS, Subversion and Git configuration management systems. It will also help with RCS.
It shows the status of the files in the current working directory, and has tools for tagging, merging, checking in/out, and other user operations. TkDiff is included for browsing and merging your changes.

TkRev also aids in browsing the repository. For Subversion, the repository tree is browsed like an ordinary file tree. For Git, the branches and tags are listed. For CVS, the CVSROOT/modules file is read. TkRev extends CVS with a method to produce a "user friendly" listing of modules by using special comments in the CVSROOT/modules file.

The user interface is consistent across Unix/Linux, Windows, and MacOS X.

TkRev is free and open-source.


Version 9.x:
  • Added Git functionality!
  • Speeded up branch browsing in Subversion substantially
  • Updated tkdiff to version 4.3.5
  • Made the Repository Browser more independent of the Working Directory Browser. You can now move around among repositories of different version control systems.
  • Updated MacOS X UI to compatibility with version 11.1 (Big Sur)
  • Many user interface tweaks:
    • Made a Copy/Paste right-mouse-button popup for the text widgets, so you can copy text from them
    • Re-arranged the Report and Status detail menus for more efficiency
  • I'm no longer making stand-alone MacOS or Windows packages. But it will run on anything that Tcl/Tk 8.5 will run on.


Get it here 

Download TkCVS


tkrev_9.6.1/www/indexbadge.html0000664000175000017500000001165215026336431017070 0ustar dorothyrdorothyr TkCVS Web Page

TkRev Version 9.4
<!-- Begin SF Tag -->
<div class="sf-root" data-id="3310" data-badge="oss-community-choice-white" data-metadata="achievement=oss-community-choice" style="width:125px">
    <a href="https://sourceforge.net/projects/tkcvs/" target="_blank">TkRev</a>
</div>
<script>(function () {var sc=document.createElement('script');sc.async=true;sc.src='https://b.sf-syn.com/badge_js?sf_id=3310';var p=document.getElementsByTagName('script')[0];p.parentNode.insertBefore(sc, p);})();
</script>
<!-- End SF Tag -->
TkCVS fishTkSVN fishTkRev Squid


Formerly TkCVS


Because who uses CVS anymore? Anyway, TkRev is a Tcl/Tk-based graphical interface to the CVS, Subversion and Git configuration management systems. It will also help with RCS.
It shows the status of the files in the current working directory, and has tools for tagging, merging, checking in/out, and other user operations. TkDiff is included for browsing and merging your changes.

TkRev also aids in browsing the repository. For Subversion, the repository tree is browsed like an ordinary file tree. For Git, the branches and tags are listed. For CVS, the CVSROOT/modules file is read. TkRev extends CVS with a method to produce a "user friendly" listing of modules by using special comments in the CVSROOT/modules file.

The user interface is consistent across Unix/Linux, Windows, and MacOS X.

TkRev is free and open-source.


Version 9.x:
  • Added Git functionality!
  • Speeded up branch browsing in Subversion substantially
  • Updated tkdiff to version 4.3.5
  • Made the Repository Browser more independent of the Working Directory Browser. You can now move around among repositories of different version control systems.
  • Updated MacOS X UI to compatibility with version 11.1 (Big Sur)
  • Many user interface tweaks:
    • Made a Copy/Paste right-mouse-button popup for the text widgets, so you can copy text from them
    • Re-arranged the Report and Status detail menus for more efficiency
  • I'm no longer making stand-alone MacOS or Windows packages. But it will run on anything that Tcl/Tk 8.5 will run on.


Get it here 

Download TkCVS


tkrev_9.6.1/www/CHANGELOG.txt0000777000175000017500000000000015034253755020377 2../CHANGELOG.txtustar dorothyrdorothyrtkrev_9.6.1/www/gifs/0000775000175000017500000000000015034253755015041 5ustar dorothyrdorothyrtkrev_9.6.1/www/gifs/logo_sourceforge.jpg0000664000175000017500000004653615026336431021116 0ustar dorothyrdorothyrJFIFHHExifMM*HHAdobe Photoshop CS4 Macintosh2011:01:25 10:02:15JFIFHH AppleMark   !'")(&"&%+0=4+-:.%&5I6:?AEEE*3KQKCP=CEB   B,&,BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB  }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzw!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzx" ?( ( (wBe¯oSڊNNȱTKK>'Ctr!XqkGmmOgW+RwҨӧYknC7!m؅_],kPDQR*>,c=Ԇmo0eH1Y7y-}H8?ZJ=yc*ʾO썫]JDkt{>q%_^ct~۴rG5tnӺ|*a5ѝ% Wp8t=M]&vaESQEQEQEQEQEQE5"bOj{zP 1;Q`*STĒ#F==Y?'9_5'|ۢM_(1F(1_[j*]8?Q\wpxa+g\Z$qs{v|]cR4lgc] w,t<zyNz@-'uzn@B68~?OskUәj?t4SAS<((((3@E,~n?s9aRIv QE((((P38< }du\ޛ~uNWA$/ȥO^e,M }bNZN~Gڕ FP=`xNϦ,~h^RG^Q (2 ( ( (95ڮ06Վ??Zӱҧ[Ql2J0#ғUն1W3._8fUg"Kio$-amRz}厵n/cfHfsQMdyֵu;最~:~4uֵ.t +0W yr+yH|G޼vۏkA(`v][#ܑŸfkkZڿbÕیj oiнځY3:YZK.B!FHg?ͭjrM͗sgteEN{]6]ST e<85zTT=\mn.hXTm9ŸP:VvoʐvO q,vsn%b̍OSV4nQNV;Nv9c?ERjڔ"TWAEbX]=ޯ==T֫IisumOln,iu.1IZUWI5Ary m?ܢE :V GO2F'ƽUtӓzWsߓ^~7*M(=OKU)M]!n%Rxc]6.  $mLZAl1#|= VvQsNoSj CR:ij{e |U4XƎmkF2 vz֥@%̼Wo Gދu$ҀF69tTSq`XxsZ:/Nzn>$BYp9#տE(EPP 0K'85'b8YYXdvҧ3`9dY7i+d!A([UEVQ@Q@s> ^!I{zʭXҏ4hѕir>/n-`+R3~9FWk]7nM^}sKTLCޥ=*G捕 uu/35ȏH L|Ic'In#F,]&S,uȇ, ğU ?OQ\/m3͓ӶeSFRɮd4yV#p9?ST6z`&5y?% H=ZZ~odD~V:$tJ(G;y-_͕K|DǕjK+ЧIS^}6GQ](LŠ(((((((QEA5#mT} ִh8KtUg3Bӗ&Eia?P*j)Ɯ#A** ( ( ( ( ( (?(126iXȠxJXhttp://ns.adobe.com/xap/1.0/ 3 Adobe Photoshop CS4 Macintosh 2011-01-17T10:16:30-05:00 2011-01-25T10:02:15-05:00 2011-01-25T10:02:15-05:00 xmp.iid:F77F117407206811BFA7ED91A52FE619 xmp.did:F77F117407206811BFA7ED91A52FE619 xmp.did:F77F117407206811BFA7ED91A52FE619 image/jpeg CCx" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?(((/<)wzmfjZx"{W=[ofY(< f7^ IsN"YF*q_Vz/; ex,Vc `T5;B *jKr}^s+=eMOK7l%[#>>6/o=8|C?m $C#tZĚV c/QjC8$o }3^z/&/o Ծ$j^%Hk 4=Y̰':ԵΙ& xǼi7O. l'8s{?kdԣ pVxt0%+ j_Qˀ8.*~0qZ#8hs#^1jq6[V p~.>{o|1Gt~ t A'e/>^O/C~ rHL;ƅl_(3z 0Cᧁ?xE6.+1uho8gCon}gÑh֞=|5kǬΛ7k+p(^s<.&U,CЋlp"af,ό83Zi6R/XhKw((y&~2?Ȳx#Mr}W:ڐGgw{Ꭱ"Zxߋ-'(z-H86:# 0s_eky??~?:㏂V:c~uZ˭ufoO/jRkg[Fgę*0TF랤?@eW. as:J xpt4r~}y酡orv"aG|Ġ|1-;+b|=F gҫcXL6?/ae X./ Z6"hҭF'*ui-J3'tX&//p.#W`jax\E8U֌+P &N#8WEQ]g8QEQEQEQEQEQE`Ůjڕͽj,vvvd "(Q}JέXQ6ERT)I1R攤cRi!3Bu'Rj!N.s,c)Mr1NNN)'vחd߃okvƫ^Cx?,b~3Ni^l͛́nʵ7Wno~zE{_xѤi|swᆖwlsukF$/ ${!?դ_ 3~ῂ<\Oudn?_(~?i߇ג;:tSgaO>rBq.)_+!Ri^\)5dJo|iG# T{L߱aV2CY%~G:?laW_X, ޱ;|a3[>%XS-{,ljW-Ԅg a | |AQv?ߤW҆Ul.!+džUR(,84R> L*|d|9b8<^3QYViw\[KR[#)R9#74\+Zꌣ4%%(ŧR^nmtI(4itӳI;QE@QEQEQET;0L~B[&WnujSQwB[uv&6Zl VV[؍ֻ~I{lCb΅xҨjBZq*E(N7qw+UVz3uiӨNwN5)TN4I 6<皚q=ޤKddSCO?LQQ1ߜ|Gq(J*?3=|?\Y֓inJf1Io֤˳|p?ି7VDk > =g|{uzϗyúݼ77??goß:KhI~ dj\Mx!Դ~ />ף_7?dլXrz\Oao 7nIkLc zv}+n$qwpc T3L]?i & `!6 :# M){>|NLgxż+2|Abeg,v.'\05كI(#QMwo__}iτEFO0hsw_lzG2oK_TasFݏ36$thh ?&-|<gC?-- F馚lM\77v7vvzƍ;O϶ٟ~?<__^j^4CFuKJSu!x׫ie-P~M?n~1 "#rď2F{V{k3Rѵ[@Vnm/چZ6hM[LF0rk>]WS{{ݍ6G,Yk6u⇃8!)*S㏌z?[eR+}SG֣'uK0oo}dնݝp?}-ٚoR63UjxKĞM1W,,~5/"|컫oH_H]+L4ۘo5 :P;{+Eͭ2@xpmܷQFŦ[y4*{^v}nsrs~ʃiNgw촶]ⶩ@~_W}_cu޻OWJZԋpx aO<|a?P63|(x\L_:96Ye8Ͼԭ|EeLu?ޡx bd\Ag"G`p~<^W⋭WPIt{ OJoJk{ Ѥ^ ϲc0%ENZUZ3˾47:wU*Fߖ5!ʴwv62x#c;4|y-c[߆ٶ! OMԴu-.٣^S\?Sˮ|T~4ޣ?e [SZ_?sMMu-OO G5y//~;i~_~=|zoYQQneӳ~|hπ7şl_&X|?cGZݟE; uNi ?e~++c=׿?O5|gZV\xƚݶyajl-ԿRϋ>'xJ |;u_^k>-4h5]wPX\ݛn"}οH?kKo&W :ƟY|I{ysi8t JwRo&_dq_D_5ཌྷI7|SkU4݋vږ+wsm {+;¿j'ɳZT9Qg5p8W `0S9Rx|]YӔA9+<*TyK n4q_ٹ7/J*𡋩a&+SWUF2IIz?SS^4w8h< Òsuwgk~NΕ? m6U'ơ9~ȟfߊ>3q^^ΩGg]UC<=KLT}[x๟~|?z [WWOxo֯&k}7Lً߱Y f~?X?ƏXw6Z%Ѣ~ҧ?we~ G Or>޵, PB5:jS-6&Ӳs,__0qyP1UZ6*r^R8B8Q7N1J1?W?SٿO_ڳRx%uuCGm{AGҵ_fZ^z?><`.9{m @.RV5K]oYZi"]6"(7MGAkv_I|i|OEVω<7φ9lW,6sCjZf I+GT۶&$u">>0=ÍgJ/¾мKXn#M_Ɨa}Y{[-/mZ62,@|y& wa ktiPxxhMw\_@tQG9תEQNm8r85v_Bzs\gxM['v./(osW߅|/xOnj<_2]z{lq1f?hτ~ '5ۅ?f1k>?-irNX`??bٳߵ'{4x|whj\jzx2ck gD|\Oa'4+Y|;~|WqOE<'i1uZ^~}sN *P5hqQ޿6_ z}5M/EWMGu۷e[U,y/~k3-G4pgAo$7uxs^kUs=Vk?e3A|u?5/|{c|Mq[g-%O4k{-:R"l.Oѱ}?S5VIEY+ioduJ$ț[]^O_K 5/_O/ۋ:+ k2L\_\bRMޏxx:? ĿAc>+Ѻx?_h$yj6 OٮtmX6gM~_۷[5_ύYQM̛10=q끎hQRc4O_WvowͿm6e߳'_o?gxZ ifh+ a X4CB6vewZ^YٿiV~E!g }.QA~tk)?FO`oF3M̝n]Ч+^? Ir]gO~> ΍mk-.~!|Nsx7~]ඎkaϩjWVfO؋D~ \|ċYYvˮ[i`t]GXȷL0Jgnu*JԓRqp+ХF\ZN7嶉^ӯ­~|~?ď5?W˗5?z.]X{M6oikQz, 썧J\xr_so_/$o[?7JeY<;-,q+W~^ ;mi:6/ƅV+r_v'FE>h_í͟^|%m<_z.uiՠ6wvcWkKO3|a_m|Q3yz<$Mе aω<kmD[m`'.x._6kO &4,RZ3¿0^1_W\ҍk?گ,>^tb$Jw`T)F\&k^}l4}+] Z-'VM:)/b%ݕռMo{kr#8w/R7گ|#xĚooA&j}Kbt?趷:ywjB42i.ihn'J|-|IUgPo4 52LZMP[C[}[`/A7gOgVž!gnjI\>&1\i$C:NAnzWۻ?_b/3(Ug')eje5 xf:>[cb,M ٍ*PPN)A~eM~||sy<+߉~5 CD7gcL4)u;x3Mn;03^_ػ6't+|~hfkz c[Ѭea:׃Qmx^-Vb~hؾkSENJ1JOKod|v#yEAotku? ]jj&Ckx{ŝoxK^:m,Nzg IGύ-K +ĚTvxJq-Eu o5r1y_vx.Mo˷?㚹bqvVQpbԔ}VIۮ߉]{Oak+6Okڤi71g~ȟ/*IEx#Yco_e=P؊_k}h_gZÐH}?S4l_O֜\g7%蕶=K QjQM]9E`lQE>US>YjiPH 'p7F _-5^HUX9\fh**jѨւ~)8A(-퇮؊8JuJe:WӺU(kPhMũr;5cĚWt-'z W6co\ÜIosG<,>qnFW^4ֵk78k{Ky.smaKwzщqik(?Tڮ#XouiޟgZy6W^ibhflh#(cr| y9RKX2QmaՅp((*HJ}\>ߔ𵖹3/:G&4R< 2׳\st8 .Rzʭ[{,-$% Qs>$b*ΝL~:*,O|0ңJ2n+l]U>*D# iQgk^xVxu9>LֺH}?Ð w?l:Ad 6~5 ωzl_A5e`|Dl烴h2W屺1kƏ}fO#^|i'Ï_h_0[[HMΗyo'_To/M~~|#xycj-?g6oas[Kgmc}ķ鷿j| A׈1̎$Ve hUOqB7{?5Tr5Zc1_7~3|2RKUA[ hξ7,bi'mN%OFU e5f4W vkGuExY}v8dok/Ytqjs!P)꾟%aRiB0TkYԩ/RܪTKrn?EikTPϒy)OHҥJ4 PPTVEWAQEQEQEQEQEi:ngujuŝqkygyCumu 'tG=k?Ğj7+/f˫IA0#Λ'Qmx"?o_Yۿqwa\^1pe^֦EZTѩJec9#'® CN"bxV/ p$ X;۱[.sY\ w:=ھ`_Qosu5>SZ6^0[uM}7'!6g~aW8 }Wu< _7y]caܖ"|0ox]X 1KDRɳ=ge,>SĐ^ u/a)G"i?s;z_>x>_*ow.7z8?/: c5Q]ſ)^ cX/dpna,D\O46\KVn癎:їb=/IF_N9J2q\Jq\So]4?Kčg鞽/_sx~cm%AJ!mRX "wV YL|ql!9&L6|EhBQp 1qQFG \c$c6Z˸; xNmfN\'Nym^7NBYv2|pfW RqeXe6ZSȸw,2FiGԝ|~e3L1LUQNEWQEQEQEQEQEQEQEG'?›Q۟֊(I<ſxXxς|P?yqxsMw-oq#׋~¿4( :EV랴Q_)Gul8_57ix(U^1X:zWG|qƙ%aqe4)2 4VZJ ɻrkX~?,?<7rʅ6w=?ukqs}OZ |)i4T_x[`BN1" qۭVWvIZ5nἦUr܋)UImjl9魽.fn6q_nzY}cϛ8ʐ$J+P[QG_Ƹ?(>yWQE (((((tkrev_9.6.1/www/gifs/TkSVN_128.png0000664000175000017500000001712015026336431017101 0ustar dorothyrdorothyrPNG  IHDR cHRMz&u0`:pQ<PLTEV@i]i,+\irBEv-)g\er|4Gqme+2kIjfGeIfv@SdePrÓלzghyOUd[ǩǺ>FV}OggɌ䈐JB8t^hzw$ '.#! nM=.WOFo֓ʒORX07T~;Lk@4(jWŮy{hx\Km8Zf#),+''&;9.:]-hL1vaZzu_[lXv)P;+_䴱nHRUzfȸYA<ျ|\0Ҽ㧛@(1T:i Z?2\:A;T鲟uѵ&1NcP`ΛfL<6DNj,.v1,XְAtp'_A-IEb2Ytյ*6a*IV:ksT?/&ݶwFzr@0Uk̍G5]^gMV} Ao+'U0bs ANnFaT]$BQ=wctVe8A'LdL\GףSHrƒz3(y)lL)6277i(t41ʏ5ݛ9>y-MFV@tRNS@fbKGDHtIME(eIDATx{\WA K0܀b1abA T` B@}"+ oޠXo - E_ZuK]nWWۭo[>g gdrf<;kT* txt +[nӰMv[ @e(B37P~fd/ ޼=zYY;H0,$OGQ\α"PkҤʹqS DđxPlذ sP!%fBT2f#}r btǒpjSSSK]Sc]S$FcSP:?AN膷Wo dt o[30 \2rt( e4tIy-+?F>կ^H{p;pmδgfgg6֭{Ha<5tǐ2Gw65ijIhjr<;m FoeoXEy\l_{yE͛s󢢢ӹyms85㘈+FA +5 yJKZ[K)k'gӹ!1*6fŭ߰eՇ~E?&89[ݎhHiIhjuC:-E@ "iKBޏ.`ܛ\/~x"Շ!*0!u"[r-zuCCt:M%xHM-&S޳sJBEQ.l p]&ޞy񣋁`E$PP$!01N1;kkuCK}:pߥa9 ]^o[#ds''i/~/~ F`Լ]kA)t.34tOOMLh :](WNO @<~@dp 3>x>†+#W(Y0Ё}8/e8975ii_]Vtie47\7^G. W;.s?Ԕ|Yܼ+#dd~?KvV###h(_ 8sgngSfgiJDWWU߾ߗ^;ԭC^d3:(Z:@r˅s} ]_<=B@ 7afK^I(Ԙ"%S䚛.xM-ɭI@[nݾ};.>>e C&smJrXnw'Mi&4\&ΨJuܘ:tq=$פ /פ6V>{woܹsƍYsrl gyg7*Ɲ;>dq(59#/8c6.=d:w2i{MbcҘi󶝣G}P}½[twCsfו|>.X܁"i,m v+v3=|Yۏ۴yC0e} C͂ vw-J@ݴꛣV[.^R>mX=挙3fϯh+QOۈпD`AХ66ݿ{[^foc ]l"J:@0.sph3'ʾ)z4`7Fʇe8A:;G vxxs^Lw;N{mjz1w3Avģ 8 3(i7";h ܽwt6vB'JZzzZ{eeee' .8~`Or4G,룣 vܺ^=0Ħ;9;ë9@qa>8vReD F;{ܜrGٱc>!NۘJh+h)L5qEcwgmIX>C,+h,jEEHF0m5ĈJMy|gj>;%d{K,mp,[ZRNRRZN"#hp!J)j$eŪ@U_}_ Xg9j֖6իmniAj;|y[[J #E2,*ZVIi ŠP|ukmz  vի+Zh WۖԚJJJDҔSL0Ʒ"[oi܌E< __a T4۸G9e$Sc21;>Kq^ٹj쯶ttS֎h0'uUUuN0!@4~>$.(ΎFnބ,lpbu8OޟZW[[.r/tZBK9R7KP3vdgeBbhlMjwʕ|-[eHyi︤Y>yJ^t 0vжfeFg5 w̳oQ G/;O0R9\qA~sx0cD%,>mۙ^Xښ0op<}}_7<r^${ zF 44#1vW$I~fD3{yqDb_ЭiRϓf4GqLi>0 :ƐoQS&{lEw>HkQ TS=y*411HBc4)/' {\A J&J85HЭyӝJEI Iø8@EAIzyJF*dta< K%J5&\fvV"92JpexJz F A=Iq#L ի5~{yL|6`T L_HB*I @ҕ{JB s>I a|J{z<`rU(3➞"?2*_SAׁ+CzzB2Bz Eqm4=HG"H J `$z!# Ǖ0%7ڠm%9#IDcKJ"BCmURҰ/W)JEJU8L"p}X; {.8 0@ ,8u^jv3 &!88T@+$U$8u)t4!njABp{&[S0)Puu )Z^7Z0 J4p7h3ꛧ(4* ON> ''TK7O %Kz SB7cIp._QX$ѐMuw;:ttwgPѓ*4@V΁$4Ì~sa4Ud0,d8 RP(Rf Z G6O$ \b6~H+GFFIedE\Mz[~}൑x`qǺVhI |IR~gӡp# >p-zX>`V8=B7+LRs C9@i&XΑJ-#+>Y7zd::h \S*1Xf %] RS*Tpb0 q C$a u]>.nEq4Vfي9vܸF wk%KKK3|g܉tEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/www/gifs/TkCVS_128.png0000664000175000017500000005410515026336431017072 0ustar dorothyrdorothyrPNG  IHDR>a cHRMz&u0`:pQ<bKGDV@ZWIDATxw\}sΝ޶l. QNQDZQeɔdKQ%NJ?Obq؉mɊ"ɖIQIJl"XA.>[f;ܙ3])JN{<{s{~#|.~Ab<˩ˍqZz tPG3hUl ^~]ވ_?oNfx{]N,)` 3+@ѱj[EFrspӝ5Llq r6d$ ldih#9ȩUr=fH4̜q6an=ϡGi=;7޻!Ý۷ ^ `!O3 $INO`5ͯ}g هlJ*P{o(VK~r]:]hkg] K Xkȳgr6?xOZj2x{O!FwXd`?6|y1A {w4,=/yFY.+ ǿ¡Ǿ33o17} šwr[n`fmxvo_w[c+کr)#4O|.o Ÿ=Ɇ2?z bQ%D(yqKǥ_SqӰiBߴ$k"}f(ܑ6uxjzm7z_#U,RTbx4J@ۍK/ZJ7oDDshTp՗3=S? ?m62dRi2%ԃC$a闺>Yx0vO5ɕ pU*M ui8q(ž.Kf?F8Źz=_ԃѻgeYTVܹ97fKH;p\-}xH=TV@ծڧ<2*?˩dѼk- "ܨzʱst ou /L~ T!ZڀשX(y,|Bnپ_zlI쁺PF_۸7\{<+%NeΞ<~{>~'?kzU -@t E2'_;GmO8s58.+ںᰒ o\~qf C2{ x~Nz(rK>,-Q ?3|m=#i߰ S͑A"&o4 kGc/`"n҆ZDnUH_  v0!NSĖ׮_.|x<?wƒ6{F6Gr̾]S* "ULEU0 nǡwQ(i >HN5DowpmƯA4z \SïY̾Rr@ 8r$8du{oLb8ct= uկth;&}I`AqX u71'Ʈ?5هlJ%vc#^%u8\}诲yno%HD%GA/ؾ|-_Mא4?/ǝЅ8ʵ{YgvgY(~qxZd0 psf˳$S~>z̏?>\ρ5mJ_8>+/#_XTF]{}lOM_A#6gK:KG.~X̓{8{qx-.xHo~?E|- c|{9פKinC|`b-{Z\8*\=S뾏S;l&7 #BrȐ.]zI G#敏?@n[u 8-1Ow>Ij1"vHo-]]}p߾lt 3e.Z.Q)%ɥ#q_S92kn`|_Evy}>}ϾIpHsϼF7 Ζ07md`U.ɽG u4cI:(Xdm:|j](õ\GkW"|ӽT"!à|c׮&i5B f=_5=v>"l^c.q4 l2mhs,!@L.mDe>I7| {}.ѓ1ڂ.hmM_^#nxF'QǏPioE|>w]GEy5VU:}sTʉ ͦm{716f>_ka傐љ8E@|9YU>З̀C| .BNXX"2# "Vo>Y=&*HkyJs% Fu~XBWh٣g1OLC.QTKU"2"JtDRr %Kf1GGqj1DBj2FS4 H$W,O5& n?f _G[",K}.I2;6>8JvUKr{?y~3lO*p8?<:F[Gg4 ݼx{p?m*/G#(MqfGͧ|~R/@mC ޸bGd!%D"`D$<)?HW)I"c PVYZ$ qUq{ȾLw9J/^VsCW?s;?B*gb|ʇzl1cStF|c'$yp@\bV}TfxdhA揋-Vٔ h,? !ݲR%%䋨Ε$ᨩ(ķ\wܼ6%ƀeAKdt4L 2?wP ![ѥ fY,(ezA^Yd"[/Ugpffΐ>2P;̺][m]İLhG;~_5`1M)d,Z3uf0QVc~= ˈL(Oܻ"0 Y.tϕџ5W+UuIJ4 _bwnk'JPxf23iOG?B9s)"i:z3۞y qKfYwu,]'k!6t,j¥Ȩ(P  o;ì{#=X*p66+S%jQϕ"#|y߃< / :B"#_4);g#/SpXƑwq#Y֞N"s$VI8@v"Ps9$1q#y׃#Bpp|MTp y=eSU 3·#=mo}gkCVlc#wh?}L̾Gt|'ܷzixk1?Dns8@~KgP%ɉlJN EPM 3dW+D !ky5\ Xڂ:CTg]N}u8;7_7RY#z茆*w_7~(u[Jԛ_6'FsEr4yϗ#ΛW]z(q'>O9>PSEv|x4' :}uAY c݁-  FmXSSȎS%Eiz2E0CAdbtug>3Ehu P0ۏsc>OꏞfRr_Ϝ`"g?'zujwc)_$JfQw gPxm*̙&eVQeqx=E7 +j$ـ-@hVk̷?+(Χ[^t{xGW}e`>$5fncx3?KNk!WF[гY#cf O+o1:W({ RcXUP0%t{k1)ٿ4:/f"T5%55P>:#C=lYu|.l)}Oʜ/2UoxxMŤ-'_x#qU!l70oj|?'ObR O`-<}'ϣ.m*y8$ CU- 52ӞNK_o,Ubs4_ X]w*lH1erZ3C>d!/+f-&6bh9j)29`TGA\RWgUR;;!R9U"_xf8j% OdM3E'`$.XW=N,!lNNNZ,kFu<%)P| p1k^SB \DY/+#zF6F,Pyn,VBO cg*hd3bEgVjAeNΰdwx#gٱQ΍6/|5elp )_~ܲkBU<)"4TF wE!P::_&?47|scMR\>ˣEǶx 5h$!+DvFqk\+f9Ɓn7]׏)Re!8@+CL BǙ&Vna*]B2ϙwH^.:s?!JYp u3=g̱/ /CC߻ .4R"(Z 4cU]p%tIFI|ft#v޽x3_Da%-je>n?;vkpO-WB5~%NhE "#ݔX̗0Xr^DI8`3_0}̟:lU0ϻofF'HM)*.YB$huphRE8_}7 uPʗV]ѨrfNkv$?|ǚ۱ Ƒ\Lc|˳buț8'tNӜT%9X}ۻV.7%*EE SAI TLt:D$S0y2継 N!2a d T"77Džӧp2}!_E{VPBTs9JT/dFI4LHRMVoYP}$j:_٩9ȅlkTIQ`6n|/|+,wx)o0rk&dSQذOS5o 3 ᢄCPe P-EW+'UUpZX5|ϚwlZcSΧԖF!ؚ@B?>nEɓ|kg9#7 0Lr9k|XPVuf˷n_d (U G+]z.n߹n:;)acOЖ;G Ly]_4۶o7-ILOOFb1;-qI=Ĺc|u$ #S/ l+SpZȄko-HsNfѦwLVJ8`1V̓Ip09q\X_~f6o%Y̯JfP* *){ -v`4]0ZuE.`6b)QCU-/D{XFˎ`MSYNzL$d?i~2Ԓ.hΜGt IPY*xC -]%(nT G_|{mJk3/q-y_MQQMjV!?ӋaZ6HPm$0TUgA`6[A+rݽfG(ZHT<DžEfy"[kIRQ+|b_}7jO޷kߍؖos?wyt(G?~Prv:\ gi%.QCg9xEUK(Z ~/gYp;VXFY8nǁ72>+~6lڶܖygQ9NOOs{r Z` 0%KHo.+Z* D9>KQcdύsd&Zz>hvY#x'6& E̊BF r %VJhڇ6!U܁-~[nU㨪lTN|iNW|/Bm}jWőX1Z]6mϾlZςiW N:cIN|C+Xm Q]E,F;6VP k滰<pgoXyYKs>Чl;r`Ӌv{|X3hF{oӱٞB)Kjf "U]:42Yn7\܁Wq3R W4<ն0iyKY"Ղ kZ `gxS)Μ?Ontw/[N8 cQYnp0ɖʤ9D*ը .Œu7mٳ )7,(b{.I Y;5 Tp.Nf:&0*)9ʆ#): ؓGP0\<"ޱ šʞ-G, NlꢌT(Ҹd (L8tre]t67_]k/]V 8~h޶hܺ 'w ./;+ T d+AcHB7:߻evtq;N=zQ6/7{EY Y5]+q8ѱVP4)@[z^TDD"҅*K%<0،SN-cǵ;3"? ju#JDK+hj׬wr #WM+`-V1/}a=x^( nk(||4* ׉T+p欪bY-:kG~(k) 3졃c8t_o`ªZ$Y(Ju9s)P(y},ED%syN9U(;w[c/uJ "&eM0[Wraƪi}d33,ܵrFzx)[#$qX[XYH@$`,'y5LaJ*~Nyl7է:NBx4Ӂ+h j&7uo!AGM/$jNӤ~g^8T]@*jc*oهI"J5:ScK/t2RK e 7&-࣫ ec٣1%',Nx ֶv-\-=.C}|\a"Yg!,ˈU\9$PEA2eo_Ù L\eBXõw~6k%Ӧj=^v$W$In5[BWW[1&Q),1[@$B糧?cY  dVHMKg LLҵnU+-t R.,[W Y\"bkVJ5c2! +T-f N3P£x\3bVhS+fM9܎J 2@+`*8+hLjŋ%j̭EDӴUsK{e MQ1TۏFaR*)Aq`v:}TNYK# [AJbJ}woPp.,rkÂv]2#}-h-P_ 0QR9?A r'X/*(bs(r0uymEq;-URJX>^>9 I(*F>`T+5\m|TkEWpnb4 @%^FVnAe~|%-oBl^eH^Tի'Mt$I(Q"hU7W8K !_TX^DTfZ09Pb$ƦGZ( b_*|tzqH*j`r 4F-&( T KB/V(U"ZI F>:=v0d*&SvnE?Z*Ls'f) BӔr  --" X"gx 5k_MV^XF2qFPlfiM eF'皶{]mY?dӋE&kjˆ/0-E۽0EwoŌ5S8L UG-qP&UU* h5xr@oUJV0Z A"q(E%qB8rYkUݖ2|袌R)rd20՚1\'82Oj!j+|?R_zZMKH,brz .{Q+V7ֳM 8OI4XDPtكl- $`?,.^)C7%L✏5dZ),R8 [/6~CP1dJ*f1v縷SY#Tި*wlYZn_8 UUN\K,֌:0(8."Hl<˳$>7MP*Mۜ\l 2&2HdeD Yf lFRJЪMEŨTmg2DA=-gBǗԶnmSS2vZ-1;@d!pjᲡk%F\@ɥ*V7AЪVZe`y/P׋KcTHr[ՠR̕@F]0V[P Um*9dUMX*Tj}5BSQ4 EQ<')kru2|"4v\mۯAv8}!dҰHCkn, #JmZ,'d1GEɥ-\,Tl-*)bJ赳}*o%a HFW*fӶdR1c'^ ]rȹ4D;64Ěk^BAV6QjMMGp:NR'.EAU4 *A7N"!&jZΣT\&\Bu L8s~U6:8r C+# b . {Ch!a\v1E7ah4 zT D R,RD JrĬ*Tt CF/0Q >Vt!8Et pER NtUcq!KPVԦ6c̅}]?dgE>{t^tCYd n؍[l?2x^@]BPʉjj|Ӂm0JijѶad Tt4<?Za:8̯J6̈́RTTZ IɅGјNTOPHU"a":49ԆPU0K1-IhN'@WT %RMшR?= ]9۾Vxy6vmȅ,E4m־:cewBGC6Y&T,ɦ<8jl>t'xr2񒆡8$[ٳ^f]?"K'TvK)%[Ƙ( 0YJkI9 ISTS]:R)kj:ˁT&j\N& Ѡ1kN'ZA,D'&)5 Km[_c;֔ogl6M:%Qlrf) 8#]xX2AB6-r UR 73{O=Hd-J)ljqr!,Y%aT}'RDFъ+#TJ:PWJh+UqEUӷr-+=yNnPɔ%|Uď(]Oh ն H'9- ~ x̿#t&[b VzFIpGD V0qyڼTDx2n_۷0x/-3@"n'oGtzqBZEeYX̢VY"5ywЇQ{)KdH\>SYWAk\` B.GLL,fblhЍQኴ>qBtS"^[cV/s1.ky5Vg?w\o E.aL^u|#%b bKPϏpW*,ַlĎӸTem=TI/{}|;Vci YQkCTr0b.ُOr.mYܚj:ko+䌪v^V #Sɖi%8>e߇(hS' i SZ D$'ne?~37ad]/{@RR3G-(MQ;Ibh>e鵭|[l;i1Js),NءR*|X|G1Ȗ!,rJhy=Bc>N|d,ߜ̓^O%,Uh[GЎFFtd-=fZC9f /gUra *E{*Lե[F_9Fqi Y4NjnXC<|g#VKT(R.eǚw^F: &7YF279N?CD2H )[Qyqr5l R%.]Mj2洶ԋFϠ ܥ,wO+<%4fb>aշ9Ku|_~>THƒdEl5Zfl~#}-TbⅾZpEG~/;޽~UCp>lF[BYO<Ÿ/lKNfރZ;Q2ǦVI8[Ph>vEwZ3F~C-vUJh\?Y `=LSg|>Nf |ޮ@f~J .OqXq4쏸l;"zMw?1LtA2u㛏/q{l9xmQp2YA}jz?~ym/d(Xh3{%V+\hЍ;賙V(u_ѱyCw7y~q>Ч0R3$OO|vs<ۺh|fa $I3Kxt]t5|!c9 ,YH"[`Nc4jsa9>_WOOinaWN15g#JmfWpZvq̪|g[(q%S]"J0Oxۋ>wwJHPU!M<,c/ma/~]!$#40N71/J\Th)L =8 (v\E_N`Bq^N.[QрLYpLMn>*<'̧H diw%s|jVfMف#wg)!@Dθ|{wx'-mCnC,X}Y]84`?;nh_>q k%IB9]5xZZ(։"r1T7Tl")aoSo[7jR<Maq=H%_=.""׳^!gUr2[x>^b>-l={q^_y^Mg} ۍ`>x óǹ>B9>t,i8waOφ0vG8RY[x<Ǔ,Afj$K}fj UhQ42}H$c^qsINL.io7V}"B}BL, )1\Z]7r͸@S@ͺF 9_B#DiWs nd2`\\+י>8Ke><~r j/afl7v"h$b%O/e'cVr_\g25^?dD<:}TYb{8hW-@ dceĻm .˅tu+'9t,Ɯ!n[l_.y Ԑ+/qǖo JjU' x<+OMOf>Gq8 ʭ}^q(U05mЭ _r? `4;;h.w޺48q% tP6D5 53TJz[ +yz`Ǯ]o؅IғI?"ùZԦRFbbV Z`])L]`f*,RtL/O?SG|),`"g_y+߲=NAlNū7n󛔳V>|}By;<&ߞ1O/%T_ЛTŽ?dP#^J2_W/-Gj;_y뎍[x&q?d\)M`sw'ږn=eR)]5f&7K/-#Gj®0%SR]Zօ;Dl؀F7Ckw9Q*d]/? ne{{_;%b<Ԧ E']VfhDP`zr #]+j**nj/JQMepU=C[V1| u'3U.>#`h֡ dt^w6L0Lv֘>Xҙαﺽk>o6ġ|ʩؚF{-.& sL|}» yƳn+p wͅ3}ST^ P^Cw/ݎepw?y4,oȭ=LҮBdҧbM< @(`;k2̲'yʎkh 30`O*|'hWX1Ǘ^-ýCvKflnbX5x])qPZuk`&QSAgǓ?bHS6{|Ud(x5 /MV0 ڷu^۵ W:y64QP2m&[́!\Iۺ]㸡ogh@-\Q?u#ʹ*@[Y\k/~潍6t X0KGO)U~ֻq8U0hjC-g)ԖGgC&Nkll:[kogZ7E2o.]q˘T/2*kfH5fxpj=7ŕ7d%J.ڷnBNgx~3sYdSӎ&r xVyGgYY#d1Cxq;ECi[B@!L!D[Olꁮ0_㑆w@LS7_Hex}Tr+Y?o<:W./~#x&qӖheMjLƄe`Ebs<"PvGS4]%RJ=GҪ)R5ZB]6#6:k/eV[6?prW3;vѳL WNg/UڿUW.:9^WJAM6I~5fPqN5PgS'&/ITH^{8XF/s~nfN~yFB-޿iwmL5wBlۯt/2 {p33ي&jfL%/ Q0v,bI"1BuU/[C"2&fKI3j*34Ғ7ۙ6ǔ49P~"?#Pހ=7JeD* ૄ2459|U=t  TlXB8H>Fd#$~L Fh"{AA>d D3YkXxDP(Zl5r`Id|LQJ@ J%Z.at*_ `ˈѶQA|_W7Lrdb&@a#$Ʒw8iw'-Ce# d( 4( K8 G jw=E}G':,V K2z2$Є=ↄLm!^OKKd` 4ǀ[7?T9M [@$ŦɅ  R/­īknOVe:4oQJz32@2 h

0# :'Z0`ئ DnT:iC`pЂL4)v9~4#Б#>eDe ,zGr*F("8s@tSpd>ɐK!C h}Lan| |_0}V4Q:윊^B5H@DIJGM{nRjVL(b"" QB :l>RN>KHp I R@ԳO|1zJ̌ԙS&Fs G=D 3J)Sa@ 6wȐ!-A@W@ꌌE:q[;*Nc1`kI$+`xz9 :T&TpZ̢#=7tPV[iF0Maac6DOWFCʈ`Zbs%cFpzʲe']S'|wfg_QsR}\4XsύH˙.3WHN6s'AN:+e볘x4j!/V $hAA`uq0ρpf2q3wvBR|BnP(tf|4 6`9dɕl~&g尌(ޢq̞?{ DAl;$Ԇ Xx#F>I2_h$۞;>+1z ш.SAj@y%$CPLB%ڀ(@-/((\2іRREGJe\#m ]=: 2ITUp$'[tɒe/.Y%+l!R_짼 Ai}tOۡ < 0eR ¢PVVrUƭY[\Qqk^^}r}FVBe4q50QC͇KغI } +6%R+z_.!;B/SQo_?GYU[_-޶ijGZB];xwמ1cF]JǛkd?KX r(!Q5&-پ}Wv鉣& `߹gAw2TVk6mQŜVMjym@PP|-`! 3R5G_|q~l؄7!M;dZcjx;!7Dg#HU=˅lξlN@HAFh4ꇜrUG[l?~ԩ'wl\z{N$]M-n掆}V,y9!HΦ=nv=f3":3==: ڈ%)ǬCZ[+W.\+:ڊBwʜLQ_GT)N~##T,.dx8;݉drBP_{z6[<*-@D! @_˗8e׌өW>45qTu;;1IN^|}}^AUڅ;Tmnؼb55֕ˊ m%srz:8gI'}x뇗wvKuccg"sɓ{X0rQq "`WT\j,U9j5&_]as9=#V1P.]Jl\_5Mu׮]y$7>zWEYefJdžGb8ELFFzzB&9?=~ Rk2c/ψI*LK=:];rsIWnܸxwVWWǷư9||Az`k%Y6T4_ڜȊIJ*.]Zwsݡ͇Rtyw>iv^Ws{>fb}XSd uDjTeﵾ\ё;Ab3Mͱ#.H=?qOXqxMunQz5f@`RIU&(+ `pjmox:&4:a禖k9j7?1>?+'#õ¶^}~W X/1tԨ1b[ TsXgZ3Jd@XN?zyȔ>략ܹS#͕mfKv kX="$:oI`dta-3zis~vVޣG.]zg_<t~^_TTSS~kngGlfљ@y>Z,QL+c]Hz[@(at=9WLMuzLGd%p  9qiDMyn_;YD3+W_n#ƼZFgh-07\^~lnSY2FX,xc[v>uJ밈.?5okX"" 3gSߓJrAp <$'4 ;j,y:$39|G g-,/+]"2l -b14wz4qS,VAWAAc-hM9=}==#F$#pJ~lnGђ{]Ń۟uDy"rdhp؋+Vu_K;: A1vTl\؎>w. $uTFD˕mBksEF8͑RiKҭPPb 7͉?* ,5{+++Uf3mɍnz ٮ\_l7,,dXbF@Z~H@c曮Ү3gvr 2MD4_gy)W[D$&xsLRwWN96Q<7>%ʒ^n//z AxX0a:bf<;ݙ2p+N܎9jG+L-]֨nw\)T`gH A]RR|rw̬@fP¢BBC&gWlzR#}'ON=1dx0hpNX!51Lj$tt$hR`_@b##@H t qs?XMGeݣ׬[L³=m6ՕPi9 5=l@nTWsi}$@*"Bhοs҃}9yzV:nhzJP` D Iw XV $44ّ5s {KqǪm*Z덞< kL OFl@*UP[2(`N%Ml_ܜt@`KKuO8eS|xݱi2H3:?e'AJ~MJ!Pv qjtFg(歯1~ bf;Kv?s#՜phש5ԨJa&jyB>~ XsOI֘fx=6۵ Wfק`/zo߹0-sm7.勤[asLhrJ~F#;#tH!Ur @zaZ)37o}bɽ;wy~#śbYŪ(kpr2g4vIkH,2jA -9 J_! vD:ҽs?ln^MK_}˻w|\¶3Em[(.nh(Z@beOD'NLxbLɩbm, l饯?O}7.ϝ{֭.1c 'm۶3ϜYtG{*v(3w T(%թZ Lp {ԫ-,6~~9|Nնk9szKrǶAںށTU?Ѳ W>qI@qcvf/ۙ5.>G*>S67.QY8|`J:.QKY3 ?zlfGWRf'7N=qc۶mݺlMN~6u4>H}OAMC )t%زB\A(~7^m;p‚7emm9%EoX|)SY_@RTԑ?Аg 3 EE͘cuZ[<ޱq㎪׬q`ǎڮ[VxţmqդSU)@gpY2mjhh>|6-p7xEG>-NMF}yX{ !p ]:6k>WtzڣV-T[rʣFyI$>SdGzF#U9\Y Я@W/YgF-Ա[ήRgSh` Fg)}U C lիFoTQА+ !g9C3C$U4`v@CjGdz6".PAGbG04$4aQUdz^ jI~Y ͸IXR|)n 9(o>cA8)#WdjX8ө0|FGcJX @>HQ_qqrZ~.o``F!Od 4V숇|)8 A P L4Ȋr1.*5;_#,X<߷~K#//e>yG^*#ZC$߁@ldc@-pPS, ;p4$FaOhUI_KC&[AQq8> V>+*;V(M?/~ B8@/ T|wWBnV|8{"W8}4馜I֥c3Z@>3D%;}<Adx 'J!p*BclAQ1'B$boʰ <6+T*|>"o?sd#3&Fvj3-_5l6OQtSML zkGt"a w̓WN#t%vyVLx303aY">|ޞDl2BO@l3xխ(9(T`05 %kӛ_, ML;)G0pӿ'M6 %\AO*%ְZRqZ?#hNJXYl^{ nUF#@sZwY&FW:8SReRf#?`FI+Y7!zv=frIJ$f`{>h~k8.&%hjMV.+ܤ2`׷6D?OD;ջxoOtEXtcommentCreated with GIMP@IENDB`tkrev_9.6.1/CHANGELOG.txt0000664000175000017500000013463415034253755015330 0ustar dorothyrdorothyrRelease 9.6.1 July, 2025 - Fix a timing problem that only occurs on MacOS, where a tooltip would be invoked on a Close button that had already been destroyed. - In the trace window, separated the command stdout from the file operations, mostly so that I could see the startup UI-matching with the file ops without seeing the very verbose stdout trace. - Touched up several little cosmetic issues. Release 9.6 July, 2025 - Fix things that Tk 9.x broke: Scope of variables in namespaces is more restricted. Tilde (~) is not expanded in pathnames unless it's done explicitly with the new "file tildeexpand" operation. That means plain files and directories starting with a ~ character are now allowed. In tkrev's directory list, they're prefixed with "./" so they can be used more or less normally. When reading and writing files, the encoding profile is set to tcl8, preserving permissive behavior for files with extended characters. - Incorporated Michael Moran's tildChk proc from tkdiff, to smooth out when and when not to do tilde expansion, with some degree of backward compatibilty. Previously, tcl always did tilde expansion. - Update tkdiff to version 6.0, which supports Tk 9.x - In RCS, a function to add a tag (symbolic name) has been added. - Added attribute "-topmost yes" to the dialogs. On KDE, they were diving behind the main window when focus auto raise activated. - Can sometimes get UI colors from a gtk3-style gtk-main.css file, if "Match GTK or CDE colors" is enabled - Removed some things from the contrib directory. I'm not including the early fork of dirdiff anymore. The script to set up files for the vendor merge module is now in the teststuff directory. The only thing left is cvsdiff, a script that enables tkrev to use gvim instead of tkdiff to compare files by setting the "Diff Visualizer" preference. Release 9.5 March, 2025 - Bug #158, require Tk 8.6. Rolling version number of tkrev to reflect that it's a substantive change. - Fix bug #157, cvs_add dialog has undefined variable Release 9.4.9 December, 2024 - Deal with renamed files in both SVN and GIT. Fixes bug #156, at least when Git itself reports the source and destination files correctly. - Changed all the gif images to png to make editing them easier. Release 9.4.8 November, 2024 - Fix bug #155, to make "git remove" unix-remove the files like in the CVS module - Annotation browser functions were broken when invoked from the branch browser in a CVS directory. - When only the branch browser exists because it was invoked with --log, the module browser will now start properly. - Give the module browser something to do (list the *,v files recursively) in an RCS directory - Fix a regression with the initial writing of the .tkrev-picklists file - UI enhancements: - Use ttk::checkbutton and ttk::radiobutton to make the UI look better on various platforms - Add some ability to follow a GTK3 or KDE desktop environment, but hide that, and the old CDE stuff, behind a variable cvscfg(match_desktop). Add ability to match NsCDE desktop too. Isolate the variable and proc names of the color and font stuff and put it into one file so it's more modular. - Rehabilitate setting some colors in .Xdefaults or .Xresources, and enable setting some fonts from there - If tracing levels F or D (File or Debug) are turned on, the trace window will display the colors and fonts used. Release 9.4.7 August, 2024 - Update tkdiff to 5.7 - Display better in themes with a dark background. Use ttk::scrollbar and refine the use of ttk::combobox. - Take the info about Xdefaults and "option add" out of the help. It mostly doesn't work anymore due to theming. Release 9.4.6 September, 2023 - Add cvscfg(large_icons) which, if non-zero, causes the user interface icons to be enlarged by a (integer) factor of $cvscfg(icon_mag) - Adjust the height of the treeview rows in case the text or icons are very large - Fix the "show diffs in changed files" button in CVS by adding a new function cvs_diff. Patch won't work there. - Measure the font height for the Treeview because it doesn't adjust adequately by itself, and if you use a huge font the rows overlap Release 9.4.5 March, 2023 - Upgrade tkdiff to 5.6. The previous version included here, 5.5.2, had a nasty crash Release 9.4.4 September, 2022 - Fixed bug #154, manpage now installs in share/man/man1 - Update tkdiff to v5.5.2 Release 9.4.3 April, 2022 - Fixed bug #153 problem recognizing trunk/branches/tags in Subversion Release 9.4.2 April, 2022 - Added a preference for which version control system to prefer if a directory has both, for example local RCS files in a Git directory, and a --vcs command line option to override it if desired - tkdiff updated to version 5.4 - Speeded up tag collection in SVN a little, by filtering the svn list output to eliminate tag copies that don't contain the file of interest Release 9.4.1 September, 2021 - Restore branch browser's diff functionality so it works if one, or no, files are selected. - Fix "show file changes in a commit" in Subversion branch browser - Update tkdiff to version 5.2.1 Release 9.4 December, 2020 - Change name from TkCVS to TkRev. Your ~/.tkcvs file will be copied to ~/.tkrev if you don't have the latter yet, so your settings will be transferred. - Re-worked the help so that it re-uses one window during a help session. It opens with a table of contents, and has a button to go back to that. - Added a search function for the help window. Release 9.3.3 November, 2020 - tkdiff version 5.1 - fix crash when starting up with a file whose CVS log can't be read - On dual-monitor setups on MacOS, tooltips on the rightmost of two side-by-side screens were moved to the left screen. Fixed. Release 9.3.2 January, 2020 - Fix Bug #152 typo in cvs remove and cvs add - SVN diagram fixes from Knute Beneke Tags could corrupt the revkind info, resulting in a bad branch diagram. If an actual branch bases on a deleted branch it would not be shown. - Fix silly typo in RCS checkin confirmation dialog - Fix uninitialized variable in search initialization Release 9.3.1 November, 2019 - Git Tools menus for gitk and git-gui now work in the log and annotation browsers as well as in the workdir browser - Fix bug #150, "cvs update only works when a single file is selected" - Fix bug #151, "cvs add does not work" - In Git branch diagram, the current branch as well as the master are now always shown Release 9.3 October, 2019 - Enhanced the annotation browser so that when you click on a line of text, it puts the revision number in an entry and you can view or show the log of that revision of the file. In git and svn, you can also show the changed files and show the difference of that revision from the previous one. - Added a toolbar menu for the annotation browser. It now has the same toplevel status as the workdir and repository browsers. - Re-worked Hide and Show a little. They weren't working for SVN at all, and not quite working as advertized for CVS. For Git, it works differently, not forcing a tracked file to show, as .cvsignore and svn:ignore do. - Added a label to show if the current directory has .cvsignore, svn:ignore, or .gitignore - Made the log button in the workdir browser do a full list of commit comments, the equivalent of "verbose." Shortened the header for CVS. $cvslog(ldetail) is gone. You can still do short logs from the Reports menu. - In the working directory browser, got CVS and SVN to show the log date. In CVS, it takes a little longer because it has to do one "cvs log" command. It will only do it if the date column is mapped. - If there are locked files in CVS or SVN, or editors in CVS, put that in the Authors column, appended to the author's name - The "Go" bookmarks menu didn't really work with the module browser. Fixed. Release 9.2.3 September, 2019 - Got the colors working properly for Git annotate. Now newer ones are redder, as they should be. - Added a button to the annotation browser so you can open the workdir browser if you used the -blame command line - Save the geometry of the annotation browser. Release 9.2.2 September, 2019 - Allow spaces in git "since" option, such as "2 years ago". If the log or blame is empty, report what the since option was. - Fixed the bindings in the text viewing windows so that copy-to-clipboard works. Home and End work now also. - Fixed a bad thing that happened under certain conditions in the workdir browser if a filename had spaces. Release 9.2.1 September, 2019 - In git branch diagram, show commit date instead of author date - Add a patch button to the workdir browser for CVS, SVN, and Git. It does a diff of all the changed files. - Add a file diff button to the branch browser in Git, and change the icon of the one that lists changed files, so the patch buttons in the workdir and branch browsers do similar things. - Introduce an "invert" tag in the viewer window, and use it in patch_colortags to make each new file stand out. - Fixed broken module-level patch dialog for CVS and SVN. Release 9.2 September, 2019 - For Git, added the ability to choose a range of lines in the text view of a file, and send that range of lines to the annotation browser. View the selected file in a git repository, select some lines, and press the "Annotate selection" button. - Added a button to the branch browser to do "git show" or "svn diff" on a selected commit, listing the files changed in that commit. - Speeded up the SVN module browser by not pre-scanning subdirectories - SVN patches (#103) from Knut Beneke: - If a svn branch is copied from a tag it is not shown in 9.1.8 - Sometimes a svn log -g produces a non consecutive list, thus resulting in an erroneous branch diagram - If a commit affected more than one branch 9.1.8 would crash - The parsing of svn comments is buggy - If a branch is added and not copied 9.1.8 would get completly confused, resulting in an almost empty branch diagram - Do not scroll to the end of the viewer output - Use verbose svn log output when not otherwise specified - Add a config cvscfg(gitsince) to limit log diagrams and annotations to a time depth Release 9.1.8 August, 2019 - When git log is drawn with logcfg(show_branches) OFF, it shows the branch names as tags, since that's the way they are in the git log and it doesn't cost anything to get them. cvscfg(gitlog_opts) is not used. - Gave the working directory browser a separate button for the fast diagram, so it can co-exist with regular branching diagrams and can have its own git options. - Added a sort button to the tags popup on the branch diagram, ticket #149 Release 9.1.7 August, 2019 - Found some things that didn't work with Tk8.5 and older versions of git, and fixed the offending things. - Implement logcfg(show_branches) so that if a diagram without branches is desired, time isn't spent getting them. This works in CVS, SVN, and GIT. - Encourage "master" to be the main trunk in a git diagram. - For the Git branch filter, assume that master is always included, so that the regex only applies to branches other than the master. - If a file is created on a side branch that we're drawing and has merged into our trunk, try to draw a merge arrow. Sometimes we succeed. - Fix Bug #148, crash when diagramming a very deep CVS branch Release 9.1.6 July, 2019 - Change behavior of cvscfg(toomany_tags) for Subversion. Instead of all-or-nothing, it now processes the max number of the most recent of the tags - Change the Revision number labels of the selected files in the branch browser to readonly entries, so the contents can be copied - Put more of the branch drawing options in the preferences menu - Fix You are Here sometimes not being drawn - Change invocation of gitk to gitk --all Release 9.1.5 July, 2019 - Improve appearance and behavior of prefs dialog, and fix embarrassing typos. Release 9.1.4 July, 2019 - Made a preferences dialog under the TkCVS menu Some of the logcfg options, such as scale and show_empty_branches are now global in scope throughout, so that the new preferences dialog will work. - Added an option to filter the branches to be diagrammed for Git. - Continued improvement in sorting out branches and in drawing. Release 9.1.3 July, 2019 - Put an item to invoke gitk in both the workdir and branch browser - Enable Git branching diagram with disjuct subtrees - When getting rev-list of branches, limit the time with --since an hour before the earliest commit we got in the log, since older ones will be useless to us anyway. Release 9.1.2 July, 2019 - For SVN and GIT, you can now start the branch browser with no file selected. It will diagram "." - Modified the search in the branch browser so it searches all the data for the revisions, not just the revision number. Several boxes may match a search. The current one is highlighted in a brighter color than the other matching boxes. - Add a new option for the git branchlog: # Which groups of git branches to consider. F can't be excluded. # F only those captured in the file log # L local, found by "git branch" # R remote, found by "git branch -r" set cvscfg(gitbranchgroups) "FL" - Worked on performance and accuracy of the branch diagram. More protection against looping. - Moved the menubars into a separate file so they're a little more modular Release 9.1.1 June, 2019 - In Subversion, draw the branch diagram while the tags are still being collected. - Also in Subversion, add the ability to draw separately rooted trees in the branch browser when a file is added on a branch - Add confirmation dialogs to the git fetch and push procs containing the --dry-run output so user can confirm or cancel - Change "View" menu on branch browser to "Diagram" so Apple doesn't mess with it and break it Release 9.1 June, 2019 - Re-implemented the working directory browser with ttk::treeview - added options to be used with git log for constructing a branch diagram - In the branch browser, replaced the transient window for listing excessive tags with an embedded listbox - A lot of minor adjustments to everything Release 9.0.8 May, 2019 - Added a menu for git log options to the branch browser - When collecting branches in Git, and also tags in SVN, draw something on the canvas so the user knows it's working. - Draw the blue branch boxes at the top for Git, because that's more how Git defines them than from an event at the bottom - You are Here is working again when currently not at the tip of a branch - Re-implemented the picklists with ttk::combobox - Fixed a bunch of random bugs Release 9.0.7 May, 2019 - Re-implemented the module browser with ttk::treeview - When on branch-of-a-branch, look for diagram elements in the immediate fetch origin as well as the default .git repository Release 9.0.6 April, 2019 - small fix to sometimes-missing rootrev($path) - put a platform-wide iconphoto on tkdiff Release 9.0.5 April, 2019 - cvscfg(gitdetail) variable to make git listing faster by skipping the "git log -n 1" for each file. Set in ~/.tkcvs or site_def - cvscfg(gitmaxhist) variable to set how far back to go in a long history Set in ~/.tkcvs or site_def - Completely reworked the branch diagram builder. It relies less on git invocations and more on its own inferences. It's both faster and better, I hope - Fixes in tkdiff for MacOS Release 9.0.4 April, 2019 - Fix a lot of crashes Release 9.0.3 April, 2019 - Fix subdirectories in git - Hide .git file in worktree directory - Rationalize the text files in the test generator, and "leave_a_mess" in subdirectories Release 9.0.2 January, 2019 - Add an entry for the comment when tagging in Subversion or Git - Fix regressions and errors in Subversion branching and tagging Release 9.0.1 December, 2018 - Roll back a svn command line option that was too new - Fix the test scripts so they run on Windows again Release 9.0 December, 2018 - Added Git functionality! - Speeded up branch browsing in Subversion substantially - Updated tkdiff to version 4.3.5 - Made the Module Browser more independent of the Working Directory Browser. You can now move around among repositories of different version control systems. - Updated MacOS UI to compatibility with version 10.x (High Sierra) - Many user interface tweaks: - Made a Copy/Paste right-mouse-button popup for the text widgets, so you can copy text from them - Re-arranged the Report and Status detail menus for more efficiency - I'm no longer making stand-alone MacOS or Windows packages. You can still run it from the Tcl/Tk code on those platforms.revbranches($new_branchparent) Release 8.2.4 (not officially released) - Implicit -dir on invocation. added use case: tkcvs

Same as tkcvs -dir (patch #101 by Maxim Yanchenko) - Fix Bug #3602137 "Typo in error string" - Save last column-sort to preferences automatically - Fix Bug #3573395 When using the "Clear all" button in the "Commit Changes" windows, a "extra characters after close-quote" error appears Release 8.2.3 November, 2011 - Works with Subversion 1.7 (no .svn directory at lower levels) - Make the CVS module-level file browser searchable - Choice of sorting files in the working directory by filename or by status is now a persistent preference - Unwork-around some work-arounds for wish8.5, which are fixed now - Fix Bug #2797830 "Bookmark with space can't be deleted" - TkDiff 4.2 (works with Subversion 1.7) Release 8.2.2 May, 2010 - Make the propget svn:mergeinfo branch diagram behave more like our merge tags, i.e. show only the first merge point instead of all revisions containing the merge. This should improve performance relative to version 8.2, too. - Improve performance in large Subversion directories - Fix CDE font problem - Show date of directories, too. Fix sort-by-revision in SVN directory. - Roll back svn update --accept postpone because it doesn't work with older clients - Clean up finished namespaces for some exec viewers Release 8.2.1 January, 2010 - History of commit log messages is kept, so you can copy-and-paste previous messages that you've used during the current session. - When a directory is refreshed in the Working Directory Browser, the scroll position is restored. - Locking and unlocking for SVN, and some additional SVN-specific right-click popups (Matthias Vorwerk) - Icons for symbolic links in a SVN directory (Matthias Vorwerk) - SVN output parsing change (xml-regexp-based) (Matthias Vorwerk) - Subversion Branch diagram can find branchpoint for a file that wasn't revised at that point (Steve Schwarm) - CVS branch browser no longer fooled by a log comment containing a dashed line of exactly the same length as the log's normal delimiter, although you may not see the rest of the comment - tksvn2bcompare.pl added to contrib directory. It enables the use of "bcompare" in place of tkdiff. (Adam McLaurin) - Add a note to the FAQ about running the X11 version of TkCVS on the Mac. - Fix mixed-up tooltips in the File Browser opened from the Module Browser. - Fix Reports->Status recursive/local switch on cvscfg(recurse) - Button in the CVS "Update with Options" dialog to make it easier to update a sticky-tagged file to the current directory tag (Jacques Klein) - Change tkcvs.tcl so it can be made into a starkit more easily Release 8.2 November, 2008 - Merge arrows are drawn in the Branch Browser for merges tracked by Subversion 1.5's mergeinfo property and CVSNT's mergepoint feature. - The branch diagram can be searched to find a version, date, tag, or author - Log browser always produces a verbose log of revisions on the selected branch instead of obeying the Directory Browser's "Log Detail" setting - If your SVN repository has a structure similar to trunk, branches, and tags but with different names, you can tell TkCVS about it by setting variables in tkcvs_def.tcl: set cvscfg(svn_trunkdir) "elephants" set cvscfg(svn_branchdir) "dogs" set cvscfg(svn_tagdir) "ducklings" - Fix a bash-ism in contrib/cvsdiff - Changed the trace levels so that "F" lets you get the CVS/SVN stdout without the whole debug output Release 8.1 November, 2007 - Rework the merge functionality. There's only one dialog for tagging, which you OK when you're ready to commit the merges. - Use panedwindow for the Workdir Browser. It has advantages and disadvantages, but it will have more advantages when we can migrate to tk8.5. Change the highlighting so it goes across all columns, and enable selection from all columns. - Add a menu item to do "svn resolved" - Fix [ 1824733 ] CVS menu in SVN work area for changed file - Fix invocation of tkdiff when one SVN revision is selected in the branch browser, diffing it against the current file like the cvs behavior - Add options to use -l and not use -P in cvs update-with-options. - Improve visibility of searched item in annotation text. - Fix for when an e-mail address appears in svn status in https protocol - Remove white boxes around Aqua pill-style buttons Release 8.0.4 May, 2007 - The Branch Browser detects lack of a trunk directory, warns that it can't do much without that structure, and continues without it. - Fix [ 1483057 ] Empty Branch Diagram for deleted files (TkSVN) If a file had been removed from the trunk and was diagrammed from a branch, some or all of the diagram could be missing. - Fix [ 1673519 ] tcl error with SVN->Browse the Log Diagram - Fix [ 1581111 ] svn url trouble with French localization - Ask for confirmation before reverting files - Display TkCVS version in window title of workdir and module browsers. - Don't fail if CVS gives a date format that tcl can't handle - Added a button for a text history log of the file to the branch browser. - Added a command line option -annotate or -blame to open the annotation browser from the command line - The "New Directory" button is back - cvscfg(svn_branch_filter) and cvscfg(svn_branch_max_count) to filter which branches to draw in the log browser - Delete the exec namespaces after the execs are finished. This should cause better memory usage behavior. - Add a contrib directory containing a wrapper for gvimdiff to replace tkdiff, and a program to compare the contents of directories. Release 8.0.3 March, 2006 - Automatic tagging of merges works for SVN the same as CVS - Working directory browser observes svn_ignore - Clean up some filenames-with spaces issues - TkDiff 4.1.3 Release 8.0.2 January, 2006 - Fix error in Branch Diagram when searching for merge tags - cvscfg(mergetrunkname) option to replace the literal "trunk" in the code with an arbitrary string - Branch Browser in SVN will diff a single selection in the tree with the file in the current directory - Fix strange "SVN Path" in top entry of Branch Browser (only cosmetic) - Lengthen maximum length of error message to trigger an error popup in exec. That lets a cvs log failure due to a permission problem tell us what went wrong. Release 8.0.1 January, 2006 - Fix a couple of undefined variables - Add log button to workdir browser and change the cvs_log function to eliminate post-processing, using syntax highlighting instead Release 8.0 December, 2005 - The Annotation browser optionally shows line numbers. - Multiple branch-browser fixes for Subversion: - Treat branchpoints as real revisions, so they have both a blue box and a black one in the diagram. It's rather inelegant, but it works with the way the branch browser was designed. Solves problem of branches not being drawn if they branch straignt from another branchpoint. - Send URL paths instead of -r arguments to the diff, svn-cat, and annotation commands because Subversion doesn't cross branch boundaries with simple revision arguments, and doesn't tell you that it's not giving you the revision you asked for. - Bugfix: relative URL path in Branch Browser is constructed correctly for path depths > 2 - The Branch Browser counts the tags when making a Subversion diagram and gives you a chance to skip the tag step if there are many, where "many" is defined by cvscfg(toomany_tags). Constructing the branch diagram for Subversion is extremely inefficient, and drawing the tags can take longer than it's worth. - For Subversion directories, the Module Browser shows the number of items within the folder instead of the "svn list -v" info string. That may help you decide whether to open the folder or not. - The Branch Browser positions the diagram so "you are here" is in the visible canvas, fixing a long-time nagging irritation. Release 8.0b1 December, 2005 - TkCVS now supports Subversion. This involved a major re-organization of the program, and many things have changed a little. The program will detect which revision-control system a directory is under and react appropriately. The previously undocumented RCS support is explicit now and has been enhanced somewhat. - Command line "tkcvs " will open the log browser without the -log option. - The annotation browser estimates how many days per color or revs per color to use, so cvscfg(dayspercolor) and cvscfg(revspercolor) are gone. You can still change it per file in the annotation browser. - The directory-level CVS Merge Tool has a pull-down with a list of the tags, to make it easier to "merge since" a tag. - TkDiff 4.1.1, which has a security patch. Release 7.2.4 July, 2005 - Fix problem with confirmation dialog Release 7.2.3 July, 2005 - Close file descriptor for stderr output, which could exhaust the maximum number of open files. - Re-work the pop-up dialogs so they appear in the center of their parent window, not the middle of the screen (or between the two screens.) - The branch browser can now diff two versions even if it was invoked from the Module Browser and the file isn't checked out. - TkDiff 4.1 (Tk8.4 recommended but not required) - The bookmarks stay in alphabetical order. Release 7.2.2 November, 2004 - Handle UTF time format in cvs 1.12.8 log. The author field no longer gets lost during parsing. - Modify the exec module so that it gives back the GUI while the background process is running - If using an external editor for commit messages (use_cvseditor), don't display the dialog but go straight to the editor. - New menu functions to set or unset the -kb (keyword-binary) flag - Added a button to save the contents of a log-viewer window to a file - Choose whether to update the working directory after branching. TkCVS has always updated the working directory to be on the new branch, though cvs itself doesn't do that. Now TkCVS gives you the choice. - Change the cvs log options so the merging tool doesn't have a problem with certain combinations of cvs clients and servers (1.10 client and 1.12 server was one such bad combination) - Fix default cvscfg(editor). The defaults are now set cvscfg(editor) "xterm" set cvscfg(editorargs) "-e vi" - TkDiff 4.0.2 Release 7.2.1 April, 2004 - Vendor Merge is back, rehabilitated by Eugene Lee, its author. - Bug fixes: 892051 apply the tag ignores user input 892050 merge changes to current doesn't do that (No report) Clear entry containing tag instead of appending, so tag doesn't grow if dialog is re-opened. Fixed a few problems with defaults in tkcvs_def.tcl. - The installer no longer hardcodes the library path in tkcvs. The program now figures out where it is at runtime. - You can now configure how many lines to keep in the trace window with $cvscfg(trace_savelines) - Import dialog has better defaults. Version default is the same as you get if you don't supply the -b option on the command line. - Don't show stderr in CVS Commit dialog, since if there are many directories they may make too much output and make you miss what you were interested in. Release 7.2 January 1, 2004 - More merging functionality. Helps you tag the merged-from and merged-to versions, and if you use the tagnames properly, draws curving arrows between them to show where merges occurred. The tagnames are configurable with the cvscfg(mergetoformat) and cvscfg(mergefromformat) variables. - Requires Tk 8.4 for the curved lines. - Fixed bug in annotation browser wherein it didn't change colors when "Days per Color" changed. - No longer pops an error dialog if the background exec fails. Just beeps at you. The command's output should tell you what happened. - TkDiff v4.0: "r" key binding to recompute diffs fix for diff symbols in Change Bars disappearing preferences for showing whitespace differences better tolerance of Windows filenames Release 7.1.4 November 6, 2003 - Bugfix for hangs in 7.1.3 - Bugfix for uninitialized X1 coordinate Release 7.1.3 October 20, 2003 - Compatible with CVS 1.11.8, which lost the global -l flag. - Mainline tkdiff is back. Tkdiff is on Sourceforge now and there's an official beta, which is pretty stable. - Annotation browsing is available from the log branch browser. There's also a button on the main window to make it more likely that people will discover the function, which can be most useful. - Merging will work to the branch as well as to the trunk in the logcanvas browser. - Solved a few problems with the exec functionality. High CPU usage is gone. It now gives back the UI (to one degree or another) and captures stderr (both) instead of doing one or the other. - Made a filter for single-line module-diff (patch) output. Now files that were added, removed, or changed are easier to pick out visually. - Added an Apply button to the module-level checkout, export, and patch dialogs. Since they don't save state, you could have to type the same thing over and over on subsequent operations. Release 7.1.2 December 21, 2002 - Fix exec problems. Exit status is detected properly. There's a new trace level so you can see what CVS says on stderr. - Log browser no longer gives a stack trace if it can't figure out where to put the "you are here" guy. It just draws the diagram without him. - The correct highlight foreground is used in the canvas so the highlighted text is readable with Windows color schemes. - Directory-level merge now picks up new directories (-d flag.) It should be an option, but you get bitten worse without -d than with it. Release 7.1.1 November 13, 2002 - Fix right-mouse button problem that showed up in the contextual popup for the current directory canvas. Fixed an area-select problem while I was at it. - Fix reversed -j arguments in the merge_diff dialog - Required Tk version is 8.3, not 8.1 Release 7.1 November 10, 2002 - New graphical tool to help with merging directories and seeing an overview of the branches. - New, completely re-written, branching diagram. Much more sensible and pleasing to the eye. Contributed by Mike Jagdis - You can invoke the log browser from the command line: tkcvs [-dir directory] [-root cvsroot] [-win workdir|module] [-log file] Saves a lot of time if you're working with a remote repository and you only want to browse one file. Contributed by John Lash. - Option to use an external editor for commit messages so the rcsinfo template feature can be used. Terminal-based editors only for now, unless you don't mind a superfluous shell window popping up in addition to your GUI-based editor. Contributed by Mike Jagdis. - A picklist keeps a temporary history of directories visited. Favorite places can be bookmarked. - Capability to browse RCS files, in case you find yourself in an rcs-controlled directory. You can't do checkins and checkouts, but you can see which files are under RCS control, which ones differ from the checked-in version, and who has them locked. - A heavily patched TkDiff that works in AquaTK, in case you're a MacOS X fan. TkCVS does pretty well in AquaTK as-is, with a few tweaks to tkcvs_def.tcl. - More intuitive module-operation dialogs contributed by Mike Jagdis. - Re-arranged buttons. There's a somewhat overwhelming array, but now almost everything is there without resorting to the menus. I've tried to organize them helpfully. In addition, the ones that do CVS functions are disabled when in a non-CVS directory. - The ".." directory has been removed from the browser, and we now have a "go up" button instead. Saves space in the list and keeps people from doing unfortunate things to ".." - Namespace problems eliminated in log browser. Now you can have as many open as you like. Contributed by Mike Jagdis - Improved viewer for command output. It has multi-command capability. That is used to advantage by the import routine, which used to open "waaaay too many windows." Contributed by Mike Jagdis - Smoother (faster?) scrolling in the directory and module browsers, due to eliminating the windows-within-a-canvas method of drawing icons. Contributed by John Cerney. - Patch for filtering and color coding "cvs update" output, contributed by Laurent Duperval. - Since there are more ways you can start tkcvs, the exiting had to be cleaned up so you don't accidentally exit, or worse, leave a windowless wish running. Contributed by Mike Jagdis. - Enhanced dialog for importing a module. Contributed by Mike Jagdis - Always sort by filename so that even if the files are sorted some other way, they are sub-sorted in alphabetical order. - If the edit file button is clicked with nothing selected, a dialog box pops up to allow input of a (new?) file name rather than erroring. (Mike Jagdis) - There was a call to "cat" in exec.tcl. It's gone now, so Windows users don't have to have cat.exe anymore. - Repaired a bug in which if you did an import and the "Group Aliases in a Folder" option was set, the aliases would be duplicated in the browser. - These days X is usually set up to map mouse wheel motion to button 4/5 events. Patch adds bindings for buttons for and 5 so that the mouse wheel can be used to scroll under X. (Mike Jagdis) Release 7.0.3 January 23, 2002 - Improved the algorithm for building the tree in the module browser, making it less error-prone. - Recursive add respects .cvsignore and $cvscfg(ignore_file_filter) - The Working Directory Browser parses the "Sticky Options" field and uses a different icon if a locally-added or up-to-date file is binary (-kb). - The Log Browser color-codes the selected revisions so you can visually match the log text with the box in the branching diagram. - The dialog for module-level tagging (cvs rtag) is a little more informative (and the code is a little less rococo). - The installer has a new option "-finaldest", to facilitate building debian-style packages. - The man page is installed in man1 instead of mann. - The tooltips no longer persist until the operation started by the button is finished. Release 7.0.2 October 19, 2001 - Fixed duplicate items when using Control-B1 to add items to the selection in the workdir browser. - Several bugfixes to the module browser. You can now have "&" composites at the end of a nested module without blowing it out of the graphical tree structure. Also fixed bugs in finding a module's title and choosing the right icon. - The ability to group alias modules in their own folder is back, but as an option cvscfg(aliasfolder). It defaults to true. - There's now an Options menu in the module browser to turn tracing on and off and temporarily change the display of alias modules. - New "File->Module File" item in the module browser menu displays the CVSROOT/modules file in a text window. - Do a "file join" on the CVSROOT variable to put it in the native path format. That helps with a PC and a Samba-mounted repository and doesn't seem to hurt anything else. Release 7.0.1 September 3, 2001 - By popular demand, made file selection in the main canvas conform more to the Shift-click-adds-range and Ctrl-click-adds-single model. - Made the CDE parameter thing more bullet-proof. It shouldn't fail if something is missing now. - After a module import, it renames the original directory and checks out into a fresh one. Otherwise, the checkout isn't recursive and you get a lot of "independently added by a second party" messages. - Commented out the tkwaits that were causing the commit and merge dialogs to disappear in some window managers. Unfortunately they may have to be un-commented back on some systems, especially Mandrake, which seems to exhibit timing problems sometimes. - If a file's log message had a line containing only "=" characters, the logcanvas browser would drop all the revisions that came after it. It will still do it if there are exactly 77 equal signs, but not otherwise. Release 7.0 June 2, 2001 - Improved main file-browsing window. It now has icons to indicate the status of the files. The right mouse button activates context-sensitive popup menus. As a consequence of using a canvas widget instead of a listbox, the selection mechanism is different. It's click to select, shift-click to add selection, click-on-background to deselect all. The right button does an area select. - The module browser reads whatever information is available in the modules file via "cvs checkout -c" before it looks for the tkcvs-specific extensions. Thus if there is a modules file at all, some information will be available without the additional comments. - Options are specified via the options database instead of with cvscfg variables. If the window manager is CDE, its options are used by default. - The state of the main windows is remembered between sessions. - Bugs in display of the Editors column are fixed. - Finally found a good home for the "Checkout with Options" dialog. Someone pointed out that it belongs in the File menu next to the simple Update item. I'm convinced that that's right. - The module browser window is paned so that you can adjust the relative width of the columns. - CVS version 1.11 is supported better. Release 6.4 October 12, 2000 - An optional column to show who's editing, and buttons to edit and unedit. - The file list can be sorted up or down by each column. - Filenames containing spaces are now permissible. - Some configuration options can be saved. - Most output windows are searchable. - New reports - cvs annotate - cvs log showing only the latest commit - Option to show only a few tags for each revision in the branch browser. - Some bug fixes. - TkCVS 6.4 requires Tcl/Tk8.1 or better! Sorry, 8.0 has problems on too many platforms. Besides, a regular expression parser that doesn't understand [\s\t]+ just isn't good enough. :-( Release 6.3 The bugfixes have finally caught up with the new features, and we are declaring a stable release. This is the first release that runs "native" on Windows - that is, without either the Cygnus emulation layer or a whole lot of fiddling. Release 6.3.b2 (bugfix) - Fix the tag dialog so that it can be invoked more than once. - Insert "tkwait visibility" before "wm withdraw" for the larger dialogs to avert race conditions which occurred on slower framebuffers. Release 6.3.b1 - New graphical Module Browser. I reworked a BWidget implementation that was contributed by Marcel Koelewijn. Then I moved some of the buttons and menus from the workdir to the module browser if they seemed more related to modules than to the working directory. Then I updated the help text to reflect the changes. - The GUI and listbox fonts are now configurable. - TkCVS now looks for a file called "site_def" in the installation directory. That's a good place to define your tagcolours and other site-specific things. It won't be overwritten by installs like tkcvs_def.tcl is. - Some contributions by Andrew Johnson: Added the ability to select an editor based on a pattern match on the filename (eg to launch gimp on .gif files, etc). User configurable with the cvscfg(editors) variable and it defaults to the cvscfg(editor) setting for backwards compatibility. Fixed scrolling in the workdir listboxes so they remain synchronized if you drag one up or down with the middle mouse button. - User-configurable debug output, contributed by Marcel Koelewijn. Tinkerers will like this. - Featurecide: Buttons are always graphical and tooltips are always on. You don't have a choice anymore. Log level "last" was removed because it didn't seem to work. You can't count on the most recent checkin coming first or last, especially on a branch. Support for old versions of CVS was removed. - Replaced the calls to awk with internal tcl parsing. It slows down the workdir listing some, but it solves portability problems and it's cleaner. Also replaced execs of rm, mv, and cp with tcl file commands. - Put scrollbars on the text windows in the Log Browser so you can see how long the log messages are. - Put a fill color in the revision rectangles in the log browser so that you can select them by clicking anywhere instead of just on the border. - Added a conflict-merge proc, translated from a shell script by Bryan Ogawa. - Between Marcel and me, the Vendor Merge functionality is rehabilitated, working with remote repositories, and using the new module browser. At least I think it's working. - And of course I've been messing with the icons. Release 6.2.b3 - Added a button to the filebrowser to list the tags of a file. - Fixed a bug in logbrowsing from the filebrowser. - Scroll to the top of log canvas, so the most recent activity shows first. - Changed the bitmap for iconified workdir and module windows. Release 6.2.b2 - Fixed the invocation of the logbrowser from the module filelist. Release 6.2.b1 - Made tkcvs more remote-client friendly by replacing all calls which change directory to the repository with CVS commands. You can now get a file list from the Module Browser remotely, although it can be slow. - Colorized the icons. - Fixed the module browser so it will display directory trees that are more than two levels deep. - Made the reports behave the way the help file says they do. The 'by name' lists weren't confined to the selected module like the helpfile said, but now they are. - Prevent "runaway tkdiff." If no file is selected, tell the user to select one. - Display "sticky tags" in the logcanvas browser. Fixed another branching bug. The x offsets of the tag labels aren't perfect - we'll have to do a real place-and-route algorithm some day. - Added a checkbox for the -F argument to cvs tag, because everyone argues about whether it should force or not. Let's let them decide. - Folded in some more changes to help it run on Windows. - Fixed the "Go" menu so it remembers where we've been. Don't know when that got broken. Release 6.1.a8: - Quotes in comment strings stopped passing thru when exec_command was implemented. Added a regsub to fix it. Dollar signs are still OK. - Changed "rsh -l user host" to "rsh host -l user" because some implementations of rsh don't understand the former. - Fixed some erratic behavior when a remote module file isn't read successfully. - read the .cvsignore file in the working directory and add it to the ignore patterns which were optionally set in tkcvs_def. - Bugfix: filter "no file xyz" out of getFiles so it doesn't try to commit them. Release 6.1.a7: - Jo Wahle has redone building the workdir columns so it's much faster, and fixed a bug in which merge conflicts would cause it to get confused. - I parsed the branch info from the cvs log to take the guesswork out of the branching tree. - Stephen Kick improved logcanvas sizing so tags on the top revision don't disappear off the top of the canvas. Release 6.1.a6: - Fix some bugs. Put in a dialog to tell you if your rsh to a cvs server failed. Fixed the listing of arguments in the "are you sure?" dialog. Improved the logcanvas' ability to find a parent node in a strange revision sequence. Release 6.1.a5: - Put in some configuration options to run on DOS/Windows. Contributed by Christoph Jaeschke. NOTE: I don't have a Wintel machine to test on (strange but true.) The configuration options are only tested on unix. - Changed the report commands to run under exec_command. I missed some last time. Release 6.1.a4: - Run lengthy cvs operations in the background to avoid locking up the GUI. Contributed by Christoph Jaeschke. - Upgrade tkdiff from v2.03 to 3.0-beta-6, which looks like it's going to be final. Tkdiff has its own editor preference now, so we don't have to kludge one in at install time. - The cvscheck script is integrated into the tcl code. Contributed by Christoph Jaeschke. Release 6.1.a3: - Bugfixes. Module browser looks at the repository that the current CVS directory is in. TkDiff2.03 is patched so that it will work with two un-checked-out files. Release 6.1.a2: - Upgrade from tkdiff v1.0 to v2.03 - Fix the bug in the module browser so that the current module always matches the X selection. - Added command-line options -dir directory -root cvsroot -win (workdir|module) - Logfile browser doesn't try to evaluate dollar signs in comments anymore, so you can use them with impunity. ------------------------------------------------------------------------------- Release 6.1.a1 was put together by Dorothy Robinson. It contains bugfixes and enhancements provided by users. Please don't blame Del for my mistakes. In general, I rolled in patches but didn't do anything with suggestions unless they were very simple. The most noticeable changes are: - Showing the current tag of each file and the directory in the main window, so users know right away whether they are on a branch or not. Providing more information and options in the update dialog box. This group of changes was contributed by Jo Wahle. It reflects use in a production environment where users are sometimes inexperienced. It's informative without getting in the way, I think. - The install script has been updated for Wish8.0, and it should now work on FreeBSD. - ~/.tkcvs is sourced on startup. - The help file no longer talks about marking files, which was obsolete. - The log browser has been reworked to show the tagnames and to draw branches more intelligently, making better use of horizontal space. Blame me for this one. - Import checks out the modules file before trying to change it. This was from M.E. Smith. tkrev_9.6.1/tkdiff/0000775000175000017500000000000015034253754014533 5ustar dorothyrdorothyrtkrev_9.6.1/tkdiff/LICENSE.txt0000664000175000017500000004310015033004015016333 0ustar dorothyrdorothyr GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, see . Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Moe Ghoul, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. tkrev_9.6.1/tkdiff/CHANGELOG.txt0000664000175000017500000005337315033002600016553 0ustar dorothyrdorothyr6.0 (07/07/2025) * Adapting to TclTk9.0 release where tilde is no longer an AUTOMATIC logdir reference - Manifested as a rework to command argument handling to RETAIN tilde-syntax - prompted ADDing GLOB-syntax (primarily for dialog) as SHELL already handles - STILL maintains TclTk8.5 as minimum required Additionally, Tk9.0 package rejection had halted ANY/ALL prior TkDiff (Tkt#99) PLUS significant enhancements to newDiff Dialog w/MAJOR added Help descriptions * Dropped specialized visual configuration SPECIFICALLY concerning a CDE environment * Bug fix to inline highlighting logic to avoid occasional missing instances. * Minor enhancement to 'Find' text-search tool to report 'failure to find' * Very minor (internal) bug fixes, Help and comment spelling + wording 5.7 (05/11/2024) * Allows implied "null content" files (eg. UNIX /dev/null) as valid Filespecs * Inline hilites now respond immediately after a OFF to ON request * Bookmark annotation prompt now relates CURRENT hunk ID on 2nd and more usage * Inline hilites no longer randomly ignores the last possible line of hunk 5.6 (11/08/2022) * Added recursion ability into directory searching for the 1-FSpec case: allows file trees as input. Recommended primarily for the VPATH Scm. * Recursion (both single and dual FSpec forms) supports patterned-fname exclusions * Repaired merge-preview window jump-scroll action when current hunk is changed. 5.5.3 (10/11/2022) * Crash elimination AND better Help info regarding the OPTIONAL "-P file" option. * Revised a prior (V5.5.2) fix that mishandled simplifying VPATH revision assignment, accidentally deactivating most revision-to-revision command formats for all SCMs. 5.5.2 (08/31/2022) * Yet MORE spurious CRASH conditions avoided (primarily in SCM Search startup situations). 5.5.1 (08/19/2022) * Minor repair of preference evolution logic to encompass stray begin/end version situations responsible for inadvertent CRASH conditions at startup when converting a PRIOR Pref File. 5.5 (07/21/2022) * CRITICAL logic repair to 'blanks' suppression support during INLINE hilite! * Alternate coding fix to vague (Mac observed) race-condition bug w/combobox mis-creation. * Added status display of merge choice counts presently targetted as pure Left or Right * Popup menu disables "Edit" (file) when POP occurs over DiffMap (not a L/R window). - BUT is now active over most window elements having a Left/Right connotation. - 'Find Nearest' selected above DiffMap evaluates choice at SCALED chosen position. * Codified preference 'upgrade' detection, yeilding safer 'new version' transitions. * Internal: Preference evolution of older settings now tied to explicit versioning data * Created "Engine config" Prefs tab: - permits access to other Diff engines having alternate algorithms. - Codifies what is needed/expected FROM the underlying engine and HOW it is accessed. - Still permits ad-hoc flag specs AND cmdline pass-thru. - former 'diffcmd' Pref now DERIVED from engine settings (for reference purposes) - former 'ignoreblanks' Pref (on/off) generalized to refer to ALL engine suppressions - primary engine options (suppressions) now specifically delineated AND configurable - shares options among Diff and DiffSrch when same command (1st word), else distinct * Added warning HILITE to Preference actions that result in FORCING a new Diff invocation. * Internal: general support for "Unified" Diff outputs, facilitating wider Engine acceptance * Internal: Dbg messaging permits suspended arg-EVAL until KNOWN they are used (less overhead). * Handful of spelling typos, internal naming and code consolidations, as always: updated Help. 5.4 (04/01/2022): * Visual Inline-diff SUPPRESSION categories (correlatable to those of Diff) supported yet specific choices are INDEPENDANT of said same Diff MATCH suppressions * Optional support for MULTIPLE Preference files w/command-line specification added permits user configuration for disjoint projects w/alternate SCM requirements * Reengineered optional SyncScroll to no longer permit fractured alignment - FOREVER only specific features may TEMPORARILY override the Preference when set. * New preference allows specifying filename patterns to EXCLUDE from searches among directories when forming candidate pairings for examination. * Text searching now (optionally) scrolls EITHER/BOTH windows independent of the current overall synchronized window preference setting. Allows visual alignment between the displayed file content based on individual text searches per each window. * Within Vpath SCM context, CWD location now effectively TOP-prunes stated VPATH nodes allowing access to yet older V-nodes w/o editting VPATH * Subdirs WITHIN given Vpath nodes now recognized as legitimate CWD-scoped locations permitting operations on directory-based subdivisions while STILL Vpath'd * Repaired how Vpath searches for Topmost and/or Prior version for consistent results * MouseWheel now scrolls properly when above checkbuttons WITHIN the filelist Dialog 5.3 (12/24/2021): * Added VPATH handling, integrated to appear as yet another SCM system. * Tkt#83 - repaired a (V5.2) syntax fault of Directory-based filename generation * Silenced new recurrence of "TCL-sensitive" characters faulting within input filenames * Filelist dialog now immediately responds fully to a threshold change * Added missing Wheel scrolling to filelist dialog * Ensure "Class" of secondary window(s) REMAIN designated as "Tkdiff"; not "Toplevel" * Tkt#82 - usage of the Perforce SCM was crashing (wrong var reference) 5.2.1 (03/27/2021): * New user preference affects how multiple-files are presented to the user. Choice of menu display has been capped at a variable maximum of 1-25. Now uses a separate dialog window when file count exceeds current max setting. * Sidestepped Tcl bug affecting "recursive diff" results when default user pref "-q" option is removed. Will now correctly suppress "binary" files. * Repaired toolbar confusion at startup about using Icon or Text buttons 5.2 (03/04/2021): * Permits entire directory TREEs to be scanned for candidate files recursively * Now stipples the BOUNDARY LINE during "Split"-push manipulations: clearer feedback * Reduce 'interactive startup' reliance on a message console and promote a "retry" paradigm * Fixed broken "Find Nearest Diff" (via the popup menu) to use initial popup LOCATION * Repaired Windows derivation of the INITIAL temp-dir path preference for NEW users. * Resolved minor clipping issue in toolbar combobox (re: proportional fonts) * Avoid Diff crash caused by specifying MULTIPLE "ignore blanks" preference options * Avoid crash from malformed filename using tilde-expansion to a non-existant user * Repaired missing accelerator+Tip for File->Recompute menu item * Toolbar buttons now reset fully when a valid Diff execution yeilds ZERO results * Visible Focus-tabbing restored to dir/file browser buttons in NewDiff dialog 5.1 (11/11/2020): * Now supports user customization of keyboard function bindings - new 4th preferences Tab allows review, editting and saving of such bindings * Failure-modes for user involved input is now more forgiving (w/feedback) - applies to preference modifications and/or inconsistent run-modes. * Scrollable bookmarks: allows access when more exist than can fit on screen. - bookmark menu w/report 'participation' checkbutton (and annotation access item) - bookmark annotation: user specified identities - beyond the default hunk index * New report fmt - based on individualized bookmark establishment for content * Increased report STATISTICS info, plus a means to view it without needing a report * More robust (internal) 'Read-Only' text display re-implementation - restores damaged Keyboard scrolling and hotkey usage in addition to GUI traversals * Redesigned internal implementation to restore MacOS network-latency reporting support * Dropped Monochrome support (revivable, but rather pointless) * Incorrect mainwindow MANUAL-resizing logic repaired (improper "gridding") * Tkt#73 - repaired typo causing crash of "conflict" file processing * Tkt#74 - scrolling w/autoselect ON crashed when scrolled prior to the 1st hunk min-bound * + autoselect now operates passively (autocenter NOT triggered) * Tkt#75 - syntactic repair resolves crash of COMBINED merge choice (L+R or R+L) usage * Addressed bug displaying a combobox w/multiple monitors, and a NON-virtual window-manager * Fixed (yet again) un-raised Tooltip windows on Mac (will NOT happen again) * Repaired crash caused by situational ancestral-data corner condition in 3-way Diff * Relaxed popup-position management on 2nd+ usage - now re-appears at most recent location * Minor fix prevents wrong subwins from squeezing shut during a manual resizing to smaller * Repair unintended session-long ASYNc behavior due to incomplete removal of the trigger * Ensure Text window focus-highlighting remains visible when Text FG/BG is altered * Removal of several (5+) internal excess-work situations improving responsiveness * Online help updated to cover aspects of ALL changes (incl. removed restrictions) 5.0 (06/08/2020): * NewDiff Dialog can now request a Conflict file comparison - It also permits adjustment of SCM choice or search-mode - and is now ALWAYS defaulted when no args are given, except - in one specific preference-controlled situation (autoSrch). * Merging when using an Ancestor file now identifies inconsistent - "deletions" similar to additions, among the two versions merging - and factors into the automatic merge choice determinations * CVS is now able to produce a list of candidate comparisons * ALL SCMs doing candidate detection now handle CONFLICTed files * URLs (Svn style) accepted as FileSpec by Dialog and Cmdline - including usage with/without @Rev suffix and for Ancestor * Multiple SCMs and/or cross-branch comparison is now possible * Repaired 'conflict' parsing to accept diff3-style files * Eliminated a TK-updating race condition involving the DiffMap * Interactive diff-region suppression is now possible * Setting a line-comparison Font preference now affects entire Window * Small features: window manager graphic for TkDiff now provided - displayed filenames are relativized when possible (shorter) - failed Diffs no longer considered Fatal - inappropriate (identical) Ancestor cancels 3way w/notification * Minor repairs to: Split/Combine scrolling and single line "push" - line numbering past final hunk corrected - tooltip rendering on a Mac - dblClick "find Nearest hunk" binding when within meta-info window - scrollwheel now works when within Merge meta-info window - Lnum/CBar highlighting no longer fails during hunk-suppresssion - Diffmap draws properly when Diffed text lacked newlines - setting an -I "regex" on the cmdline also activates them, - filenames with "sensitive" characters ($ []) wont crash - Missing/wrong text highlighting on random count of last hunk(s) - Default Filebrowser preferred-view-content filters mis-specified - Online help updated/expanded to cover aspects of ALL changes 4.3.5 (08/08/2018): * NewDiff Dialog now allows browsing for files OR directories - with the Ancestor file also permitted to extract from an SCM - additionally it and browsers now stack above each other properly * Tool arguments now permit cross-branch SCM comparison specification * Ability to view Ancestorfile also denotes 3way mode is active * 3way collisions now findable via toolbar dropdown list highlights * Textwin labels now tooltip the name+modtime of any NON-temp file * Builtin editor now provides Line numbers * Fixed recent new color preference settings to "apply" correctly * Crash fixed when 3way diff was active and Lnum+Chgbars are OFF * Pre-startup latency msg feature now OFF (MacOS X only) fixes Crash * Repaired Lnums,etc. to use CDR preference settings when appropriate 4.3.4 (07/21/2018): * Emergency Re-repair of the (V4.3.3) Merge content corruption issue - previous fix targeted a phantom cause (only fixed SOME cases) 4.3.3 (07/19/2018): * Critical bug that MIGHT corrupt Merge content via Split use fixed * Re-implementation of 3way Diff support now functions properly - merge choices are preset via 3way analysis AHEAD of user preference - resolved collisions (when possible) also removes its display markup * Added status msgs (to a popup), in lieu of a busy cursor, at pgm startup w/SCM use to account for potential network latency delay - new help info for 3way support/strategy plus latency effects * Small bugs/inconsistencies repaired - Collision color in the DiffMap now honors its preference value - DiffMap is redrawn as needed for Split/Combine and/or collisions - Misleading (inactive) filelist per-file 'menu accelerators' removed - Avoids crash (chooses line 1) when no CDR exists and invoking Editor - Report Save-as filename browser lacked the filetypes option setting 4.3.2 (06/28/2018): * Fixed obtuse data-dependant fatal crash caused by inline-diff of IDENTICAL lines (induced by Diff itself). * minor fixes to newDiff dialog (absent V4.3.1 param), resizing * random typos in help info 4.3.1 (06/26/2018): * Repaired crash(v4.3) when using the "-conflict file" option * Supports Diff 'suppresion' options (Empty or RE-matched lines) with ability to enter/manage/save rules, activate from cmdline, and interoperate with any supportable 'diff' engine * Enhanced and expanded preferences coverage - previously hidden settings exposed (map and collision colors) - color used during Split/Combine for boundary movement feedback - provided interactive color chooser for above - added new 'suppression' settings - added new 'default side' choice for merge initialization - redesigned layout of checkboxes for better readability - enhanced feedback for inter-related settings, and or editting * builtin file editor now opens at the current diff region * avoid unneeded display updates when nothing applicable changed * Editorial revisions of online help info (new and old content) - better explanations of 'quoting', interfacing to 'diff', and more uniform typography * minor internal consolidations- dead code removal, upgrade to later version of embedded software, contrib patches, etc. 4.3 (06/06/2018): * Add ability to create a file-pairs list from a Git diff (by Kevin X), then extended (by vampm) facilitating other sources of multi-pairs, including local directory-to-directory comparisons and Subversion. * Rework the main text windows as a text + canvas hybrid so everything stays visually aligned while scrolling with multiple fonts (by vampm) * Add a facility to slice individual Diff records into logical pieces providing more exacting mergefile generation capabilities (by vampm) * Report generation can now suppress NON changed Text lines (by vampm) * Merge Preview now indicates diff line contributors and line numbers * Repaired handling of data files having random bytes embedded * Numerous small enhancements (wheel scrolling, more GUI feedback, ...) * Extensive audit and content update of the online help text (by vampm) 4.2 (2011): * Works with Subversion 1.7 * Make opening file dialog know where it started from, and start in the same directory as the first file when looking for the second one. * You can now specify a preference for filetypes for the file open/save dialogs. * Detect PVCS by environment variable (patch 1839361 by nafmo) * Update BitKeeper support (patch 3053551 by wscott) * Mercurial support (patch 1867700 by damonmc) * Rudimentary Git support (patch 1836293 by cecilh3) * add help menu items to report versions of wish and diff * Fix location of temp files on MacOS X * Gave it a debug (-d) option 4.1.4 (11/15/2007): * Ignore -u option from svn for usage "svn diff --diff-cmd=tkdiff" * Perforce support for P4CONFIG environment variable * Remove an old font work-around for Mac, but add a new one for tk8.5 on Windows * Fix duplicate keyboard accelerator for Preferences 4.1.3 (2/20/2006): * Fixed incompatibility with older versions of Tcl/Tk ("-state disabled"). * Applied Warren Jones' subversion patch, which prevents the svn error that occurs when you omit a revision number. 4.1.2 (2/1/2006): * Can now do "tkdiff OLD-URL[@OLDREV] NEW-URL[@NEWREV]" in Subversion 4.1.1 (12/20/2005): * Security patch for temp files (CVE-2005-4434) 4.1 (7/4/2005): * Clearcase support * Better Subversion support * -L command line option allows you to control the labels above the diff file panes. * tkdiff --help or -h print a usage message for command line without invoking the GUI. * The New Diff Dialog is expanded so you can specify all the options. * The two panes can be resized relative to each other using a sash widget. Tk8.4 is recommended, since the implemetation is much better. 4.0.2 changes (11/08/2004): * Made sure all the prefs are saved (Bug# 878340) * Put all the Aqua stuff in one place 4.0.1 changes (4/27/2004): * Fix detection of a ,v file in the current directory for RCS 4.0 changes (3/10/2004): * Inline diff highlighting * Current line comparison window * Support for Subversion * better tolerance of Windows filenames * CDE, Windows, and MacOSX aware 3.09 changes (5/24/2001): * Removed use of the user name in temp file path. This removed a problem on Windows when the user name had a space in it. * Made diff "edge detection" smarter by using the new smarter overlap code for cases where diff decided to treat whitespace slightly different on missing-EOL files when doing 3-way diffs. * Added the "..." back to the Save options in the merge result window when appropriate. 3.08 changes (1/15/2001): * Made overlap detection smarter 3.07 changes (12/17/2000): * Highlight overlaps in bright yellow during 3-way merge * Added "Exit" and "Save & Exit" buttons to merge preview window * Removed error that popped up when doing a merge that was not necessary. 3.06 changes (unreleased): * Minor changes for AccuRev integration 3.05 changes (11/30/1999): * Added Jean-Francois' 3-way diff/merge feature * Added Bryan Oakley's tabstop feature * Added full support for Accurev 3.04 changes (8/5/1999): * Basic support for AccuRev. Graphical equivalent of 'accurev diff foo.c' * Fixes as a result of running Scriptics' error checker (see archives for details) * 'q' is quit 3.03m changes: * Added -o to set the name of the merge output file 3.03 changes: * includes the new line-by-line comparison window * bug fix for line numbers not being sync'd initially * slight modification for how change bars are colored * bug fix for up/down arrow keys (they were moving by two lines instead of one) * bug fix for Alt-V not opening the View menu (ditto for a few other alt- combinations) * fixed a couple of -underline options for menus * new preferences for enabling the display of the line comparison window, and for configuring how individual characters are highlighted in that window * added " vs. " to the window title (eg: foo-old.txt vs. foo.txt - TkDiff 3.03) -- this more closely aligns with Windows standards, and is equally useful on other platforms, I suppose * online help has been updated to reflect these changes + As of 3.00: (11/06/1998) A new GUI. No more reliance on perl... It's 100% Tcl/Tk now. Built-in editor. A "find" facility. Lots more... And all of this thanks to Bryan Oakley! + GPL'ed (as of 2.03). + RCS, CVS and SCCS support (auto-detected)... Even more SCM systems are supported in 3.00. + Highlighted difference regions, randomly accessible, with a quick overview/navigation bar. + Side-by-side viewing and linked (synchronized) scrolling of files. + On-line help and extensive customization (also much-improved in 3.00). + File-merge and change-summary facilities. + Line-number toggling (for easier cut & paste), with extra goodies as of 3.00. + Windows NT support. ...and more stuff I can't even remember, probably. Much work has been done by Bryan Oakley for this release (in fact, 99% of it). :-) Thanks, Bryan! Keep an eye on the tkdiff home page at http://www.ipass.net/~klassa/tkdiff for developments... I don't think there'll be many, at this point -- Bryan has turned this thing into just about all you could ask for! If you have problems, though, please send bug reports (better yet, patches :-)) against 3.00 to klassa@ipass.net. tkrev_9.6.1/tkdiff/tkdiff0000755000175000017500000341335315033002600015717 0ustar dorothyrdorothyr#!/bin/sh #-*-tcl-*- # the next line restarts using wish \ exec wish "$0" -- ${1+"$@"} ############################################################################### # # TkDiff -- A graphical front-end to diff for Unix and Windows. # Copyright (C) 1994-2006 by John M. Klassa # Copyright (C) 1998 by Bryan Oakley # Copyright (C) 1999-2001 by AccuRev Inc. # Copyright (C) 2004 by Tom Dunne # Copyright (C) 2004-2025 by Dorothy Robinson ("dorothyr") # Copyright (C) 2017-2025 by Michael-M ("vampm") # # TkDiff Home Page: http://sourceforge.net/p/tkdiff/ # # Usage: see "tkdiff -h" or "tkdiff --help" # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ############################################################################### # Chgd from 8.0 to 8.5 as of V4.3 to ensure support of "Text displaylines" package require Tk 8.5- # set a couple o' globals that we might need sooner than later # N.B> version must be roughly formatted as Maj.Minor[.patch][anythingelse] # It is parsed to PROMOTE old Preference data when required set g(name) "TkDiff" set g(version) "6.0" set g(debug) 0 ;# Master setting - Initialized (by default) to false # get this out of the way -- we want to draw the whole user interface # behind the scenes, then pop up in all of its well-laid-out glory wm withdraw . ############################################################################### # Primitive Debugging output (ie. useful values, states, etc.) during operation # Semi-cryptic output, but helpful (assuming pgmr plants it in useful places) # and can be enabled by: global var, cmdline flag or hard-coded per instance, # and can even be empirically DISABLED (per instance only: a -1 'force' flag) # EVERY msg is (by default) prefixed with a "Dbg: " header but is overridable, # and MAY be redirected into a specific output channel (default: stderr) # # IMPORTANT: when INVOKING this command (particularly when the 'message' # involves variables OR cmd processing), it is more efficeint to quote # that ARGUMENT with BRACES, not Dbl-quotes, because of the CONDITIONAL # nature of the "Dbg" execution -- those variables OR commands will not # be EVALUATED until "Dbg" determines it will ACTUALLY produce output!! # This makes a simple DEFAULTED CONTEXT (ie. NO EXPLICIT 'force' flag) MUCH # "lighter weight" by not evaluating args it has no intention of USING!! # # Mixing this together with a force-flag of "-1" means that you NEVER really # have to "comment out" a Dbg instance (beyond the cost of a NULL invocation) ############################################################################### proc Dbg {message {force 0} {hdr "Dbg: "} {where stderr}} { global g if {$force >= 0 && ($g(debug) || $force)} { puts $where "$hdr[uplevel 1 set na "\"$message\""]" } } # Startup phases: # IMPORTANT: this is a PRIMARY mechanism by which we act to prevent TK from # performing 'callbacks' or other actions at in-opportune times. # In short: level-0 begins at script readin. Level-1 should be set when # major data upheavals (wipes/(re)builds) are about to take place. # Moreover, callbacks themselves should try to separate WATCHING # what TK wants to do, from actually ALLOWING TK to initiate such # actions by only allowing any data dependent portions once level # 2 is current. # This then makes it possible for the application-code to invoke AT WILL # when IT knows the data is ready - **even** when level 2 has not quite # (as yet) officially been achieved! (See 'map-resize' as a key example). # HOWEVER, because it IS a 'global' flag, it cant be raised until ALL it # expects to cover is ready. If there is a need for finer 'granularity' # we can always invent more "Phases", designating which is needed by whom. # # 0 : Bare metal, looking for viable cmd args, obtaining 1st SCM content # 1 : Transitioning to GUI mode and/or DURING major datastruct upheavals # 2 : Operational mode set g(startPhase) 0 # FIXME - move to preferences option add "*TearOff" false 100 option add "*BorderWidth" 1 100 # Determine the windowing system # (since there are different ways to do this per past versions of tcl) if {[catch {tk windowingsystem} w(wSys)]} { # (Much older TK versions derive windowingSystem from the platform) if {"$::tcl_platform(platform)" == "windows"} { set w(wSys) "win32" } elseif {"$::tcl_platform(platform)" == "unix"} { set w(wSys) "x11" } elseif {"$::tcl_platform(platform)" == "macintosh"} { set w(wSys) "classic" } else { set w(wSys) "x11" # N.B> this is NOT Darwin (ie. MacOS X -> Aqua) as # 'tk windowingsystem' WONT have 'catch'ed to ARRIVE here } } # Determine the name of the temporary directory, the rc file name, # and NULLdev, all of which are platform dependent. # # Much MAY likely be overridden by a preference in .tkdiffrc, # EXCEPT (obviously) when no such file actually exists yet switch -- $::tcl_platform(platform) { windows { if {[info exists ::env(TEMP)]} { # N.B> Backslashes are problematic - lets convert this # to a Tcl 'canonical' pathname to just avoid it all. # But no worries - 'tmpfile' will convert BACK before use! set opts(tmpdir) [join [file split $::env(TEMP)] "/"] } { set opts(tmpdir) C:/temp } # Reserved filename which is REALLY a NULL device set opts(NULLdev) "nul" set basercfile "_tkdiff.rc" # Native look for toolbar set opts(fancyButtons) 1 set opts(relief) flat } default { # MacOS X seemingly sets TMPDIR to something awful like # /var/folders/uC/uCFr1z6qESSEYkTuOsevX++++yw/-Tmp-/ # BECAUSE its INHERITED from the "Finder" pgm-launcher - NOT the USER # Use the system location instead if {[info exists ::env(TMPDIR)] && $w(wSys) != "aqua"} { set opts(tmpdir) $::env(TMPDIR) } { set opts(tmpdir) /tmp } # Reserved filename which is REALLY a NULL device (Unix-like platforms) set opts(NULLdev) "/dev/null" set basercfile ".tkdiffrc" # Native look for toolbar set opts(fancyButtons) 0 set opts(relief) raised } } # Split up and store a VPATH EnvVar (if it exists) if {[info exists ::env(VPATH)]} { set finfo(Vpath) [split $::env(VPATH) ":"] } # Where should we start? # MacOSX apps want to start in ROOT (thanks Finder) which is obnoxious if {[pwd] == "/"} { if {[info exists ::env(HOME)]} { catch {cd $::env(HOME)} } } # Try to find a pleasing native look for each platform. # Fonts. set sysfont [font actual system] Dbg "system font: $sysfont" -1 # See what the native menu font is . configure -menu .native menu .native set menufont [lindex [.native configure -font] 3] destroy .native Dbg "menufont $menufont" -1 # Find out what the basic tk Fg/Bg/Font defaults are label .testlbl -text "LABEL" set w(bgnd) [lindex [.testlbl cget -background] 0] set w(fgnd) [lindex [.testlbl cget -foreground] 0] set labelfont [lindex [.testlbl configure -font] 3] destroy .testlbl Dbg "labelfont $labelfont" -1 # and for Text text .testtext set textfont [lindex [.testtext configure -font] 3] destroy .testtext Dbg "textfont $textfont" -1 # and for Entry entry .testent set w(selcolor) [lindex [.testent configure -selectbackground] 4] set entryfont [lindex [.testent configure -font] 3] destroy .testent Dbg "entryfont $entryfont" -1 # This happens on Windows in tk8.5 (and apparently *nix too)! # You get {TkDefaultFont} instead of {fixed 12} or whatever # Then when you add "bold" to it, WHAM - you have a bad spec! if {[set fs [lindex $textfont 1]] == ""} { # Decompose it, to RE-compose it: lassign [font actual $textfont] na fm na fs set textfont [list $fm $fs] } set font [list $textfont] set bold [list [concat $textfont bold]] Dbg "::font($font)\n::bold($bold)" -1 option add *Label.font $labelfont userDefault option add *Button.font $labelfont userDefault option add *Menu.font $menufont userDefault option add *Entry.font $entryfont userDefault # This makes tk_messageBox use our font. # The default tends to be terrible no matter what platform option add *Dialog.msg.font $labelfont userDefault # Initialize arrays ####################### # globals ('g' is general pgm globals, 'w' is more widget-related) # Defining them upfront mostly just avoids having to test for existance later. # Note: MORE KEYNAMES EXIST than just those shown here (eg. name, debug, ...) # Note: 'scmS' is a STATIC list of ALL known SCMs (reverse alpha sorted). # Note: 'scmSrch' is a STATIC list of SCMs capable of searches array set g { conflictset 0 count 0 destroy "" d3Left {} d3Right {} ignore_hevent,1 0 ignore_hevent,2 0 is3way 0 lnumDigits 4 mapborder 0 mapheight 0 mapwidth 0 mapScrolling 0 mergefile "" mergefileset 0 returnValue 0 scmDOsrch 0 scmPrefer "" scmS {Vpath SVN SCCS RCS PVCS Perforce HG GIT CVS ClearCase BK Accurev} scmSrch {CVS GIT SVN} showmerge 0 statusCurrent "Standby...." statusMrgL 0 statusMrgR 0 statusInfo "" tempfiles "" thumbMinHeight 8 thumbDeltaY 0 } # Widgets often go active AS they are being BUILT... potentially # INVOKING callbacks that EXPECT TO FIND critical variables # Ensure at least those are PRESENT ahead of time array set w { bLnum 0 prefD {alertD 0} TypPop1@ -1 TypPop2@ -1 TypPopA@ -1 } set UniQ 0 ;# Generic counter for ensuring UNIQUE object names # reporting options array set report { doSideLeft 0 doLnumsLeft 1 doCMrksLeft 1 doTextLeft "Full Text" doSideRight 1 doLnumsRight 1 doCMrksRight 1 doTextRight "Full Text" filename "tkdiff.out" fnamVetted 0 BMrptgen {} } # Be advised (regarding the following global array definition): # Produces On-demand Asynchronous file input via 'exec' machinery # (EXISTENCE of the element 'trigger' WILL activate it) array set ASYNc { out "" events 0 } # Only those elements that are gauranteed to exist are initialized here. # The remainder of the FINFO entries are dynamically added and (occasionally # removed) as the user interacts with the tool. There are 3 categories of # dynamic information: # #1. entries that describe INPUT parameters: # f,* filespec describing files/dirs/URLs (w/Glob syntax?) # rev,* revision value (for a to-be-detected SCM system) # FSpec* the DE-TILDE'd & DE-Glob'd internal form of f,* # scm* SCM list (DERIVED from 'f,*'), that detected as valid # ulbl,* user-label: when provided, overrides "lbl" (see below) # # #2. entries ACTUALLY used AFTER input has been processed # pth,* the actual local (possibly temp) file to compare # tmp,* optional flag denotes "pth" AS a tempfile (& other uses) # lbl,* displayable label for "pth" # pproc,* special post processing needed for "pth" (rare) # # #3. entries VERY similar to #2, but pertaining to ANCESTOR files # apth,* the actual local (possibly temp) file to compare # atmp,* optional flag denotes "apth" AS a tempfile (& other uses) # albl,* displayable label for "apth" # # In each above case, '*' is a monotonic number beginning at 1. Zero # is a special case used exclusively for a #1 "Ancestor File" entry. # The SAME value, WITHIN its category, describes attributes of a SINGLE # object --- However "ulbl" is an exception - its number is USED by # category 2, despite being SET by category 1 (reasons are mostly # historical, dating from a time when the only values WERE 1 & 2); # "ulbl" is NOT expected to see usage beyond that still valid case, # although it is NOT specifically prohibitted. # # Items in category #1 represent data ENTERRED by the user; as such they # are tied somewhat to the GUI (thereby initialized here), and are # (mostly) fixed at being at MOST three each (except MAYBE ulbl). Note that # scm,* (as an entry) is mostly for the inquiry/search modes as individually # retrieved files will generate their OWN (NOT modifying this global value). # Additionally, FSpec* is derived FROM its f,* value but acts as a BARRIER # between the syntax a user may ENTER (Tilde/Glob notations), and the # equivalent EXPANDED value (FSpec*) used internally (needed to span the # semantics of Tcl8.x versus Tcl9.x) # SADLY, these needs (internal/external & an unfortunate encoding DEFAULT) # only became necessary RECENTLY, (Tcl 9.0) thus one REALITY is that FSpec* # values are literally only USED at 'points of entry' and are SUBSEQUENTLY # *dumped back* into their external counterparts (f,*) once vetted to exist, # and operations can begin! # # >>>> EDITTING to just USE (FSpec*) EVERYWHERE was deemed TOO costly! # # While Tcl/Tk 9.0 made data ENCODING a much stricter issue, compensation was # possible by PRESERVING the default actions of V8.x.x, # # VIA a V9 "-profile tcl8" file config operation to OVERRIDE the defaulted # value of 'strict" (and SHOULD have been an 'open' option, but isn't)! # # Items in category #2 (NOT set here) are grouped as adjacently numbered # PAIRS, and are files intended, actually, or previously been compared, # DERIVED from the items of category #1. # # Items in category #3 (NOT set here) use a DISJOINT monotonic numbering # system from 1 to "fPairs" (explained next) AND a 'a'-prefix naming # # Beyond the 'category' entries are: # "fCurpair" designates which monotonic PAIR is actively in use (1->fPairs) # with "fPairs" itself being the COUNT of how many "fCurpair"s exist. # # "fLfmt" notes the CURRENT format of presenting a multiFile List where # (0=menu, 1=dialog); It is used in conjunction with opts(fLMmax) to # determine WHEN that format needs to be SWITCHed to one form or the other # Intention is to avoid 'unweildy' menus with too many entries. # # Thus "f,1" DIRECTLY implying "pth,1" is true ONLY if "f,1" designates a # single file. Likewise for "f,2" -> "pth,2". Input fields designating # directories and/or SCM branches (or commits) can generate SEVERAL "pth,N" # (and other category 2) entries, each. # # The "lbl,Left" and "lbl,Right" and "title" entries are simply the DISPLAYED # label values (set from whatever the ACTIVE pair of "lbl,*" entries are), # and are tied directly to the GUI, (providing a cheap update mechanism), and # "fRecurs" authorizes recursive descent if the given Fspec(s) is/are Dirs. # # Finally, "Vpath" only EXISTS (as a list of Vnodes) if the EnvVar VPATH did, # with "Vpofst" noting how many nodes(0->N) were "TOP pruned" due to the CWD # # IMPORTANT: # Certain COMBINATIONS of category 2/3 entries (existance, emptiness) are used # to describe various situations (i.e. tmp files, real files, pairs needing # comparison but NOT yet fully extracted from a necessary SCM repository; # or files NOT editable because they were extracted by an SCM; and even when # a 3way diff is to be considered active: ie. EXISTANCE of 'albl,N' element). # EXERCISE CARE Re: ADDING/RENAMING of NEW elements... # Category 2/3 values are essentially considered TRANSIENT and MAY BE # DELETED or reset at times using patterns such as '[aptl]*[0-9]'. # # Be VERY CAUTIOUS when considering CHANGING ANY of these manipulations! array set finfo { title {} fLfmt 0 fPairs 0 fCurpair 1 fRecurs 0 lbl,Left "label_of_file_1" lbl,Right "label_of_file_2" f,0 "" rev,0 "" FSpecA "" f,1 "" ulbl,1 "" rev,1 "" FSpec1 "" scm1 "" f,2 "" ulbl,2 "" rev,2 "" FSpec2 "" scm2 "" } # CRITICAL: # Color makes a HUGE difference to Tkdiff - lack of it, well, is gonna be # REALLY BAD with MANY features virtually UN-USABLE ... BUT it COULD "run". # # Historical notes: ################## # From V4.2 thru V5.0 a truely DISMAL ability to run MONOCHROME was maintained. # AS OF V5.1 (circa 2020) we decided that you likely cant BUY a B+W monitor # anymore, and even if you did, its HIGHLY unlikely you'd be using THIS tool. ################## # While we have left inplace the STRUCTURE to PROVIDE such support, AND the # critical CONTENT for re-engineering the changes to RESTORE that capability, # # POOF - Its now GONE!! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< # # Notably, the "else" to this test for color support WOULD NEED to contain lots # of local vars, suitably sprinkled throughout the 'driving list' for SETTING # the defaults. IN ADDITION, to the extent that they would CONFLICT with how # the COLOR settings are described, those SAME LOCAL VARS would require setting # within the "if-color" branch (not unlike how the colors themselves are done). # After, those locals, having replaced the hardcoding, SHOULD be UNSET as well # #################################### # # BECAUSE of all that, TkDiff **WILL NOW ABORT** if color is unavailable !! # # Yet THAT eventuality necessitates some juggling of "procs" to ensure they # EXIST before someone calls them. SO we need them HERE, NOW, because the # setting of APPLICATION DEFAULTS takes place at script "READ-IN time"! # # Furthermore, because these will ALL now reside ABOVE the demarcation of our # builtin pgm-flow tracing "region" they will ALWAYS operate silently untracked # REGARDLESS of WHEN they may be invoked (be that now to ABORT, or later on). # Needed is: 'fatal-error' and 'do-exit' # Conveniently, BEYOND these two, any FURTHER calls will NOT EMMANATE # from either of them because the needed conditions WILL NOT be met, OR # they are protected by 'catch'-stmts for their OWN internal reasons !! # ############################################################################# ############################################################################### ############################################################################### ## Severe Error/Exit handling mechanisms ############################################################################### ############################################################################### # Throw up a modal error dialog or print a message to stderr. # In general we print to stderr and exit if the main window hasn't yet been # created, otherwise put up a dialog and throw an exception. ############################################################################### proc fatal-error {msg} { global g if {$g(startPhase)} { popmsg $msg "Aborting..." } else { puts stderr "Error: $msg\n$g(name) Aborted" } do-exit 2 } ############################################################################### # Exit with proper code ############################################################################### proc do-exit {{returncode {}}} { global g w ASYNc # During pgm startup, we MAY have built the status window just to let the # user know we are talking to a SCM server that MIGHT experience network # latency - so if that window exists (but OTHER windows do not) and we are # here, something died and we want to RELEASE that window before we leave. if {[info exists w(status)] && ![info exists w(client)]} { Dbg "something died (or was killed) ... trying to shutdown" catch {wm forget $w(status)} # Release any extra event loop (if it is running) so we CAN leave set ASYNc(events) 0 unset -nocomplain ASYNc(trigger) ;# not much point, but it IS correct } # we don't particularly care if del-tmp fails. catch {del-tmp} # Value from latest external execution if {$returncode == {}} { set returncode $g(returnValue) } # exit with an appropriate return value exit $returncode } ############################################################################### # OK - FINALLY we can establish the DEFAULTS for running TkDiff (@ READ-IN !) ############################################################################### if {[string first "color" [winfo visual .]] >= 0} { # We have color - HURRAY!! (but, let's not go crazy...) # # This mass assignment is a NOD to the days of monochrome support # It remains more as an example of how to approach reinstating such, and is # NOT absolutely needed as the colors could simply be PLANTED where they go lassign "Tomato PaleGreen DodgerBlue yellow magenta \ Goldenrod1 Khaki gray LightSteelBlue blue" \ Pdel Pins Pchm Polp Padj Pinf Pcur Pdif Pcht Pbyt # (closebrace) else (openbrace) <-- WOW Tcl is really pissy about braces!! # # Only black and white?? YUCK (It's gonna look/work AWFUL, sorry). # lassign {Black White} bLk wHt ;# <-- just shortening the color names # lassign "$bLk $bLk $bLk $bLk $bLk $wHt $bLk $wHt $bLk $bLk" \ # Pdel Pins Pchm Polp Padj Pinf Pcur Pdif Pcht Pbyt # # These were the specifics of the MONOCHROME support settings: # # textopt "-background white -foreground black -font $font" # currtag "-background $Pcur -foreground white" # difftag "-background $Pdif -foreground black -font $bold" # deltag "-background $Pdel -foreground white" # instag "-background $Pins -foreground white" # chgtag "-background $Pcht -foreground white" # overlaptag "-background $Polp -foreground white" # bytetag "-underline 1" # inlinetag "-underline 1" # mapins "$Pins" # mapdel "$Pdel" # mapchg "$Pchm" # adjcdr "$Padj" # inform "$Pinf" # # The PROBLEM is that 'font'ing, underlining, etc were used to compensate # for the LACK of colors in certain instances posing complex substitution # situations (different option counts) together, PLUS more INVERSE VIDEO use # } else { fatal-error "$g(name) no longer supports Monochrome operation" } # Establish the DEFAULT option values for numerous application-wide items ... # (most are generally customized at runtime and become USER preferences) # # Each item is designated by an internal KEY and ALWAYS has a VALUE in 'opts()' # AND (if a DESCRIPTION was provided) thats kept (via the SAME key) in 'pref()' # Thus 'opts()' ALWAYS exists, but only MOST are considered as User PREFERENCES # (N.B> During ongoing development simply ADD to the table CONTENT as needed, # ( -> do NOT ALTER keys unless remapping OLD ones during UserPref READS) # ( > SOME 'opts' have ALREADY been Pre-defaulted: just PRESERVE them here) # *** IMPORTANT *** # Keys matching "[mng][rae][gvn]*" are CARGO Capable (ie $w(wSys) dependant)! # Binding to a DIGIT requires the "Key-" descriptor: as <1> would be a BUTTON foreach {key val desc} [subst { adjcdr "$Padj" {CDR region color during adjustment} autocenter 1 {Automatically center current diff region } autoselect 0 {Auto-select nearest diff region when scrolling} autoSrch 0 {Auto-search detected SCM when capable} bytetag "-background $Pbyt -foreground white -underline 1" {Tag options for characters in line view} chgtag "-background $Pcht" {Tag options for changed diff region} colorcbs 0 {Color change bars to match the diff map} currtag "-background $Pcur" {Tag options for the current diff region} customCode {} {} deltag "-background $Pdel -font $bold" {Tag options for deleted diff region} diffcmd "diff" {Diff command} difftag "-background $Pdif" {Tag options for diff regions} editor "" {Program for editing files} egnCmd "diff" {Diff cmd} egnSrchCmd "diff -r" {Diff recursive-srch cmd} egnCase 0 {Suppress Case distinction} egnBlanks 0 {Suppress all Whitespace} egn#Blanks 0 {Suppress varying Whitespace} egn@TabX 0 {Suppress Tab-based Whitespace} egn@EOL 0 {Suppress EOL Whitespace} egnTabSiz 0 {Specify the Tab size} egnSCase 0 {Suppress Case distinction-srch} egnSBlanks 0 {Suppress All Whitespace-srch} egnS#Blanks 0 {Suppress varying Whitespace-srch} egnS@TabX 0 {Suppress Tab-based Whitespace-srch} egnS@EOL 0 {Suppress EOL Whitespace-srch} egnSTabSiz 0 {Specify the Tab size-srch} egnXcludFil 0 {Specify excluded file patterns} eopCase "-i" {Suppress Case distinction arg} eopBlanks "-w" {Suppress All Whitespace arg} eop#Blanks "-b" {Suppress varying Whitespace arg} eop@TabX "-E" {Suppress Tab-based Whitespace arg} eop@EOL "-Z" {Suppress EOL Whitespace arg} eopTabSiz " --tabsize" {Specify the Tab size arg} eopSCase "-i" {Suppress Case distinction srch-arg} eopSBlanks "-w" {Suppress all Whitespace srch-arg} eopS#Blanks "-b" {Suppress varying Whitespace srch-arg} eopS@TabX "-E" {Suppress Tab-based Whitespace srch-arg} eopS@EOL "-Z" {Suppress EOL Whitespace srch-arg} eopSTabSiz " --tabsize" {Specify the Tab size srch-arg} eopXcludFil " -x" {File patterns to exclude arg} fancyButtons $opts(fancyButtons) {Windows-style toolbar buttons} filetypes { {"Text Files" {*.txt *.tcl}} {"All Files" {*}} } {Choice of file suffixes for file dialogs} fLMmax 9 {FileList Menu max-threshold} geometry "80x30" {Text window size} genEdit "" {Invoke an editor on the Current file} genFind "" {Request textual search in either file} genNxfile "" {Switch to next available file} genPvfile "" {Switch to prev available file} genRecalc "" {Request to re-diff current file pair} genXit "" {Request Immediate tool exit} ignoreEmptyLn 0 {Suppress diffs of empty lines} ignoreRegexLnopt {} {RegExp(s) for matching lines} ignoreRegexLn 0 {Suppress diffs of RegExp-matched lines} ignSuprs 0 {Utilize Engine suppresions when Diffing} inform "$Pinf" {Informational highlight} inlinetag "-background $Pchm -font $bold" {Tag options for diff region inline differences} inlSuprs 0 {Designated suppression attributes} instag "-background $Pins -font $bold" {Tag options for inserted diff region} mapchg "$Pchm" {Map color for changes} mapdel "$Pdel" {Map color for deletions} mapins "$Pins" {Map color for additions} mapolp "$Polp" {Map color for collisions} mrgLeft "" {Mark CDR for Leftside Merge} mrgLtoR "" {Mark CDR for Left-then-Right Merge} mrgRght "" {Mark CDR for Rightside Merge} mrgRtoL "" {Mark CDR for Right-then-Left Merge} navCntr "" {Center CDR within Display window} navFrst "" {Move CDR to First Diff region} navLast "" {Move CDR to Last Diff region} navNext "" {Move CDR to Next Diff region} navPrev "

" {Move CDR to Previous Diff region} overlaptag "-background $Polp" {Tag options for overlap diff region} predomMrg 1 {Predominant merge choice} scmPrefer {Auto Auto} {Prefer given SCM when detected} showcbs 1 {Show change bars} showinline1 0 {Show inline diffs (per-byte method)} showinline2 1 {Show inline diffs (recursive method)} showlineview 0 {Show current line comparison window} showln 1 {Show line numbers} showmap 1 {Show graphical map of diffs} syncscroll 1 {Synchronize scrollbars} tabstops 8 {Tab stops} tagcbs 0 {Highlight change bars} tagln 0 {Highlight line numbers} tagtext 1 {Highlight file contents} textopt "-background white -foreground black -font $font" {Text widget options} tmpdir $opts(tmpdir) {Directory for scratch files} toolbarIcons 1 {Use icons instead of labels in the toolbar} xcludeFils {} {Files to exclude when searching} }] { set opts($key) $val ; if {$desc != {}} {set pref($key) $desc} } # So much for defaulting ... (as mentioned earlier) "BRIEFLY" is now over! # Whack the little (global) vars we used to SEED and PROCESS the option values unset Pdel Pins Pchm Polp Padj Pinf Pcur Pdif Pcht Pbyt key desc val # Further ensure wrapping is turned off. This might piss off a few people, # but it would screw up the display ROYALLY to have things wrap append opts(textopt) " -wrap none" # Work-around for bad font approximations, # as suggested by Don Libes (libes@nist.gov). catch {tk scaling [expr {100.0 / 72}]} ############################################################################### # <<<< NOTICE >>>> # # The following PROCS are STILL ABOVE the "Do Not Track Me" script region !!! # These are primarily UTILITY Procs and unworthy of being traced... # You will KNOW if one of these fails because they will show up # in a Stack Trace on the way to a REAL error, or simply be MISSING # because pgm flow never let them be called (and so would not have # had the chance to announce themselves anyway... ############################################################################### ############################################################################### # Our Dialog 'factory' supporting: creation/display/invocation/release # Specific actions/args are per each subcmd & existence of 'windowName' (wNM) ############ subcmds ############## # NONMODAL wNM ?toplevel-args? # MODAL wNM ?toplevel-args? # Create/restores Dialog window toplevel; RCode indicates which. # 1= wNM existed and will be reused; 0= wNM was JUST NOW created: # caller then DEFINEs content (if reqd), followed by any needed # cfg/re-cfg, ultimately terminated with a PROPER 'show' subcmd # NONMODAL .vs. MODAL are mutually exclusive subcmds establishing # the mode (and expected usage) EACH performing the same tasks. # N.B> CHOICE of mode affects HOW to construct AND show the window!! # dismiss wNM ?savepos? # Remove dialog from display. Optionally (savepos==true) retain # last known size/position of window to reinstate on next use # Default savepos=0. NOTE: 'savepos' is generally only needed # if the dialog was intended to be DESTROYED and then rebuilt. # A simple 'dismiss' WILL tend to RE-display at its PRIOR loc. # # # # # # # # The following subcmd causes the dialog to be displayed and is designed to # be used after POSSIBLE construction and/or configuration. # N.B> There are implications to the CONSTRUCTION of a MODAL dialog regarding # the GLOBAL variable 'ctrlvar' whose NAME is specifed on the 'show' *IF* # it was declared as MODAL. # Primary is *it* becomes the target of any "actions" within the # dialog that expect to terminate it (successfully or not). The 'val', # given ON the 'invoke' should be whatever value you would want in a # default sense (Cancel, whatever), in the event the dialog is perhaps # closed via the window manager. # For a NON-MODAL dialog, ITS "actions" may be whatever is deemed # proper, including the 'dismiss' subcmd, or even a "destroy". # # show wNM [ctrlvar val] ?focusTarget? # Begins dialog processing and WAITs to be dismissed. Note that # if the window was defined as MODAL, "ctrlvar val" are REQUIRED. # When 'focusTarget' is provided, it should be the element within # 'wNM' where focus should be initially directed. RCode IS the # value of 'ctrlvar' (which itself must be GLOBALLY accessible) ############################################################################### proc Dialog {cmd wNM args} { global w switch -- $cmd { NONMODAL - MODAL { lassign {1 0} M(MODAL) M(NONMODAL) set w(mode$wNM) [expr {$M($cmd) * 2}] ;# To do syntax check @'show' if {![winfo exists $wNM]} { # N.B> The overall tool class DERIVES from its scriptname # (w/a Capitalized 1st letter): MAINTAIN that for any FURTHER # windows created else the Wmgr MAY decorate its taskbar wrong wm withdraw [toplevel $wNM -class Tkdiff {*}$args] if {$w(wSys)=="aqua"} { setAquaDialogStyle $wNM $M($cmd) } if {[info exists w(dlgeo,$wNM)]} { # We were TOLD (at a prior 'dismiss') to REposition this # window at its last known location - make that happen scan $w(dlgeo,$wNM) "=%*dx%*d+%d+%d" X Y wm geometry $wMN "=+$X+$Y" # But because we dont KNOW that such remembering will # happen again THIS time, FORGET it, while allowing the # dialog to acquire a NEW position AFTER being displayed # at this DESIGNATED location (USER is free to move it) unset w(dlgeo,$wNM) after idle wm geometry $wNM {} } # Tell caller window NOW exists, but is UNPOPULATED return 0 # else Tell caller window already exists and READY to be displayed } { return 1 } } show { if {[llength $args] < $w(mode$wNM)} { error "Dialog $wNM: $cmd: missing args" } # Put it onscreen # 'nowait' is to PREVENT us from WAITING for a MODAL dialog # that is ALREADY visible (not a USUAL situation, but...) if {[winfo ismapped $wNM]} {set nowait 1} {wm deiconify $wNM} raise $wNM if {$w(mode$wNM)} { lassign $args ctrlvar val focalpt upvar #0 $ctrlvar var # Poke ctrlvar if user nukes the window (release tkwait & GRAB) set var $val ;# FORCE named ctrlvar to EXIST with a VALUE bind $wNM [list set $ctrlvar $var] # Direct focus for the dialog if {![string length $focalpt]} { set focalpt $wNM } set focalPrev [focus -displayof $wNM] focus $focalpt if {![info exists nowait]} {catch {tkwait visibility $wNM}} catch {grab $wNM} ####################################################### # Begin dialog operation; waiting here until completion ####################################################### tkwait variable $ctrlvar catch {focus $focalPrev} catch {grab release $wNM} return $var } { lassign $args focalpt if {![string length $focalpt]} { set focalpt $wNM } after idle focus $focalpt } } dismiss { lassign [concat $args 0] retain ;# Save position? # Use CATCH to not CRASH: window MAY have been deleted catch { if {$retain} { set w(dlgeo,$wNM) [wm geometry $wNM] } catch { wm withdraw $wNM } } } } } ############################################################################### # A simple (reusable) 'entrybox' dialog. ############################################################################### proc Prompt { msg {preload {}} {title {Please provide}}} { global w set f .prompt if {![Dialog MODAL $f -bd 10]} { # Window was JUST created (withdrawn) and needs content wm title $f $title wm transient $f . wm group $f . # Don't destroy the window, just hide from view wm protocol $f WM_DELETE_WINDOW "Dialog dismiss $f" message $f.msg -text $msg -aspect 1000 entry $f.entry -textvariable w(val$f) pack $f.msg $f.entry [set b [frame $f.buttons]] -fill x pack $f.entry -pady 5 button $b.ok -text OK -default active -command "set w(ok$f) 1" button $b.cancel -text Cancel -command "set w(ok$f) 0" pack $b.ok -side left pack $b.cancel -side right bind $f.entry "$b.ok invoke ; break" bind $f.entry "$b.cancel invoke ; break" } else { $f.msg config -text $msg ;# Simply change the prompt msg on reuse } # Initialize, run, and dismiss if {[set w(val$f) $preload] != {}} { $f.entry selection range 0 end } $f.entry icursor end Dialog show $f w(ok$f) 0 $f.entry Dialog dismiss $f # Provide STATUS result # N.B> Caller is responsible for retrieving the actual TEXT response # (from the WELL-KNOWN location "$w(val.prompt)") AFTER checking # the returned boolean STATUS of the Dialog (ZERO = user CANCELLED) return $w(ok$f) } ############################################################################### ############################################################################### ## BUILTIN Specialized Debugging facilities ############################################################################### ############################################################################### ############################################################################### # Internal variation (of 'Dbg' - see defn @top of file) specifically geared to # the planting of 'trace' stmts which expect to 'append args' to a cmd prefix # STRICTLY FOR DEVELOPMENT/INVESTIGATIONAL USAGE # example - # trace add ?what&name? ?ops? WatcH # ..... (area of code to watch - particularly for what=variable) # trace remove ?what&name? ?ops? WatcH # # BUGS: only implemented for 'variable' traces just now ############################################################################### proc WatcH {args} { if {[set op [lindex $args end]] in "read write unset"} { # It was a variable trace, so show its value (unless it was unset) if {$op == "unset"} {set value "-na-"} {upvar [lindex $args 0] value} Dbg {$args\t\t$value} 1 "WatcH:" stdout } } ############################################################################### # Modal msg dialog: defaults to error classification/decoration in front of "." # Args (except 1st) are optional and are identified by CONTENT, NOT position # N.B> Not ALL (-type)s are presently recognized ############################################################################### proc popmsg {msg args} { global g # derive args (after establishing defaults) lassign {error ok Error} severe type title parent foreach item $args { if {[string index $item 0] == "." && [winfo exists $item]} { set parent "-parent $item" } elseif {$item in {error warning info question}} {set severe $item } elseif {$item in {ok okcancel yesno yesnocancel}} {set type $item } else { set title $item } } # Notify and wait for acknowledgement (default display is in front of ".") return [tk_messageBox -message "$msg" -title "$g(name): $title" \ -type $type -icon $severe {*}$parent] } ############################################################################### # INTERNAL stacktrace generator (helps pin down WHERE something got executed) # Defaults to tracing stack-levels, but can be asked to do stack-frames ############################################################################### proc trap-trace {{title "Trace"} {framORlevl "level"}} { set str "" for {set x [expr [info $framORlevl]-1]} {$x > 0} {incr x -1} { append str "$x: [info $framORlevl $x]\n" } popmsg $str info "$title" ;# pause until developer acknowledges } # PREPARE to OverWrite all those defaults (reading the USERS Preferences file) # Errors will ultimately be reported. But before doing so, we need to CREATE: proc define {name value} { global w opts # Any key coming thru that CONTAINS (read as: PREFIXED) with the value of # the CURRENT windowing system must be stripped back to its REAL preference # name (and stored as such). This allows anything else (such as some OTHER # PLATFORMs setting - aka bindings) to just simply be retained (as CARGO) # N.B> Requires NON-'prefix' USE of cargo TRIGGER strings to be Verboten! set opts([string map "$w(wSys) {}" $name]) $value } # This lets the rc file have a slightly more human-friendly interface, # AND hides our 'cargo' mechanism for w(wSys) DEPENDENT values! # Old-style .rc files should still load just fine for now, though it ought to # be noted NEW .rc files won't be able to be processed by OLDER TkDiff vrsns # BUT - that SHOULDN'T be a problem (who moves backward?) # Compute Preferences file LOCATION in preparation to attempted READing # N.B> TKDIFFRC can hold EITHER a dir or file NAME, # with the PRESUMPTION its a FILE if whats NAMED doesnt CURRENTLY exist # Same is true of the $HOME location, but NOT for the ROOT location if {([info exists ::env(TKDIFFRC)] && [set g(rcfile) $::env(TKDIFFRC)]!={}) || ([info exists ::env(HOME)] && [set g(rcfile) [file join $::env(HOME) $basercfile]] != {})} { if {[file isdirectory $g(rcfile)]} { set g(rcdir) $g(rcfile) # Probe if user supplied a "-P preFname" option on the cmdline if {[set g(rcfile) [lindex [regexp -inline -all -- \ {(?:\A|\s+)-P\s*(\S+)} $argv] 1]] != {}} { set g(rcfile) [file join $g(rcdir) $g(rcfile)] } { set g(rcfile) [file join $g(rcdir) $basercfile] } } # This is terribly anti-social and LIKELY aint 'save'-able ANYWAY! # But it ALLOWS us to "soldier on" using JUST the builtin defaults. # and anything the user cares to modify them to in their session. } { set g(rcfile) [file join "/" $basercfile] } # AND clean up the global namespace (which wasnt checked before trampling)!! unset -nocomplain basercfile # GO READ the Pref file (if its there) if {[file exists $g(rcfile)]} { if {[catch {source $g(rcfile)} error]} { set startupError [join [list "There was an error in processing your\ startup file." "\n$g(name) will still run, but some of your\ preferences" "\nmay not be in effect." "\n\nFile: $g(rcfile)" \ "\nError: $error"] " "] } ############################################################################### # Preference Morphing # (written as if this were a CALLED proc, but STILL all happening @ READ-in) # # RARELY - an EXISTING preference becomes inconsistent with the evolution # of the code. As we cant know in advance what vintage file was just # read-in, it may have just installed a SEMANTICALLY OLDER Pref. Its useful # to map/adjust (or at least, remove) such older Prefs (when reasonable). # Each of these "Morphs" chains forward to the next to allow ANY age of # file to be processed UP the evolutionary path: an in-exact science at best! # N.B> While ADDing NEW Prefs is never an issue, installing Prefs NEWER than # the RUNNING code version is PROBLEMATIC - yet is NOTED; ...NOT aborted! ############################################################################### # 1st hack (predates files even HAVING the version stamp that WROTE them) # V3.0 was the first codebase NEEDING this for (~ V2.xx+) files... # If user has a 'diffopt' Pref defined (from their rc file), # magically convert/merge that to become 'diffcmd' if {[info exists opts(diffopt)]} { set opts(diffcmd) "diff" ;# The V3.0 original DEFAULT value lappend opts(diffcmd) {*}$opts(diffopt) unset opts(diffopt) } # 2nd hack (files become version stamped) # V4.3.1 Began recording the Codebase version that WROTE the Prefs, but when # READ back IN, was placed into a bare GLOBAL Var "prefsFileVersion". # Luckily, no SEMANTICS ever CHANGED in the codebase since that time, # thus nothing needs adjusting beyond the stamp LOCATION itself # (maintaining the evolutionary chain) if {[info exists "prefsFileVersion"]} { set opts(prefsVrsn) $prefsFileVersion unset prefsFileVersion } # 3rd hack (PERMANENT location of the 'File Version') # V5.1 Decided it made more sense to keep the "FV" (fileVrsn) WITH the datums # and thus base future MORPHs on the versions themselves. # Morphing is an UPWARD process, all bets are off if the FV is NEWER! if {[info exists opts(prefsVrsn)] && [regexp {[0-9]+(?:\.[0-9]+)*(?:[ab][0-9]+)?} $opts(prefsVrsn) FV] && [regexp {[0-9]+(?:\.[0-9]+)*(?:[ab][0-9]+)?} $g(version) CV] && [package vcompare $FV $CV] <= 0} { # V5.5 Re-oriented how Diff (as an Engine) is CONFIGd for use in TkDiff if {![package vsatisfies $FV "5.5-"]} { # 1. No longer presumes "diffcmd" IS (GNU) Diff exclusively. Merges # SRCH args into the NEW Srch-cmd (which simply DEFAULTs to "diff") # 2. Similarly, suppression categories are now explicit (DO NOT MAP # the old 'blackbox' flag set -is not worth it- Just whack'em); the # resultant All-Suppressions-OFF default makes USER then RE-config. # 3. "ignoreblanks" is now "ignSuprs" (same semantics - new NAME), # "ignoreRegexLn" and "ignoreEmptyLn" became bit-Based booleans. # 4. "diffcmd" is now DERIVED (as opposed to user-SET) thus will be # rewritten internally (later), requiring no further action. if {[info exists opts(fRecurs)]} { lappend opts(egnSrchCmd) {*}$opts(fRecurs) } if {$opts(ignoreEmptyLn)} { set opts(ignoreEmptyLn) 8 } if {$opts(ignoreRegexLn)} { set opts(ignoreRegexLn) 4 } if {$opts(ignoreblanks)} { set opts(ignSuprs) 2 } unset -nocomplain \ opts(fRecurs) opts(ignoreblanksopt) opts(ignoreblanks) } ################################################################################ # FUTURE Morphs should INSERT above HERE as OPEN-ENDED If-'package vsatisfies' # code-blocks in INCREASING Version order (when needed) ################################################################################ } else { popmsg "Your Preference file (V$FV) appears to be NEWER than the $g(name) V$CV currently running. This MAY NOT operate properly..." warning "Near CRITICAL warning" } } ############################################################################### # SCRIPT readin-time TRICK for EXTENDED DYNAMIC debug tracking on DEMAND # # Pre-scan command line args to detect/collect ALL debug (-d*) specifications # (because we EMBED tracking info INTO designated procs - NOT WRAP THEM!) # If ANY specs exist - we WRAP the 'proc' LANGUAGE STMT instead to act as a # SELECTOR of which yet-to-be-read procs to augment with tracking, IN ADDITION # to its normal task of actually DEFINING every such proc seen - from HERE ON! # #N.B> ANY proc NOT TO BE pre-processed should occur BEFORE reaching this code!! # CRITICAL: # "scanning" of EVERY PROC read *DOES AFFECT* autoloaded ones as well: Thus, # 'wrapping' here *WILL BE REVERTED* before reaching the END OF THIS SCRIPT!! # Also Tcl/Tk V9 changes to default-namespace storage-scoping does NOT 'play' # well with this technique and MAY have issues EXPANDING Var values to report # JUGGLING the renaming of 'proc' SURROUNDING such namespace READINGS # (to UNdo, then REdo) would be A method to EXEMPT them from consideration. ############################################################################### if {[set DbuG [lsearch -inline -glob -all $argv {-d*}]]!={}} {lappend DbuG -- rename ::proc ::proc_ ;# RENAME 'proc' stmt to NEW name, then USE to redefn proc_ proc {nam arglst body} { # Each argline supplied -d spec is COMPOSED of (encoded) idioms: # SIMPLE Dbg activation -> (d) - Turned on BEFORE Run-time BEGINS # what type of proc? -> regular (dp) or widget (dw) # RE match in/ex-clude? -> exclude (!) or include () <- implied # OF a specific naming -> APPENDED regexp expression # N.B> Cmdline ORDER of specs may(?) result in unintended implications # (if so, it is was never anticipated to work in that fashion) if {[llength $::DbuG] > 1} { foreach d $::DbuG { if {[switch -glob -- $d { -dw!?* {expr { [string equal -len 1 $nam "."] && [regexp [string range $d 4 end] $nam] ? [break] : 0}} -dw?* {expr { [string equal -len 1 $nam "."] && [regexp [string range $d 3 end] $nam]} } -dw {expr { [string equal -len 1 $nam "."]} } -dp!?* {expr {![string equal -len 1 $nam "."] && [regexp [string range $d 4 end] $nam] ? [break] : 0}} -dp?* {expr {![string equal -len 1 $nam "."] && [regexp [string range $d 3 end] $nam]} } -dp {expr {![string equal -len 1 $nam "."]} } default {if {$d != "--"} { # Wasnt EoList sentinel? -- Bad or a plain "-d" arg if {$d=="-d" && !$::g(debug)} { set ::g(debug) 1 ## ANNOUNCE us (proves it was turned on) Dbg {$::g(name) $::g(version)} 0 "\n\n\nDbg: " } # Once Dbg turned ON, dont need '-d' IN ::DbuG anymore # (N.B> removes duplicates AND syntactically BAD Specs) set d [lsearch -exact $::DbuG $d] set ::DbuG [lreplace $::DbuG $d $d] } set d 0 }}]} then { proc_ $nam $arglst [concat {puts stderr \ "[string repeat " " [info level]][info level 0]";} $body] return ;# Tracking was EMBEDDED into NAMED proc } } } proc_ $nam $arglst $body ;# <--Does NOT embbed ANYTHING in THIS proc } # N.B> 'proc_' RUNs ONLY @SCRIPT-READ time (is REVERT'd before READin ends) } ############################################################################### ############################################################################### # HERE BEGIN THE PROCS (any BELOW this line are subject to execution tracking) ############################################################################### ############################################################################### ############################################################################### # Return the name of a temporary file # n - a naming fragment (to help identify where/why it was created) # forget!=0 - dont 'remember' the filename for the "destroy @ termination list" ############################################################################### proc tmpfile {n {forget 0}} { global g opts UniQ set tmpdir [file nativename $opts(tmpdir)] set fnam [file join $tmpdir [pid]-$n-[incr UniQ]] Dbg {temp file $fnam} set access [list RDWR CREAT EXCL TRUNC] set perm 0600 if {[catch {open $fnam $access $perm} fid ]} { # something went wrong error "Failed creating temporary file: $fid" } close $fid if {!$forget} {lappend g(tempfiles) $fnam} return $fnam } ############################################################################### # Execute an external command, optionally storing STDOUT into a given filename # Returns the 3-tuple list "$stdout $stderr $exitcode" # # Operation is sensitive to the EXISTANCE (not value) of flag "ASYNc(trigger)" # to run in ASYNChronous .vs. BLOCKing mode. When running ASYNC, an event loop # is provided for dispatching tasks encountered WHILE the command is processed ############################################################################### proc run-command {cmd {out {}}} { global ASYNc errorCode # Arrange for requested output format (given execution constraints) # N.B> 'fout' targets one of: a channel, a cmd indirection, or a Variable if {[info exists ASYNc(trigger)]} { # Establish channel for cmd to WRITE into if {[set fout $out] != {}} { fconfigure [set fout [open $out wb]] -buffering none # PREVENT V9.x from throwing 'encoding' errors if {$::tcl_version >= 9.0} { fconfigure $fout -profile tcl8 } # (-OR- into ALIAS'd global AYSNC-var TO local name) } { upvar #0 ASYNc(out) STDout } # -OR- redirect'd DIRECTLY into a file (encoding doesnt matter - for now) } elseif {[set fout $out] != {}} { set fout "\">$out\"" } # Establish default answers set STDerr [set STDout ""] set exitcode 0 set cmderr [tmpfile "cmderr" 1] ;# retain filename locally; WE will whack # (N.B> stderr redirection prevents 'catch' from assuming msgs -> errors) # But the big difference in ASYNC .vs. BLOCKing is how to deal with STDOUT if {[info exists ASYNc(trigger)]} { Dbg "Cmd running in ASYNC mode" # Startup the cmd (so we can attach its stdout to the event loop) ... # ...where an (anonymous) handler can snag any/all STDOUT produced, but # more importantly WATCHES for an EOF, telling us the cmd has completed set cmdout [open "|$cmd \"2>$cmderr\"" rb] chan configure $cmdout -blocking 0 -buffering none chan event $cmdout readable [list apply {{fin fptr} { global ASYNc if {$fptr != {}} { puts -nonewline $fptr [chan read $fin] } else {append ASYNc(out) [chan read $fin]} if {[chan eof $fin]} {set ASYNc(events) 0}}} $cmdout $fout] # (args shown above are PASSED via these param) -> fin fptr set ASYNc(events) 1 #### vwait ASYNc(events) ;# wait here until we see EOF from handler above #### chan configure $cmdout -blocking 1 ;# (N.B> to get errorcodes) if {[set failed [catch "close $cmdout"]]} {set errCODE $errorCode} Dbg "Back from ASYNC cmd: rc($failed)" if {$fout != {}} { catch {close $fout} } } elseif {[set failed [catch "exec $cmd $fout \"2>$cmderr\"" STDout]]} { set errCODE $errorCode ;# Snag this before it can get overwritten } # Suck out any error messages that MAY have been produced (and whack file) catch { set hndl [open "$cmderr" r] # PREVENT V9.x from throwing 'encoding' errors if {$::tcl_version >= 9.0} { fconfigure $hndl -profile tcl8 } set STDerr [read $hndl] close $hndl file delete $cmderr } if {$failed} { switch -- [lindex $errCODE 0] { "CHILDSTATUS" { set exitcode [lindex $errCODE 2] } "POSIX" { if {$STDerr == ""} { set STDerr $STDout } set exitcode -1 } default { set exitcode -1 } } } #Dbg "runcmd RESULTS($exitcode): out([string length $STDout])\ err([string length $STDerr]) appropriate ?" return [list "$STDout" "$STDerr" "$exitcode"] } ############################################################################### # Populate the 'ndx'th finfo FILE via its accompanying finfo 'tmp' SCM command # Returns descriptive msg(s) if something fails; a NUL string on Success ############################################################################### proc scm-chkget {ndx} { global finfo # 'ndx' is a number POSSIBLY prefixed by an 'a' (for ancestor) # adjust the NAMING for 'finfo(xxx)" elements accordingly set A "a" ; if {[string index "$ndx" 0] == $A} { set ndx [string range $ndx 1 end] } { set A "" } if {![info exists finfo(${A}pth,$ndx)]} { set finfo(${A}pth,$ndx) "[tmpfile scm$ndx]" } Dbg {scm-chkget ($ndx) -> '$finfo(${A}tmp,$ndx)': $finfo(${A}pth,$ndx)} lassign [run-command "$finfo(${A}tmp,$ndx)" "$finfo(${A}pth,$ndx)"] \ scmOUT scmERR scmRC # Remember to postproccess (if needed) and ... if {!$scmRC} { if {[info exists finfo(${A}pproc,$ndx)]} { $finfo(${A}pproc,$ndx) "$finfo(${A}pth,$ndx)" } # ... return the erased cmd (DO NOT UNSET) to indicate Success return [set finfo(${A}tmp,$ndx) ""] } # This atrocity originated because CVS refuses to extract the Repo version # of a CONFLICTED file - but WITHOUT posting any visible REASON ... WTF? ! # So look for this and inject our OWN error msg if {[set msg "$scmERR\n$scmOUT"] == "\n" \ && [string match {cvs[ .]*} $finfo(${A}tmp,$ndx)]} { set msg "Is this a CONFLICTed file(?): [lindex $finfo(${A}tmp,$ndx) end]" } # Send messages back to caller only on failure return "$msg" ;# Failed! } ############################################################################### # Filter PVCS output files that have CR-CR-LF end-of-lines ############################################################################### proc filterCRCRLF {file} { set outfile [tmpfile CRCRLF] set inp [open $file r] set out [open $outfile w] fconfigure $inp -translation binary fconfigure $out -translation binary set CR [format %c 13] while {![eof $inp]} { set line [gets $inp] if {[string length $line] && ![eof $inp]} { regsub -all "$CR$CR" $line $CR line puts $out $line } } close $inp close $out file rename -force $outfile $file } ############################################################################### # Return the smallest of two values (N.B> args CAN be expressions) ############################################################################### proc min {a b} { return [expr {($a) < ($b) ? [expr ($a)] : [expr ($b)]}] } ############################################################################### # Return the largest of two values (N.B> args CAN be expressions) ############################################################################### proc max {a b} { return [expr {($a) > ($b) ? [expr ($a)] : [expr ($b)]}] } ############################################################################### # Align (or force set on/off) Info window item visibility ############################################################################### proc do-show-Info {{which {}} {force {}}} { global g w opts if {$force != {}} { set opts($which) $force } # Detect if/when text Info windows should be mapped OR unmapped if {$opts(showln) || $opts(showcbs) || $g(is3way)} { if {! [winfo ismapped $w(LeftInfo)]} { grid $w(LeftInfo) -row 0 -column 1 -sticky nsew grid $w(RightInfo) -row 0 -column 0 -sticky nsew } } elseif {[winfo ismapped $w(LeftInfo)]} { grid forget $w(LeftInfo) grid forget $w(RightInfo) } # The mergeInfo window (for now) is ALWAYS 'on' ... # However if we ever create an opt() for the "contrib markers" # then simply uncomment this to get it to turn on/off like above # if {$opts(showln) || $opts(XXX-contrib-XXX)} { # if {! [winfo ismapped $w(mergeInfo)]} { # grid $w(mergeInfo) -row 0 -column 0 -sticky nsew # } # } elseif {[winfo ismapped $w(mergeInfo)]} { # grid forget $w(mergeInfo) # } # In any event SOMETHING changed - ensure we utilize canvas properly cfg-line-info } ############################################################################### # Transliterate "text-tagging" precedences for Font/Bg/Fg canvas plotting ############################################################################### proc translit-plot-txtags {twdg} { global g opts # The neccessity of this routine stems from the USER view being one of # setting 'text-tags' for highlighting various meta-data pgm elements, # because THAT was the FORMER implementation. Internally we have shifted # to a Canvas based technique (to reduce textline aligment issues since # version TK8.5), but must NOW cope with the reality of canvas-text NOT # providing a 'tag-precedence-stack' mechanism. Emulating a "what-would- # have-happened" approach is better than redefining the USER view of the # preferences (or auto-magically MAPPING the existing user base). # # Technique is to pre-compute how the tagging-specified user input would # be precedence-stacked by the pgm so we can setup direct access to "N" # composite sets of values as needed when canvas-rendering the meta-data. # Note that TkDiff uses MORE than simple precedence and thus SOME sets # might only be UTILIZED by the Left or Right view, or under values of # OTHER related option settings -- thus the NAMING of each set is an # encoding that 'plot-line-info' intends to access randomly as needed. # First establish a BASE precedence layer (just the Text widget settings) # (what you get if NO user tagging was explicitly supplied [unlikely]). # For the 3 key display values we support: Font Fg Bg # plus 2 font-derivative metrics we NEED later: Ascent Ascent+Descent # (PLUS a running MAX of certain key-character widths across ALL fonts) set Fg [$twdg cget -foreground] ;# foreground set Bg [$twdg cget -background] ;# background set Fnt "[$twdg cget -font]" ;# font set Aft [set Hft [font metrics $Fnt -ascent]] ;# ascent of font incr Hft [font metrics $Fnt -descent] ;# height of font set Dw [font measure $Fnt "8"] ;# Digit width set Cw [font measure $Fnt "+"] ;# ChgBar width set Sw [font measure $Fnt " "] ;# Space width set Mw [font measure $Fnt "M"] ;# Em width # Begin the database with a snapshot of the "settings" for what is # (effectively) the "textopt" tag layer (plain old file lines) lappend DB [set nam t] "{$Fnt} $Aft $Hft $Fg $Bg" # Now, OVERLAY in PRECEDENCE ORDER, successive basic tags, recording each foreach t {difftag currtag} { # Turn each tagging definition into a "look up table"(lut) of its # contents, then look for any option names of interest, and process # whichever ones are found (similar to above BASE setting derivation) append nam [string index $t 0] array set lut $opts($t) foreach op [array names lut -regexp {\-((f|b)g|(fo[rn]|ba))}] { # (allow for abbreviations of the V8.5 option keywords) switch -glob -- $op { "-for*" - "-fg" { set Fg $lut($op) } ;# fg "-b*" { set Bg $lut($op) } ;# bg "-fon*" { set Fnt $lut($op) ;# font set Aft [set Hft [font metrics $Fnt -ascent]] ;# ascent incr Hft [font metrics $Fnt -descent] ;# height set Dw [max $Dw [font measure $Fnt "8"]] ;# maximal Dw set Cw [max $Cw [font measure $Fnt "+"]] ;# maximal Cw set Sw [max $Sw [font measure $Fnt " "]] ;# maximal Sw set Mw [max $Mw [font measure $Fnt "M"]] ;# maximal Mw } } } # Append this snapshot of values to the overall database lappend DB $nam "{$Fnt} $Aft $Hft $Fg $Bg" array unset lut } # DB entries 't'(text) 'td'(diff) and 'tdc'(curr) now exist IN THAT ORDER # # Next construct the mutually exclusive variations that are specifically # composited by the pgm when adds/chgs/dels are detected in the input files # onto EACH of the LAST TWO CATEGORIES. Note that specific Info-only # situations (eg. opts(colorcbs), highlighting) are NOT addressed here and # is handled during 'plot-line-info' rendering directly. foreach t {instag chgtag deltag overlaptag} { # Re-establish base settings prior to overlay of EACH mutual tag foreach {nam base} [lrange $DB 2 5] { lassign $base Fnt Aft Hft Fg Bg # Derive new name, then turn each tagging definition into a # "look up table"(lut) of its contents, looking for the option # names of interest, overlaying values found (same as before) # Note that each new name is a MAPPING into its Chgbar mark append nam [string map {i + c ! d - o ?} [string index $t 0]] array set lut $opts($t) foreach op [array names lut -regexp {\-((f|b)g|(fo[rn]|ba))}] { # (again, allow for abbreviations of the V8.5 option keywords) switch -glob -- $op { "-for*" - "-fg" { set Fg $lut($op) } ;# fg "-b*" { set Bg $lut($op) } ;# bg "-fon*" { set Fnt $lut($op) ;# font set Aft [set Hft [font metrics $Fnt -ascent]] ;# ascent incr Hft [font metrics $Fnt -descent] ;# height set Dw [max $Dw [font measure $Fnt "8"]] ;# maximal Dw set Cw [max $Cw [font measure $Fnt "+"]] ;# maximal Cw set Sw [max $Sw [font measure $Fnt " "]] ;# maximal Sw set Mw [max $Mw [font measure $Fnt "M"]] ;# maximal Mw } } } # Append this snapshot of value to the overall database lappend DB $nam "{$Fnt} $Aft $Hft $Fg $Bg" array unset lut ;# throw away all lut tuples for next pass } } # Historical Note (Re: TKDIFF 4.2 and earlier) # The highest precedence tag, "inlinetag", is only designed for (thus # overrides) 'chgtag' defined values. However, it is ONLY ever APPLIED to # char-ranges within the main L/R-Text widgets. Thus its color/font opts # NEVER applied to the actual RENDERING of Info data, despite them having # been (in the past) CONFIGURED into the Lnum and CB *Text widgets*. Thus # it AFFECTS nothing and as such, this emulation ignores it. # Finally, post the data needed by 'cfg-line-info' to compute canvas width # AND the complete database of precomputed attrs for 'plot-line-info' with # its 11 values: "t, td, td+, td!, td-, td?, tdc, tdc+, tdc!, tdc-, tdc?" set g(scrInf,cfg) "$Dw $Cw $Sw $Mw" set g(scrInf,tags) $DB } ############################################################################### # Resolve present Info window plotting configuration (AFTER any chngd settings) ############################################################################### proc cfg-line-info {} { global g w opts # First obtain the maximal Text widget font measurements lassign $g(scrInf,cfg) wDig wChg wSpc wEm # Then establish an X position for plotting the PRIMARY Info elements such # that the maximal line number (if visible) will FIT to its left # Values (mX, tX) for windows (Merge .vs. Text) WILL need to be distinct set g(scrInf,mX) [set g(scrInf,tX) \ [expr {$opts(showln) ? $wDig*$g(lnumDigits) : 0}]] # In a 3way Diff situation, make room for a Textwin "ancestral indicator" if {$g(is3way)} { incr g(scrInf,tX) $wEm } # MergeInfo always (for now) adds space for ITS (left/right) markers # (but it COULD be done as a pref, by replacing 'true' with some var) if {[set sz [expr {( true ? $wChg+$wSpc : 0) + $g(scrInf,mX)}]]} { $w(mergeInfo) configure -width [incr sz 3] incr g(scrInf,mX) ;# 'slides' padding to 1pxl on left and 2pxl right } # Add to 'tX' any space needed for Changebars (if visible) which will # left-justify to that position defined above. Then INCREASE that amount # (+5pxl for padding) and apply it to BOTH Text Info canvases, calling it # "scrInf,XX" (for plotting), making the canvas EXACTLY wide enough # (does NOTHING if meta-data visibility options are ALL turned off) if {[set sz [expr {($opts(showcbs) ? $wChg+$wSpc : 0) + $g(scrInf,tX)}]]} { $w(LeftInfo) configure -width [incr sz 5] $w(RightInfo) configure -width [set g(scrInf,XX) $sz] incr g(scrInf,tX) 3;# 'slides' padding to 3pxl on left and 2pxl right } } ############################################################################### # Plot text widget line numbers and/or contrib markers in adjoining info canvas ############################################################################### proc plot-merge-info {args} { global g w opts # Ignore this routine if not needed, havent gotten far enough in processing # -OR- its trigger will have zero effect on the displayed content if {!$g(showmerge) || $g(startPhase) < 2 \ || ([llength $args] > 0 && [lindex $args 0 1] in $w(benign))} return # Initialize: Empty the canvas # Identify the line range of the CDR # Import the 'tag' attr table and make it random access # Begin with NO current attr group $w(mergeInfo) delete all lassign [$w(mergeText) tag ranges currtag] sCDR eCDR array set attr $g(scrInf,tags) set aGRP {} # Begin at 1st VISIBLE screen text line, converting its indice->integer set Lnum [file rootname [$w(mergeText) index @0,0]] # Map/plot Lnums # Line numbers here are identical to widget indices. Markers derive # from the TAGNAMES used for each line of a given diff REGION. # (PRESUMES the canvas & text widgets are physically aligned!!) # Stops when we walk beyond the visible range of the Text widget lines, # -OR- we discover the EXTRA "last line" at the bottom of the widget set LastLnum [file rootname [$w(mergeText) index end-1lines]] while {[llength [set dline [$w(mergeText) dlineinfo $Lnum.0]]] > 0} { if {$Lnum == $LastLnum} {break} ;# ignore extra last line # Detect/decode any diff(R/L) tag on the line (if it even exists) # (the tag NAME encodes what SIDE the merge contribution came from) # N.B. tags report in priority order, thus ZERO should be where to find # EITHER 'diff(R/L)' (each being of lowest prio & mutually exclusive) switch [lindex [$w(mergeText) tag names $Lnum.0] 0] { diffR { set aNewGRP [expr {$Lnum<$sCDR || $Lnum>=$eCDR ? "td" : "tdc"}] set side " >" } diffL { set aNewGRP [expr {$Lnum<$sCDR || $Lnum>=$eCDR ? "td" : "tdc"}] set side " <" } default { set side {} ; set aNewGRP "t"} } # Instantiate correct 'tag' attribute group (if it changed) if {"$aNewGRP" != "$aGRP"} { lassign $attr([set aGRP $aNewGRP]) Fnt Asc Hgt Fg Bg } # We want to plot on the same BASELINE as the text widget, but it # must be EMULATED as canvas '-anchor' provides NO SUCH setting. lassign $dline na y na na bl ;# extract TxT y and baseline incr y $bl ;# move y to its baseline then UP by the incr y -$Asc ;# "plot font" ascent (=eff. NE/NW edge) # Plot the contributory-side marker (if any) if { "$side" != {}} { $w(mergeInfo) create text $g(scrInf,mX) $y -anchor nw \ -fill $Fg -font $Fnt -text "$side" } # Plot LineNum if requested if {$opts(showln)} { $w(mergeInfo) create text $g(scrInf,mX) $y -anchor ne \ -fill $Fg -font $Fnt -text "$Lnum" } incr Lnum } } ############################################################################### # Plot text widget line numbers and/or change bars in adjoining info canvas ############################################################################### proc plot-line-info {side args} { global g w opts # Ignore this routine if we havent gotten far enough into the processing # -OR- everything that might have displayed is turned OFF anyway if {$g(startPhase) < 2 \ || ((!$g(is3way)) && (!$opts(showln)) && (!$opts(showcbs)))} return # Create session-persistent constants for NOW and FUTURE use if {! [info exists g(LR,Left)]} { set g(LR,Left) [list Snum Enum Pad Ofst Cbar] set g(LR,Right) [list Snum Enum na na na Pad Ofst Cbar] } # Only redraw when args are null (meaning we were called by a binding) # or when called by the trace and the widget action might potentially # change the height of a displayed line. if {[llength $args] == 0 || [lindex $args 0 1] ni $w(benign)} { # Initialize: Empty the canvas # Import the 'tag' attr table and make it random access # Begin with NO current attr group # Map the index of the 'current diff' to refer to g(DIFF) # Presume default first attr-group is a NON hunk-line $w(${side}Info) delete all array set attr $g(scrInf,tags) set aGRP {} set gPos [hunk-ndx [hunk-id $g(pos)] DIFF] set aNewGRP "t" # Begin at 1st VISIBLE screen text line, converting its indice->integer set Lnum [file rootname [$w(${side}Text) index @0,0]] # Now, (if >1 exists) binary-search for an APPROPRIATE start "scrInf,*" # entry to allow mapping 'Lnum' BACK to its ORIGINAL linenumber. We # want the CLOSEST item (preferrably ABOVE) the target Lnum value, but # BELOW is used when Lnum > last line of the final hunk. When NONE # exist (files are identical), the screen numbers ARE the real numbers, # so a dummy entry allows the remaining code to function properly. if {[set i $g(COUNT)]} { # N.B> 'rngeSrch' (unlike hunk-id, et.al) uses ZERO-based indices # so increment the index UNLESS it comes back as the last entry if {[set i [rngeSrch DIFF $Lnum "scrInf,"]] != $g(COUNT)} {incr i} lassign $g(scrInf,[set hID [hunk-id $i DIFF]]) {*}$g(LR,$side) } else {lassign { 0 0 0 0 "" 0 0 "" } {*}$g(LR,$side) } # When a 3way is active, it REQUIRES a per-line 'ancestral' mapping # (so figure out where to START that mapping as well) if {$g(is3way)} { set anc(max) [llength $g(d3$side)] set anc(ndx) [rngeSrch d3$side [expr {$Lnum - $Ofst}]] if {$anc(ndx) < $anc(max)} {lassign \ [lindex $g(d3$side) $anc(ndx)] anc(fst) anc(lst) anc(mrk) } else { lassign {0 0 " "} anc(fst) anc(lst) anc(mrk) } } # Map/plot Lnums, advancing as needed through any mapping entries. # Line number translation consists of USING variables already set but # WATCHING for when to ADVANCE to the next sequential mapping entry. # (PRESUMES the canvas & text widgets are physically aligned!!) # Stops when we walk beyond the visible range of the Text widget lines, # -OR- we discover the EXTRA "last line" at the bottom of the widget set LastLnum [file rootname [$w(${side}Text) index end-1lines]] while {[llength [set dline [$w(${side}Text) dlineinfo $Lnum.0]]] > 0} { if {$Lnum == $LastLnum} {break} ;# ignore extra last line # Waterfall test detects phase of WHAT plots WITHIN a hunk boundary # and establishes which tag-derived display attribute group to use # (NB. purely Pad'ded lines always skip plotting altogether) if {$i > 0 && $Lnum >= $Snum} { if {$Lnum > ($Enum - $Pad)} { if {$Lnum > $Enum} { if {$i < $g(COUNT)} { # Step forward to the next hunk mapping # loading the NEXT scrInf,* entry settings set hID [hunk-id [incr i] DIFF] lassign $g(scrInf,$hID) {*}$g(LR,$side) if {[info exists g(overlap$hID)]} {set Cbar "?"} # Restart loop if 'Lnum' is NOW INSIDE the params # of the newly read-in hunk (to support abutted # hunks created by the Split/Combine feature) if {$Lnum >= $Snum} continue # Special fixup needed when FINAL hunk had padding } elseif {$Pad} {incr Ofst $Pad; set Pad 0 } set CB false ; set aNewGRP "t" ;# Is beyond entry } else { incr Lnum ; continue } ;# A PADDING line } else { set CB $opts(showcbs) ;# A DIFFed line set aNewGRP [expr {$i==$gPos ? "tdc$Cbar":"td$Cbar"}]} } else {set CB false ; set aNewGRP "t" } ;# Is before entry # Instantiate correct 'tag' attribute group (if it changed) if {"$aNewGRP" != "$aGRP"} { lassign $attr([set aGRP $aNewGRP]) Fnt Asc Hgt Fg Bg } # We want to plot on the same BASELINE as the text widget, but it # must be EMULATED as canvas '-anchor' provides NO SUCH setting. lassign $dline na y na na bl ;# extract TxT y and baseline incr y $bl ;# move y to its baseline then UP by the incr y -$Asc ;# "plot font" ascent (=eff. NE/NW edge) # FINALLY plot THIS Lnum and/or ChgBar per the CURRENT options # Do ChgBars 1st (more often skipped), with NW-corner as locpt. # Subsequent Linenumber will uses NE-corner at the SAME locpt. # (Annoyingly, canvas text has NO "Bg"-cell - must emulate!) # Weird flipping of colors just mimics the way tags were APPLIED # when this was all done in a Text widget (as of TkDiff 4.2) if {$CB && "$Cbar" != ""} { # Highlight Chgbars ? (i.e. colored Bg or Fg) if {$opts(tagcbs)} { if {$opts(colorcbs)} { switch -- $Cbar { "!" - "?" { set Cfg [set Cbg $opts(mapchg)] } "+" { set Cfg $opts(mapdel) ; set Cbg $opts(mapins) } "-" { set Cfg $opts(mapins) ; set Cbg $opts(mapdel) } } } else { lassign "$Fg $Bg" Cfg Cbg } # Make/plot a fontsized ChangeBar "background rect" set yy $Hgt set Dims [list $g(scrInf,tX) $y $g(scrInf,XX) [incr yy $y]] $w(${side}Info) create rect $Dims -fill $Cbg -outline $Cbg } else { set Cfg $Fg } $w(${side}Info) create text $g(scrInf,tX) $y -anchor nw \ -fill $Cfg -font $Fnt -text " $Cbar" } if {$opts(showln)} { # Highlight LineNum ? if {$opts(tagln) && "$Cbar" != ""} { # Make/plot a fontsized Lnum "background rect" if {$g(is3way)} { set xx [lindex $g(scrInf,cfg) 3] ;# ancestral mark ofst } { set xx 0 } set yy $Hgt set Dims [list $g(scrInf,tX) $y [incr xx] [incr yy $y]] $w(${side}Info) create rect $Dims -fill $Bg -outline $Bg } $w(${side}Info) create text $g(scrInf,tX) $y -anchor ne \ -fill $Fg -font $Fnt -text "[expr {$Lnum - $Ofst}]" } # Insert the 'ancestral' marker if a 3way is in progress # (and we haven't walked off the list of markers altogether) if {$g(is3way) && $anc(ndx) < $anc(max) \ && ($Lnum - $Ofst) >= $anc(fst) && ($Lnum - $Ofst) <= $anc(lst)} { # Markers generated from OTHER side display in inverse video, # thus make/plot a fontsized marker "background rect" if {[string is upper $anc(mrk)]} { set xx [lindex $g(scrInf,cfg) 3] ;# ancestral mark width set yy $Hgt set Dims [list 1 $y $xx [incr yy $y]] $w(${side}Info) create rect $Dims -fill $Fg -outline $Fg set Fg3 $Bg; # (which forces us to flip the text color) } else { set Fg3 $Fg } $w(${side}Info) create text 1 $y -anchor nw \ -fill $Fg3 -font $Fnt -text $anc(mrk) # Step map forward to next triplet (when 'last' has been used) if {$anc(lst) == $Lnum - $Ofst} { lassign [lindex $g(d3$side) [incr anc(ndx)]] \ anc(fst) anc(lst) anc(mrk) } } incr Lnum } } } ############################################################################### # Split file containing CVS (or other?) conflict markers into 2 (3?) tmp files # name Name of input file containing conflict markers # ndx Highest CURRENT finfo indice (entries added here must be higher) # whose optional identity Augmentation (eg. the SCM it came from?) # # N.B> Its possible a THIRD file (an ancestor) may be seen in the input format # (file+marker syntax is as produced by 'diff3 -m Mine [Ancestor] Theirs') ############################################################################### proc split-conflictfile {name ndx {whose {}}} { global g finfo if {[catch {set input [open $name r]}]} { fatal-error "Couldn't open file '$name'" } # Must derive the SPECIFIC finfo indices we plan to populate # (due to the processing technique being a parallel, NOT sequential one) # ie. 'L'eft 'R'ight (and 'A'ncestor when needed) set R 1 set A [expr {[incr R [set L [incr ndx]]] / 2}] # Initialize the files/streams/names/flags to start (beyond 1st 4 - empty!) # # N.B> CANT create finfo(albl,$ndx) until data is SEEN (it triggers 3way!) lassign "7 [open [set finfo(pth,$L) [tmpfile cf1]] w] \ [open [set finfo(pth,$R) [tmpfile cf2]] w] \ [open [set finfo(apth,$A) [tmpfile cfa]] w]" \ out f1 f2 fa Re1 finfo(atmp,$A) \ finfo(lbl,$L) finfo(tmp,$L) finfo(lbl,$R) finfo(tmp,$R) # Read/copy input into 'out' files as directed by embedded markers while {[gets $input line] >= 0} { # The FIRST marker tells us whose marking FORMAT to follow if {$Re1 == ""} { if {[regexp {^<<<<<<<* +} $line]} { # This maps 'diff3-like' merge markers set Re1 {^<<<<<<<* +(.*)} set Re2 {^=======*} set Re3 {^>>>>>>>* +(.*)} set Re4 {^\|\|\|\|\|\|\|* +(.*)} } elseif {[regexp {^>>>>>>>* +} $line]} { # This maps ??WHOSE?? markers # (and why did they invent their OWN?) # (***Pls ADD identifying comment!!***) set Re1 {^>>>>>>>* +(.*)} set Re2 {^<<<<<<<* +(.*)} set Re3 {^=======*} set Re4 {^\|\|\|\|\|\|\|* +(.*)} } } # Dont bother with matching until we find the first marker if {$Re1 != ""} { if {[regexp $Re1 $line na name]} { # First Marker: following data was from SECOND file if {$finfo(lbl,$R) == "" && $name != ""} { set finfo(lbl,$R) "[shortNm $name] ($whose Cflct)" } set out 2 } elseif {[regexp $Re2 $line na name]} { # Second Marker: following data was from FIRST file if {$finfo(lbl,$L) == "" && $name != ""} { set finfo(lbl,$L) "[shortNm $name] ($whose Cflct)" } set out 1 } elseif {[regexp $Re3 $line na name]} { # Third Marker: following data is COMMON to ALL files if {$finfo(lbl,$L) == "" && $name != ""} { set finfo(lbl,$L) "[shortNm $name] ($whose Cflct)" } set out 7 # FINDING the 4th Marker indicates there WAS an Ancestor!! } elseif {[regexp $Re4 $line all name]} { # Fourth Marker: following data was from Ancestor file if {![info exists finfo(albl,$A)] && "$name" != ""} { set finfo(albl,$A) "[shortNm $name] ($whose Cflct)" } set out 4 } else { if {$out & 1} { puts $f1 $line } if {$out & 2} { puts $f2 $line } if {$out & 4} { puts $fa $line } } } else { puts $f1 $line puts $f2 $line puts $fa $line } } close $input close $f1 close $f2 close $fa # If for some reason no names were detected, invent SOMETHING ... # N.B> Existence of an Ancestor is IMPLICIT within the data if {$finfo(lbl,$L) == ""} {set finfo(lbl,$L) "theirs ($whose Cflct)"} if {$finfo(lbl,$R) == ""} {set finfo(lbl,$R) "ours ($whose Cflct)"} # Cleanup & return highest indice used (Ancestors NEVER get counted) if {![info exists finfo(albl,$ndx)]} {array unset finfo "a\[pt]*,$A"} return $R } ############################################################################### # Derive list SrcCodeManagement systems that seem VALID for given dir/file/URL # (N.B> dir/file candidates that DONT EXIST will SKIP choices that require it) ############################################################################### proc scm-detect {fn {extra {}}} { regsub -all {\$} $fn {\$} fn ;# (Backslash any '$' ciphers as literal) # Use dirname OF argument if it is not a directory already # (N.B> isdirectory & dirname are tilde-safe - no thrown errors) if {[file isdirectory $fn]} {set dnam $fn} {set dnam [file dirname $fn]} # There are basically FOUR 'possibilities' for detection: # 1 those determined by the naming of the file (or its directory) # 2 those that require some ADJOINING file structure naming # 3 those requiring external-executables to be invoked # 4 those that depend on existance of certain ENV variables # ### (unknown if a better order exists: one below is purely historical) ### *My* gut feeling is the precedence described above should be followed ### (which is NOT completely the case as it exists here) however, as some ### cases are combo/subsets of others there is plenty of room for debate. # # In any event, this is now a voting process (former if-else chain) where # the user gets to pre-state their choice PROVIDED its an allowed one. lappend scms if {[file isdirectory [file join $dnam CVS]]} { lappend scms CVS } if {[is-repo-dir ".svn" $dnam]} { lappend scms SVN } if {[is-repo-git]} { lappend scms GIT } if {[string match {*://*} $fn]} { lappend scms SVN } if {[sccs-is-bk]} { lappend scms BK } if {[file isdirectory [file join $dnam SCCS]]} { lappend scms SCCS } if {[file isdirectory [file join $dnam RCS]]} { lappend scms RCS } if {[file isfile $fn,v]} { lappend scms RCS } if {[file exists [file join $dnam vcs.cfg]] || \ [info exists ::env(VCSCFG)]} { lappend scms PVCS } if {[info exists ::env(P4CLIENT)] || \ [info exists ::env(P4CONFIG)]} { lappend scms Perforce } if {[info exists ::env(ACCUREV_BIN)]} { lappend scms Accurev } if {[info exists ::env(CLEARCASE_ROOT)]} { lappend scms ClearCase } if {[is-repo-dir ".hg" $dnam]} { lappend scms HG } if {[is-vpath $dnam]} { lappend scms Vpath } # We occasionally need to ADD a 'pseudo SCM' to the end of a NONEMPTY list if {$extra != "" && [llength $scms]} {lappend scms $extra} return $scms } ############################################################################### # Scm-detect HELPER Fcn (attempts file normalize on dirname that MAY NOT exist) ############################################################################### proc is-repo-dir {trgnam dirname} { # check for targnam directory in all parent directories # (N.B> impossible if dirname itself doesnt exist) if {[catch {file normalize $dirname} dirname]} { return false } set prevdir {} while {$dirname != $prevdir} { set chkDnam [file join $dirname $trgnam] if {[file isdirectory $chkDnam]} { return true } set prevdir $dirname set dirname [file dirname $dirname] } return false } ############################################################################### # Scm Detect HELPER Fcn (runs Git provided command to determine ?CWD? location? ############################################################################### proc is-repo-git {} { return [expr [catch {eval "exec git rev-parse --is-inside-work-tree"}] ==0] } ############################################################################### # Scm Detect HELPER Fcn Returns: # =0 if finfo(Vpath) was never loaded from a missing VPATH EnvVar at startup # =0 if arg is not prefixed by ANY of the VPATH list elements of finfo(Vpath) # OTHERWISE which element (1->N) matched (note: this is +1 of its index value) ############################################################################### proc is-vpath {dnam} { global finfo # When finfo(Vpath) was never loaded, answer is NO if {[info exists finfo(Vpath)]} { # But we also need to know if the directory of the targeted filename # is fully WITHIN at least ONE of the elements of that VPATH. # N.B> VPATHs are expected to be ABS-paths, so normalize input first if {[catch {file normalize $dnam} dnam]} { return 0 } foreach vp $finfo(Vpath) { if {[incr ndx] && [string equal -length [string length $vp] $vp $dnam]} { return $ndx } } } return 0 } ############################################################################### # Scm Detect HELPER Fcn Returns: truth of BitKeeper ?presence? ############################################################################### proc sccs-is-bk {} { set cmd [auto_execok "bk"] set result 0 if {[string length $cmd] > 0} { if {![catch {exec bk root} error]} { set result 1 } } return $result } ############################################################################### # Decide which Src Code Managment system is expected to obtain the current file ############################################################################### proc scm-elect {scms vote} { Dbg {Elect Candidates($scms) Vote($vote) for [info level -1]} -1 # Simply apply the users vote # N.B> This makes it APPEAR that either SCM meta-value (Auto or None) # always results in just TAKING the top entry - the trick is that when # 'scms' was setup by 'newDiff' it likely CONTAINS 'None' as a # candidate value, making it electable here, based on the 'vote' # This allows the caller to recognize that access was BLOCKed not MISSING if {$vote in $scms} {return $vote ;# new democratic way ...user choice } else {return [lindex $scms 0]} ;#ye olde way...1st found } ############################################################################### # Obtain a revision of a file: # fn requested file name # ndx index in finfo array to place data ('-ndx' implies Ancestor naming) # rev "" implies SCM will use ITS default (generally 'most recent') # Scm if !Null, which SCM to use (avoids lookup) # probe when true - non-existance is NOT a reason to fail # Returns 0 (Success) or 1 (Failed + diagnostic messages produced) ############################################################################### proc get-file-rev {fn ndx {rev ""} {Scm {}} {probe 0}} { global g opts finfo tcl_platform # First, some simple initializations common to ALL regsub -all {\$} $fn {\$} fn ;# (Ensure any '$' ciphers remain literal) set cmdsfx "" ;# To prevent 'exec'-spoofing on Windows platform(?) if {$tcl_platform(platform) == "windows"} { set cmdsfx ".exe" } # Ancestor files are stored into a slightly adjusted array element name # N.B> 'ndx' AS PASSED *can* be an EXPRESSION (not just a number): resolve! if {($ndx) < 0} { set A "a"; set ndx [expr {-1 * ($ndx)}] } { set A ""; set ndx [expr $ndx] } # PRESUME eventual success ... **THEN** ... set MSG [set msg {}] set stillbad 0 # (Dbl-Check file existence - But MUST let URL thru: *IS* no way to Chk) if {![string match {*://*} $fn] && ![file exists $fn]} { set stillbad 1 } # ... DETECT and FORMULATE the appropriate SCM command to request the file # (if one was not already pre-selected as a parameter) # N.B> The 'None' choice is PRESERVED when it was originally present if {"" == $Scm} { set Scm [expr {!($ndx & 1)}] ;# Get from the correct side set ScmVote [lindex $g(scmPrefer) $Scm] ;# obtain CURRENT preference set Scm [expr {"None" in $finfo(scm[incr Scm])? "None" : ""}] ;# None? set Scm [scm-elect [scm-detect $fn $Scm] $ScmVote] } # HOWEVER - only SVN will handle a URL; report instead when SCM cant # -UNLESS- its not URL/SVN at all and filename DOESNT EXIST if {$Scm == "SVN" || !$stillbad} { switch -- $Scm { CVS { append cmd "cvs" $cmdsfx if {[set lbl $rev]!=""} { set rev "-r $lbl"} { set rev "-r [set lbl "HEAD"]" } # For CVS, if it isn't checked out, there is neither a CVS nor RCS # directory. It will however have a ,v suffix just like rcs. # (There is not necessarily a RCS directory for RCS, either...) # (however, if not, then the file will ALWAYS have a ,v suffix.) set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd update -p $rev \"$fn\"" } SVN { append cmd "svn" $cmdsfx if {[set lbl $rev]!=""} { set rev "-r $lbl" # ??? SVN is WEIRD - has multiple Rev formats but ALLOWS only # HEAD if the FSpec is a URL ?? Expect SVN errors to occur!! } elseif {[string match {*://*} "$fn"]} { set rev "-r [set lbl "HEAD"]" } { set rev "-r [set lbl "BASE"]" } # Subversion directly ALLOWS a URL instead of a true filename set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd cat $rev \"$fn\"" } GIT { if {[is-repo-git]} { # Only works if you are actually INSIDE the work tree append cmd "git" $cmdsfx; # Default revision is the 'stage' if {[set lbl $rev]==" " || $rev==""} { set lbl "--staged" ; set rev ":"} {set rev "$rev:"} set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) \ "$cmd show \"$rev[exec $cmd rev-parse --show-prefix]$fn\"" } {set MSG "Please re-start from within a Git work tree."} } BK { append cmd "bk" $cmdsfx if {[set lbl $rev]!=""} { set rev "-r$lbl"} { set rev "-r[set lbl "HEAD"]" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd get -p $rev \"$fn\"" } SCCS { append cmd "sccs" $cmdsfx if {[set lbl $rev]!=""} { set rev "-r$lbl"} { set rev "-r[set lbl "HEAD"]" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd get -p $rev \"$fn\"" } RCS { append cmd "co" $cmdsfx if {[set lbl $rev]==""} {set lbl "HEAD"} set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd -p$rev \"$fn\"" } PVCS { append cmd "get" $cmdsfx if {[set lbl $rev]!=""} { set rev "-r$lbl"} { set rev "-r[set lbl "HEAD"]" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd -p $rev \"$fn\"" set finfo(${A}pproc,$ndx) "filterCRCRLF" } Perforce { append cmd "p4" $cmdsfx if {[set lbl $rev]!=""} { set rev "#$lbl"} { set rev "#[set lbl "HEAD"]" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd print -q \"${fn}$rev\"" } Accurev { append cmd "accurev" $cmdsfx if {[set lbl $rev]!=""} { set rev "-v \"$lbl\""} { set rev "-v \"[set lbl "HEAD"]\"" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd cat $rev \"$fn\"" } ClearCase { set cmd "cleartool" # is this NOT a Windows tool (why no append of .exe?) # list given file Dbg {exec $cmd ls -s \"$fn\"} catch {exec $cmd ls -s \"$fn\"} ctls # get the path name to file AND its (present?) revision info # (either CHECKEDOUT or a number) if {![regexp {(\S+)/([^/]+)$} $ctls na path checkedout]} { set MSG "Couldn't parse ct ls output '$ctls'" break } # Compute the version PRIOR to the one FOUND if {$checkedout == "CHECKEDOUT" || $checkedout == 0} { if {$checkedout == 0} { set path [file dirname $path] } set pattern "create version \"($path/\[^/\]+)\"" } else { incr checkedout -1 set pattern "create version \"($path/$checkedout)\"" } # Search history of the file for the determined version on our branch Dbg {exec $cmd lshistory -last 50 \"$fn\"} catch {exec $cmd lshistory -last 50 \"$fn\"} ctlshistory set lines [split $ctlshistory "\n"] set prior "" foreach line $lines { if {[regexp $pattern $line na prior]} { # Point DIRECTLY at the requested file # However, make it APPEAR like it IS a tmpfile # (so we will deny invoking an editor later) set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $prior)" set finfo(${A}pth,$ndx) $prior set finfo(${A}tmp,$ndx) "" break } } if {$prior == ""} {set MSG "Couldn't resolve $fn, gave up..."} } HG { append cmd "hg" $cmdsfx; # Mercurial support if {[set lbl $rev]!=""} { set rev "-r$lbl"} { set rev "-r[set lbl "PARENT"]" } set finfo(${A}lbl,$ndx) "[shortNm $fn] ($Scm $lbl)" set finfo(${A}tmp,$ndx) "$cmd cat $rev \"$fn\"" } Vpath { # Has no 'access' cmd: files simply EXIST (or not) in stacked dirs # The supplied 'rev' value says which GENERATION of the file to get: # ZERO is topmost (and the default), ONE is PRIOR-to topmost # N.B> finfo(Vpath) was ALREADY top-pruned (by CWD) as needed set vp $finfo(Vpofst) ;# But report Vpath depth as per original VPATH if {("$rev"!={} && $rev) || $vp} { set lbl "Prior" } { set lbl Topmost set rev 0 } # Absolute files are PREFIX-matched to identify which node if {[string index $fn 0]=="/" && [file exists $fn]} { foreach vNod $finfo(Vpath) { if {[incr vp] && [string first $vNod/ $fn]} { if {$rev} { incr rev -1 } { set finfo(${A}lbl,$ndx) "[shortNm $fn] (${Scm}(#$vp)-$lbl)" set finfo(${A}pth,$ndx) $fn if {$vp} { set finfo(${A}tmp,$ndx) "" } break } } }} else { # Relative files are POSTFIX-joined to identify which node foreach vNod $finfo(Vpath) { if {[incr vp] && [file exists $vNod/$fn]} { if {$rev} { incr rev -1 } { set finfo(${A}lbl,$ndx) "[shortNm $fn] (${Scm}(#$vp)-$lbl)" set finfo(${A}pth,$ndx) [file join $vNod $fn] # Make it THINK its a tmpfile if its DOWN the Vpath if {$vp > 1} { set finfo(${A}tmp,$ndx) "" } break }} } } if {![info exists finfo(${A}pth,$ndx)]} { # Error report depends on whether this was a PROBED request, # yet we must STILL pass back a failed-RC if probe is active if {$probe} { set stillbad 1 } { set msg "$lbl Vpath entry for $fn does not exist" } } } None { set msg "Did your preferred SCM system ($Scm) block file:\n" append msg " $fn\nfrom its intended SCM repository?" } default {if {$probe} { set stillbad 1 } { # ... but DONT FLAG non-existence, if it was NOT required... set msg "File '$fn' is not part of a revision control system" } } }} elseif {stillbad} { set msg "File '$fn' does not appear to EXIST?" } { set msg "$Scm does not accept URL-based File specifications" } # Note label for this file WILL BE overridden (just NOT here, not NOW) if {[info exists finfo(ulbl,$ndx)] && $finfo(ulbl,$ndx) != {}} { Dbg { User label: $finfo(ulbl,$ndx) OVERRIDES finfo(lbl,$ndx)} } # If NO errs (and in 1st pairing) NOW is the time to actually GET the file # (even that of an ancestorfile if its required) # N.B> Oddball reason NOT to is if its a Vpath'd file IN the TOP node... # which means its just THERE (and edittable - NO finfo(tmp,*) !! if {![string length "$MSG$msg"] && !$stillbad && $ndx < ("$A"=="" ? 3:2) && [info exists finfo(${A}tmp,$ndx)] && [string length $finfo(${A}tmp,$ndx)]} { watch-cursor "Accessing $finfo(${A}lbl,$ndx)" set MSG [scm-chkget ${A}$ndx] restore-cursor } # Report any errors (THIS GETS slightly INVOLVED): # We need to send back the message(s?) RESPONSIBLE for the RetCode - # but the CALLER has the job of sorting out what to DO with them if {[string length "$MSG$msg"] || $stillbad} { if {"$msg" != ""} { uplevel 1 set msg "{$msg}" } if {"$MSG" != ""} { uplevel 1 set MSG "{$MSG}" } return 1 } { return 0 } } ############################################################################### # Obtain an ordinary file # fn requested file name # ndx finfo array index to place data ('-' ndx implies Ancestor naming) # probe a probed request ALLOWS non-existence to be considered successfull # Returns: 0 Success (WITH NO observable message activity) # 1 Failed (PLUS a 'pushed' HARD-error message to the caller) # (N.B> will reject a URL w/'not exist' IFF asked [2Fspec+0Rev] seems possible) ############################################################################### proc get-file {fn ndx {probe 0}} { global g opts finfo # Ancestor files are stored into a slightly adjusted array element name # N.B> 'ndx' AS PASSED *can* be an EXPRESSION (not just a number): resolve! if {($ndx) < 0} { set A "a"; set ndx [expr {-1 * ($ndx)}] } { set A ""; set ndx [expr $ndx]} # Verify filename actually exists BEFORE aaking more questions # (NO callers EXPECTED to ask for a default-Rev URL - it simply rejects) set MSG {} if {![file exists $fn]} { # But DO NOT REPORT non-existence if this attempt was ONLY a probe if {$probe} { return 1 } { set MSG "File '$fn' does not exist" } } elseif {[file isfile $fn] || $fn == $opts(NULLdev)} { set finfo(${A}lbl,$ndx) [shortNm [set finfo(${A}pth,$ndx) "$fn"]] } else { set MSG "'$fn' exists, but is not a file" } # Messaging is PUSHED back to caller (so a BOOLEAN can be returned) if {$MSG!={}} { uplevel 1 set MSG "{$MSG}" return 1 } return 0 } ############################################################################### # Read the command line (syntactic errors MAY result in usage + termination) # Returns: =0 incomplete (requires interactive assistance OR SCM search mode) # >0 success (enough info SUPPLIED for at least 1 pairing to exist) # <0 File was found to not exist (also needs interactive assistance) ############################################################################### proc CmdLn {} { global g opts finfo argv argc # Initialize: N.B> Ancestor data is NEVER 'counted' lassign "[llength $opts(ignoreRegexLnopt)] {} 0 0 0 0 0"\ ignRxs missing ARGi lbls URLs pths revs set D -1 ;# Local-master Dbg switch within this proc # Loop through argv, storing revision args in finfo(rev,[12]) and # filespec args in finfo(f,[12]). revs and pths are counters. # N.B> 'URLs' as a LOCAL variable serves a different purpose in EACH proc # you find it in: here it counts URLs that LACK a SPECIFIC Rev; # Other procs simply use it (locally) for THEIR distinctive purposes. while {$ARGi < $argc} { Dbg "Examining arg #${ARGi}([set arg [lindex $argv $ARGi]])" 0 "CmdLn: " switch -regexp -- $arg { "^-h" - "^--help" { help-concept cline exit 0 } "^-d.*" { # ::DbuG Specs previoulsy acummulated and/or Dbg activated } {^-@.*$} { # First, de-tangle the option value from the option flag # to get just the Ancestor Rev data if {[string length $arg] > 2} { set rev [string range $arg 2 end]} { set rev [lindex $argv [incr ARGi]] } # First to set this locks it in place, EXCEPT for a URL@Rev if {$finfo(rev,0) == ""} {set finfo(rev,0) $rev} } {^-[vr].*$} { # All 'rev' option(s) are ganged together here to share logic: # Cant just 'count and store' because it MAY be INTENDED to # backfill a PRE-existing URL Fspec that lacked specific # Rev data (using the pairing-of-args rules); Yet URLS only # count @Rev instances, merges thus just 'happen' # First, de-tangle the option value from the option flag if {[string length $arg] > 2} { set rev [string range $arg 2 end]} { set rev [lindex $argv [incr ARGi]] } # Might THIS Rev PAIR with a PRIOR default-versioned URL? # # + Rev(s) CLAIM to exist (but COULD be URL-paired) # then + 2 Fspecs exist (need to check 1st one) if {$pths && [set i [min $revs 2]] && (($i == 2 && [string match {*://*} $finfo(f,2)]) || ($i == 1 && [string match {*://*} $finfo(f,1)]))} { if {$finfo(rev,$i) != ""} { set i [incr revs] } } { set i [incr revs] } Dbg "Rev,$i <- ($rev) revs($revs)" $D "CLI\t:" # PERMIT up to the 1st two Revs; though errors may COUNT more if {$i < 3} {set finfo(rev,$i) $rev} } "^-L$" { set finfo(ulbl,[incr lbls]) [lindex $argv [incr ARGi]] } "^-L.*" { set finfo(ulbl,[incr lbls]) [string range $arg 2 end] } "^-conflict$" { set g(conflictset) 1 } "^-o$" { set g(mergefile) [lindex $argv [incr ARGi]] } "^-o.*" { set g(mergefile) [string range $arg 2 end] } "^-u$" { # Ignore flag generated from "svn diff --diff-cmd=tkdiff" } "^-B$" { set opts(ignoreEmptyLn) 8 } "^-I$" { lappend opts(ignoreRegexLnopt) [lindex $argv [incr ARGi]] } "^-I.*" { lappend opts(ignoreRegexLnopt) [string range $arg 2 end] } {^-[12]$} { set opts(predomMrg) [string range $arg end end] } "^-psn" { # Ignore the Carbon Process Serial Number set argv [lreplace $argv $ARGi $ARGi] incr argc -1 incr ARGi } {^-R$} { # Authorize recursion when TWO directories are specified set finfo(fRecurs) 1 } "^-P$" { # Step PAST the Preference filename (we grabbed it already) # IFF that is what it was - otherwise it is an actual DIFF arg # (depends on Preferences LOCATION being a Dir, or not) if {[info exists g(rcdir)]} { incr ARGi } { append opts(diffcmd) " " [concat "$arg"] } } "^-P.*" { # User NAMED (and we already grabbed) the Preference filename # (just swallow it - CANT be the Diff arg; there IS a value!) } "^-" { # Args not otherwise recognized are passed to Diff directly # (WRONG if it was SUPPOSED to grab NEXT item as its VALUE) append opts(diffcmd) " " [concat "$arg"] } {^-a.*$} - default { # ALL input fnames come through here (in particular: Ancestor) # # First, de-tangle any option value from the option flag # (if it even HAD one - only the Ancestor filespec will) # establishing slot index and counts, (NEVER count an Ancestor!) if {$arg == "-a"} { set N 0 ; set path [lindex $argv [incr ARGi]] } elseif {[string match {-a*} $arg]} { set N 0 ; set path [string range $arg 2 end] } { set N [incr pths] ; set path $arg } # Wow - this is gonna be convoluted - NEED to KNOW if its a URL # even though we might never use IT (or its Rev) *IFF* ... # the COUNTS have exceeded the upper-limit of TWO! # ALL just to report a SYNTAX ERROR correctly! # Identify if its REALLY a URL (SVN based syntax) # A URL is effectively a Rev, DESPITE any un-specified @Rev! # (due to implying its own inherent default value) if {[string match {*://*} $path]} { Dbg "IS a URL" $D "CLI\t:" # If URL has a @Rev attached, will need to STRIP+RELOCATE it # unless its an attempted 2nd Ancestor (-> simply ignored) # (but ensure 'rev' is ALWAYS initialized) if {([set rev ""]=="") && ($N || $finfo(f,$N) == "") && [set at [string last "@\{" $path]] > 0 || ([set at [string last "@" $path]] > 0 && [string first "/" $path $at] < 0)} { # SPLIT them and GRAB EACH individually set rev [string range $path $at+1 end ] set path [string range $path 0 $at-1] Dbg "WITH an @Rev($rev)" $D "CLI\t:" } { Dbg "with NO @Rev supplied" $D "CLI\t:"} # Regardless, count it WAS a URL *UNLESS* # it was an Ancestor (which is NEVER counted) if {$N} { incr URLs } # Next, deal with Rev COUNTING (ie. 'revs'): # Rev Slot(N) may've been preloaded (-r) earlier thus can # MERGE w/Fspec(N) IFF 'rev' is EMPTY w/NO revs incr if {$rev!=""} { # Shift POSSIBLE PRE-enterred Rev1 upward # (N.B> *MAY* be moving nothing at all !!) if {$N==1} { set info(rev,2) $finfo(rev,1) } # SPECIFIED Rev goes into same slot as URL will if {$N < 3} { set finfo(rev,$N) "$rev" } incr revs } # Else URL will MERGE with PRIOR "-rRev" (or just BE empty) # Sadly - pretend URL exists ... (CANT PROVE otherwise) set fexist 1 Dbg "PLACED AS Rev,$N w/RevCount($revs)" $D "CLI\t:" # else its a plain FILE Fspec: But verify tilde+Glob was HANDLED # (ordinarily done by SHELL already - but if was QUOTED? ) } elseif {$N>2 || [tildChk $path fexist path] || $fexist != 1} { Dbg "IS a FILE for (f,$N) marked as non-exist" $D "CLI\t:" # HAH - caught you!! Forget the msg, just deal w/existence set fexist 0 # else SAFELY expand any POTENTIAL Glob-syntax into REAL NAME } { set path [glob -n $path] } # But if FILE (not URL) actually wont exist, TkDiff needs the # USER to Repair/Retry again. Arrange to make RetCode NEGATIVE if {$N<3 && !$fexist} { set missing "-" } { Dbg "for (f,$N)<-($path) w/NO ERROR" $D "CLI\t:" } # PERMIT up to the 1st two Fspecs; though more COUNT as errors # (N.B> Yes - Ancestor still gets here BECAUSE it isnt counted) if {$pths < 3} { set finfo(f,$N) $path } { Dbg "Rejected for slot f,$N" $D "CLI\t:" } } } incr ARGi } # Check for an OVERFLOW of revision and/or file args provided # (Basic command line SYNTAX mistakes made) Dbg "Syntax CHK: $pths filespecs($URLs URLs), $revs revisions" if {$revs > 2 || $pths > 2} { if {$pths > 2} { puts stderr "$g(name): Error: specify at most 2 filespecs" } if {$revs > 2} { puts stderr "$g(name): Error: specify at most 2 revisions" } help-concept cline exit 1 } # Underflow is trickier - ZERO Fspecs *may* be legal given an appropriate # CWD and compliant SCM. Even ZERO revs can be OK IF the user permitted it # # Basically this is all about AVOIDING "newDiff" (IFF requested) # when ZERO Fspec args (and POSSIBLY zero Revs) have been provided set g(scmDOsrch) 0 set g(scmPrefer) "$opts(scmPrefer)" ;# <-- Make the default 'active' if {!$pths} { # The automatic way out is a SINGLE, preferred, searchable SCM, with # either given Revs, -OR- the users REQUEST that searching is desired. # Otherwise it all loads into the dialog and the user can handle it # N.B> do not simplify logic: 'scmDOsrch' is NEEDED by 'assemble-args' # First, resolve which SIDE may have a viable SCM (if any) set scms [scm-detect "."] ;# (need only 'detect' once w/CWD for both) if {[set finfo(scm1) [scm-elect "$scms" [lindex $g(scmPrefer) 0]]] \ in $g(scmSrch)} {incr g(scmDOsrch) 1} if {[set finfo(scm2) [scm-elect "$scms" [lindex $g(scmPrefer) 1]]] \ in $g(scmSrch)} {incr g(scmDOsrch) 2} # Finally - check if we now have a DEFINITIVE choice ... # (if both SCMs are the same, it counts as just one) if {$g(scmDOsrch) != 3 \ || ("$finfo(scm1)" == "$finfo(scm2)" && [incr g(scmDOsrch) -1])} { # ... (and the Revs -OR- users OK to just go DO it) if {$g(scmDOsrch) && $opts(autoSrch) && !$revs} { incr revs ;# go STRAIGHT to processing (no dialog) } } # If revs is ALSO ZERO here, newDiff dialog will be presented next #Dbg "DOsrch($g(scmDOsrch)) skipdialog($revs)" } # Notice and act upon certain imperative settings: # - mark merge file as INITIALLY known (thus triggering the merge window) # - turn on Regex line skipping *if* it was added here (else its a pref) if {$g(mergefile) != ""} {set g(mergefileset) 1} if {$ignRxs < [llength $opts(ignoreRegexLnopt)]} {set opts(ignoreRegexLn) 4} return [expr "${missing}($revs + $pths)"] } ############################################################################### # Check provided filename to see if its leading portion can be SHORTENNED. # fn: candidate filename # tild: optional 2nd-choice value to replace HOME value with # DEFAULTS to tilde (but SHOULD be set to "" to prohibit 2nd choice) # (anything ELSE and it BEST NOT END with a SLASH!!) # # Intent is to produce shorter NAMES of filenames in things like: # menu-items, msgs and labels # RETURNS unchanged filename when modification(s) is not possible # # N.B> DO NOT USE if the return value COULD find its way to 'exec': # Invoked PGMs (notably Diff) DONT always natively accept 'tilde' names! ############################################################################### proc shortNm {fn {tild {~}}} { global env ;# Should NOT BE MEANS to OBTAIN users HOME location (spoofable) # Begin by trying to eliminate the current working directory from the name # N.B> +/- 1 ndx game and '/' avoids a potential home-dir SUBSET naming err set ndx [string length [set lead [pwd]]] if {[string equal -length [incr ndx] "$lead/" "$fn"]} { return "[string range "$fn" $ndx end]" # IFF that fails to MATCH, then try for replacing a lead $HOME with $tilde # UNLESS: env(HOME) doesnt EXIST -OR- callers prohibits it (tild=="") } elseif {[info exists env(HOME)] && [string length tild]} { set ndx [string length [set lead $env(HOME)]] if {[string equal -length [incr ndx] "$lead/" "$fn"]} { return "$tild[string range "$fn" [incr ndx -1] end]" } } # If NOTHING could be shortened - just return the ORIGINAL filename return "$fn" } ############################################################################### # Check if provided filename (NOT PATH) is on list of stated EXCLUSIONs ############################################################################### proc xclude { fn } { global opts set fn [file tail $fn] foreach x $opts(xcludeFils) { if {[string match $x $fn]} { return 1 } } return 0 } ############################################################################### # Process the arguments, whether from the command line or from the dialog # Returns: >1 success (= number of files that apparently exist) # (INCLUDES obtaining the first PAIR) # =1 failure (can not continue) # =0 ?successfully? produced nothing to compare... retry? ############################################################################### proc assemble-args {} { global g opts finfo set O([set O(2) 1]) 2;# (just a simple meta-pgm 'O'ther identity value) # RE-establish how many files and revs we got from the GUI or CmdLn # (An AncestorFile - finfo slot ZERO - is NEVER part of the count) # However, a URL must count as BOTH (even w/o a Rev - due to IMPLIED dflts) # N.B> 'URL' here tracks WHICH slot(s) (L=1/R=2) contain a URL Fspec lassign {0 0 0} URL revs pths foreach i [array names finfo {f,[12]}] { if {$finfo($i) != ""} { # This weirdness bumps the Rev cnt when a URL did NOT specify one # (because the ones that DID will be counted shortly) # and notes which slot (1, 2, or BOTH=3) a URL was enterred on if {[string match {*://*} $finfo($i)]} { if {$URL} {set URL 3} {set URL [string index $i end]} if {$finfo([string map {f rev} $i]) == ""} {incr revs} } incr pths } } foreach i [array names finfo {rev,[12]}] {if {$finfo($i)!=""} {incr revs} } # Save any current DERIVED values (in case NEWLY produced ones fail) set priorVals [array get finfo {[aptl]*[0-9]}] array unset finfo {[aptl]*[0-9]} Dbg " Recovered $pths filespecs, $revs revisions" # The task here is to deal with trying to expand all GIVEN args into PAIRS # of things to compare, thus validating *syntactically* what should happen. # Note that SEMANTIC correctness (can we actually OBTAIN what is described) # will (mostly) occur later. # Basic argument ASSUMPTIONs - # - when NO SCM is involved, only LOCAL files will participate, possibly # aggregated by involving a Directory as one/both of the Filespecs. # - when an SCM is needed (because one or more revisions exist), we 1st # PRESUME the OTHER FSPEC (if any) refers to a REAL (dir or file) # object which MAY be in the sandbox (or not), UNLESS its a URL. # - when only a single (or no) revision is provided, then some FILE (in # or out of the sandbox) will likely participate unless BOTH are URLs # - when TWO revs are given, NO FILES from the sandbox are used (except # for possible name generation); revisions ALWAYS create temp files # FROM the SCM, even if either were to MATCH that of the sandbox. # - finally, if NO ARGS are provided, CERTAIN capable SCM systems MAY # generate their OWN list of files AND revisions, PROVIDED the user # has authorized such action by SETTING the AutoSrch option. # Establish NAMED placeholders for messaging (MSG=BAD msg=recoverable) # NOTE: called fcns KNOW of these names and *may* load them independently # Also initialize count of how many IMPLIED files are ultimately derived # ...AND a marker that messaging WAS produced and MUST be evaluated set Why [set MSG [set msg {}]] set Err [set cnt 0] # A 'conflict' file is a special animal (1 file representing 1->3 files)! if {$g(conflictset)} { if {$revs == 0 && $pths == 1} { ################################################################# # tkdiff -conflict FILE (N.B> does NOT preclude a 3way) ################################################################# Dbg "Applying Pairing RECIPE: conflict file" # Conflict files can come from multiple SCM toolsets, or even a # 'diff3 -m Mine [Ancestor] Yours' command. The names entered # into finfo are DERIVED from embedded MARKER lines inside it # (while the CONTENT gets spread out into separate tmpfiles) set cnt [split-conflictfile "$finfo(f,1)" $cnt] } else { set Why "'-conflict' run can specify ONLY 1 filespec (we saw $pths)" set Err 1 } # Identify input PATTERN (#Fspecs and #Revs) and ASSEMBLE pairs from it } else { # DETERMINE the proper SCM(s) to request individual files (when needed) foreach N {1 2} { # ('shorten' the VARname(s) - conserves coding linespace later) set f($N) $finfo(f,$N) ; set r($N) $finfo(rev,$N) # VOTE which SCM to use (pths==0 uses a DIFFERENT Vote strategy) if {$N <= $pths} { # Yet, must treat NON-existent FILE as a reportable Warning? # (sadly dont KNOW how to do same for URL) # But even a non-file MIGHT choose a vaguely accurate SCM if {![string match {*://*} $f($N)] && ![file exists $f($N)]} { if {$Why == ""} { append Why "File(s) do not exist:" } append Why "\n\t'$f($N)" set Err 1 } set ScmVote [lindex $g(scmPrefer) $N-1] ;# obtain preference set Scm($N) [scm-elect [scm-detect $f($N) None] $ScmVote] # There CANT be a 2nd SCM if there ISNT a 2nd Fspec # (simply means BOTH Revs - if any - come from the SAME 1st SCM) } { set Scm($N) {} } # PAY ATTENTION: # *User provided* REV data is summarily REMOVED for "Vpath" - # (because no definitive Rev-ID actually exists) # THAT MEANS having to UN-count it (IFF was passed) but ALWAYS # writing it as REQUESTING the *appropriate* "latest" revision if {$Scm($N) == "Vpath" || $N == 2 && $Scm(1) == "Vpath" && $Scm(2) == ""} { if {$r($N) != ""} { incr revs -1 } set r($N) 0 ; # Generally we want the LATEST Vpath version # BUT - if a ONE-Fspec SCM comes up as Vpath, then the LEFT # side needs to be an EARLIER version than the one that will # show up for the RIGHT side; the TWO-Fspec format MUST NOT! # (must be ABLE to compare DISTINCT Fspecs that just *happen* # to fall within a common VPATH; even if resolved to SAME file) if {$N==2 && $Scm(2) == ""} { set r(1) 1 } } Dbg " f,${N}($f($N)) rev,${N}($r($N))" ;# ONLY ever ADJUSTS Vpath revs! } Dbg " PAIRing SCM info: SCM($Scm(1)/$Scm(2))" # UNLESS the input has been deemed UNUSABLE ... if {$Err} { set msg $Why # ... DERIVE the given input PATTERN into PAIRED file set(s) } elseif {$revs <= 2 && $pths == 0} { ################################################################# # tkdiff (inquiry or interactive) (simply NO input given) # -OR- # tkdiff -rREV ($CWD is) SCM sandbox # tkdiff -rREV1 -rREV2 (with 1 or 2 revisions) ################################################################# # Some SCMs can produce their OWN list of files 'known' to be # different; POSSIBLY with no input whatsoever. So detect the SCM # first, THEN (if it is one) let *it* try. All other cases lead # to error msgs (if revs were given). # Note that DETECTING the SCM was based on the current PROCESS dir # and that 'scmPrefer' used here is DERIVED from the preference # N.B> 'SScm' (Srch-SCM): so named to avoid array/scalar conflict if {$g(scmDOsrch)} { set SScm [lindex $g(scmPrefer) $g(scmDOsrch)-1] ;#VOTE first set SScm [scm-elect $finfo(scm$g(scmDOsrch)) $SScm];#then ELECT } else {set SScm [concat $g(scmPrefer)]};# <-- it WONT be searchable Dbg "Applying Pairing RECIPE: SCM-inquiry ($SScm)" switch -glob -- "$SScm" { GIT { # N.B: An input syntax of '-r ' (or '-r " "') is the Git Index if {$opts(autoSrch) || $g(scmDOsrch)} { if {[set cnt [inquire-git $revs]] & 1} { incr cnt -[set Err 1] } } else { set Err 1 set msg "You denied access for $SScm to search for files" } } SVN { if {$opts(autoSrch) || $g(scmDOsrch)} { # This could take some time, so let user know we are busy watch-cursor "Inquiring of SVN for files..." if {[set cnt [inquire-svn $revs]] & 1} { incr cnt -[set Err 1] } restore-cursor } else { set Err 1 set msg "You denied access for $SScm to search for files" } } CVS { if {$opts(autoSrch) || $g(scmDOsrch)} { # This could take some time, so let user know we are busy watch-cursor "Inquiring of CVS for files..." if {[set cnt [inquire-cvs $revs]] & 1} { incr cnt -[set Err 1] } restore-cursor } else { set Err 1 set msg "You denied access for $SScm to search for files" } } "* *" { set msg "no searchable SCM was detected/designated\n" if {([lindex $SScm 0]!= "" && [lindex $SScm 1]!= "") \ && ([lindex $SScm 0]!= "Auto" || [lindex $SScm 1]!= "Auto")} { append msg " were your SCM settings '$SScm' at fault ?" } set Err 1 } default { if {"$SScm" != "" } { set msg "the $SScm SCM system needs at least 1 Fspec given" } { set MSG "no SCM was detected for the current directory" } set Err 1 } } } elseif {$revs < 2 && $pths == 1} { ################################################################# # tkdiff FSPEC (file in, dir at, URL .vs.) SCM sandbox # tkdiff -rREV FSPEC with or without a revision) ################################################################# Dbg "Applying Pairing RECIPE: FSpec(1) Revs(0/1)" # URL 'side' is determined by which arg was first: Fspec or Rev # Any other arg syntax is ALWAYS Left =SCM(@REV) and Right =File if {$URL} { if {$r($URL) == $r($O($URL))} { set MSG "There is NO point in comparing a file to itself" set Err 1 } { if {[get-file-rev "$f($O($URL))" $O($URL) "$r($O($URL))" $Scm($O($URL))]} { array unset finfo "\[ptl]*,$O($URL)" ; set Err 1 } elseif {[get-file-rev "$f($URL)" $URL "$r($URL) $Scm($URL)"]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1 } else {incr cnt 2} } } elseif {[file isdirectory [set P $f(1)]]} { # Only in this Dir, or the whole Tree ? foreach D [expr {($finfo(fRecurs) && $Scm(1) in $g(scmS)) ? [DFSobj Dir $P] : $P } ] { foreach P [glob -nocomplain -directory $D -types f *] { if {[xclude $P]} { continue } # N.B> Uses names IN Dir(s) to PROBE the SCM Sandbox if {[get-file-rev "$P" $cnt+1 "$r(1)" $Scm(1) 1]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 } elseif {[get-file "$P" $cnt+2 1]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 array unset finfo "\[ptl]*,[expr $cnt+2]" } else {incr cnt 2} } } } else { if {[get-file-rev "$P" 1 "$r(1)" $Scm(1)]} { array unset finfo "\[ptl]*,1" ; set Err 1 } elseif {[get-file "$P" 2]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1 } else {incr cnt 2} } } elseif {$revs == 2 && $pths == 1} { ################################################################# # tkdiff -rREV1 -rREV2 FSPEC (file in, dir at) SCM sandbox ################################################################# Dbg "Applying Pairing RECIPE: FSpec(1) Revs(2)" if {[file isdirectory [set P $f(1)]]} { # Only in this Dir, or the whole Tree ? foreach D [expr {($finfo(fRecurs) && $Scm(1) in $g(scmS)) ? [DFSobj Dir $P] : $P } ] { foreach P [glob -nocomplain -directory $D -types f *] { if {[xclude $P]} { continue } # N.B> Uses names IN Dir(s) to PROBE the SCM Sandbox if {[get-file-rev "$P" $cnt+1 "$r(1)" $Scm(1) 1]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 } elseif {[get-file-rev "$P" $cnt+2 "$r(2)" $Scm(2) 1]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 array unset finfo "\[ptl]*,[expr $cnt+2]" } else {incr cnt 2} } } } else { if {[get-file-rev "$P" 1 "$r(1)" $Scm(1)]} { array unset finfo "\[ptl]*,1" ; set Err 1 } elseif {[get-file-rev "$P" 2 "$r(2)" $Scm(2)]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1 } else {incr cnt 2} } } elseif {$revs == 0 && $pths == 2} { ############################################################ # tkdiff FSPEC1 FSPEC2 (dirs, files or mixed) ############################################################ Dbg "Applying Pairing RECIPE: FSpec(2) Revs(0)" # One, the other, or both may be directories # Regardless, the same FILE name must exist in EACH to be paired if {[file isdirectory $f(1)] && [file isdirectory $f(2)]} { # Should we DO just this one level -or- Recursively descend ? if {!$finfo(fRecurs) || [string trim $opts(egnSrchCmd)]=={}} { foreach P [glob -nocomplain -directory $f(1) -types f *] { if {[xclude $P]} { continue } #N.B. "file isfile xxx" thankfully WON'T fault OS softlinks if {[file isfile \ [set F [file join $f(2) [file tail $P]]]]} { set finfo(lbl,[incr cnt]) \ [shortNm [set finfo(pth,$cnt) $P]] set finfo(lbl,[incr cnt]) \ [shortNm [set finfo(pth,$cnt) $F]] } } # Recursive - go for it! # but may need to "normalize" cnt/Err if IT posts a message } elseif {[set cnt [inquire-diff]] & 1} { incr cnt -[set Err 1] } # EITHER method MAY result in NO usable input if they simply # have no actual COMMON filenames if {!$cnt && !$Err} { set Err 1 set msg "Given directories have NO filenames in common" } # maybe only ONE was a directory ... } elseif {[file isdirectory $f([set i 1])] || [file isdirectory $f([set i 2])]} { if {[get-file [file join $f($i) [file tail $f($O($i))]] $i]} { set MSG "Searched file $f($O($i)) non-existant in: $f($i)" array unset finfo "\[ptl]*,$i" ; set Err 1 } elseif {[get-file "$f($O($i))" $O($i)]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1 } else { incr cnt 2 } } else { # Otherwise they are just files if {[get-file "$f(1)" 1]} { array unset finfo "\[ptl]*,1" ; set Err 1 } elseif {[get-file "$f(2)" 2]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1 } else { incr cnt 2 } } } elseif {$revs > 0 && $pths == 2} { ################################################################# # tkdiff -rREV1 FSPEC1 (file in, dir at, URL) SCM sandbox # (+) [-rREV2] FSPEC2 (same or distinct) SCM sandbox # (can compare ACROSS a branch/WC boundary or distinct SCMs) ################################################################# Dbg "Applying Pairing RECIPE: FSpec(2) Revs(1/2)" if {[file isdirectory $f(1)] && [file isdirectory $f(2)]} { # Should we DO just this one level -or- Recursively descend ? if {!$finfo(fRecurs) || [string trim $opts(egnSrchCmd)]=={}} { foreach P [glob -nocomplain -directory $f(1) -types f *] { # Use sandbox for name intersection - thus NOT probing! if {[xclude $P] || ![file isfile [set F \ [file join $f(2) [file tail $P]]]]} {continue} if {[get-file-rev "$P" $cnt+1 "$r(1)" $Scm(1)]} { array unset finfo "\[ptl]*,[expr $cnt+1]" set Err 1 } elseif {[get-file-rev "$F" $cnt+2 "$r(2)" $Scm(2)]} { array unset finfo "\[ptl]*,[expr $cnt+1]" array unset finfo "\[ptl]*,[expr $cnt+2]" set Err 1 } else { incr cnt 2 } } # Recursive - go for it! # but may need to "normalize" cnt/Err if IT posts a message } elseif {[set cnt [inquire-diff]] & 1} { incr cnt -[set Err 1] } # EITHER method MAY result in NO usable input if they simply # have no actual COMMON filenames if {!$cnt && !$Err} { set Err 1 set MSG "Provided Dirs had NO filename in common" } } elseif {[file isdirectory $f([set i 1])] || [file isdirectory $f([set i 2])]} { set P "[file join $f($i) [file tail $f($O($i))]]" if {[get-file-rev "$P" $cnt+1 "$r($i)" $Scm($i)]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 } elseif {[get-file-rev "$f($O($i))" $cnt+2 "$r($O($i))" $Scm($O($i))]} { array unset finfo "\[ptl]*,[expr $cnt+1]" ; set Err 1 array unset finfo "\[ptl]*,[expr $cnt+2]" } else { incr cnt 2 } } else { # N.B> for EACH Fspec, we ALLOW an SCM (if permissable) if {($URL&1) || $r(1)!=""} { if {[get-file-rev "$f(1)" 1 "$r(1)" $Scm(1)]} { array unset finfo "\[ptl]*,1" ; set Err 1} } elseif {!($URL&1)} { if {[get-file "$f(1)" 1]} { array unset finfo "\[ptl]*,1" ; set Err 1} } if { !$Err && (($URL&2) || $r(2)!="")} { if {[get-file-rev "$f(2)" 2 "$r(2)" $Scm(2)]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1} } elseif {!$Err && !($URL&2)} { if {[get-file "$f(2)" 2]} { array unset finfo "\[ptl]*,\[12]" ; set Err 1} } if {!$Err} { incr cnt 2 } } } } Dbg "Final status: FSpecs($pths) Revs($revs) -> $cnt/2 pairings $Err Err" # Tell user if ANYTHING went wrong (POSSIBLY superimposing Err INTO cnt) if {$Err} { if {$MSG!={}} { if {[winfo exists .newDiff]} { popmsg "Error: $MSG" } { puts stderr "Error: $MSG" } # Wipeout any GENERATED values (its a loss anyway) restore init val array unset finfo {[aptl]*[0-9]} array set finfo $priorVals set cnt 1 } elseif {$msg!={}} { if {[winfo exists .newDiff]} { popmsg $msg warning "Warning"} { puts stderr "Warning: $msg" } # N.B> when MSG has POSTED this makes NO REAL chgs; BUT if not, it # forces a -1, UNLESS we also found usable files .... for which # it will then operate AS-IF to increment (making 'cnt' ODD). # This "odd"ness has no particular special meaning, although it # WOULD indicate (to main) that this wasn't a "clean" input parse. # At present, 'main' doesn't care and simply uses the found files. if {!$cnt} {set cnt -1} { set cnt [expr $cnt|1] } } } # Derive any additional target-related values (preparing to move forward) if {$cnt > 1} { set finfo(fCurpair) 1 set finfo(fPairs) [expr {$cnt / 2}] if {[set P $finfo(f,0)] != {}} { # The USER may only SPECIFY a 3way when its a SINGLE comparison # Otherwise we silently erase their attempt if {$cnt == 2} { # Unlike other files, Ancestors can ONLY come from an SCM when # a rev is given (because DEFAULTING it to the most recent # check-in defeats its purpose) (?? but what about 'BASE' ??) if {[set r0 $finfo(rev,0)] != ""} { if {[get-file-rev "$P" -$finfo(fCurpair) "$r0"]} { array unset finfo "a\[ptl]*,1" } } elseif {[get-file "$P" -$finfo(fCurpair)]} { array unset finfo "a\[ptl]*,1" } } else { lassign {} finfo(f,0) finfo(rev,0) } } } # TELL "main" what we want done next... # -1 = Force RESTART # 0 = Simply EXIT # 1 = RESTART (if in graphics mode) or ABORT (when not) # >1 = Process ($cnt/2) file pairs (INTEGER divide ignores ANY +1) return $cnt } ############################################################################### # Align various label decorations to the CURRENT input file pairing ############################################################################### proc alignDecor {pairnum} { global g w opts finfo # Establish if 3way mode is NOW active and what file indices are in use set g(is3way) [info exists finfo(albl,$pairnum)] Dbg "is3way($g(is3way))" set ndx(1) [set ndx(2) [expr {$pairnum * 2}]] incr ndx(1) -1 set finfo(title) \ "[file tail $finfo(lbl,$ndx(1))] .vs. [file tail $finfo(lbl,$ndx(2))]" # Set file labels (possibly overridden) and a Tooltip for REAL files foreach {LR n} {Left 1 Right 2} { if {[info exists finfo(ulbl,$ndx($n))] && $finfo(ulbl,$ndx($n)) !={}} { set finfo(lbl,$LR) $finfo(ulbl,$ndx($n)) ;# Override lbl display } else {set finfo(lbl,$LR) $finfo(lbl,$ndx($n))} if {![info exists finfo(tmp,$ndx($n))] \ && $finfo(pth,$ndx($n)) != $opts(NULLdev)} { # (N.B> Tip data will ALSO be used by report generation heading) set g(tooltip,${LR}Label) "{$finfo(pth,$ndx($n))\n" append g(tooltip,${LR}Label) \ "[clock format [file mtime $finfo(pth,$ndx($n))]]}" } { set g(tooltip,${LR}Label) {}} set_tooltips $w(${LR}Label) "$g(tooltip,${LR}Label)" } # Add/Remove the Ancestor indicator (and its tooltip) as needed if {$g(is3way)} { grid $w(AncfLabel) -row 0 -column 1 if {![info exists finfo(atmp,$pairnum)]} { set tipdata "{$finfo(apth,$pairnum)\n" append tipdata "[clock format [file mtime $finfo(apth,$pairnum)]]}" } { set tipdata "{$finfo(albl,$pairnum)}"} set_tooltips $w(AncfLabel) "$tipdata" } else { set_tooltips $w(AncfLabel) {} grid forget $w(AncfLabel) } # Unlock a preset mergefile name if the CURRENT pairing COULD be arbitrary if {$finfo(fPairs) > 1} {set g(mergefileset) 0} # Guess the best 'mergefile' name for the CURRENT pairing (if not preset) if {! $g(mergefileset)} { # If BOTH are tmpfiles, lets go with just the file itself in the CWD... if {[info exist finfo(tmp,$ndx(1))]&&[info exist finfo(tmp,$ndx(2))]} { set rootname [file rootname [file tail $finfo(pth,$ndx(1))]] set suffix [file extension $finfo(pth,$ndx(1))] } else { # ...or lets pair it to the NON-tempfile location (Left preferred) if {[info exists finfo(tmp,$ndx(1))]} {set i 2} {set i 1} set rootname [file rootname $finfo(pth,$ndx($i))] set suffix [file extension $finfo(pth,$ndx($i))] } set g(mergefile) [file join [pwd] "${rootname}-merge$suffix"] } Dbg "MergeFileSet($g(mergefileset)): $g(mergefile)" wm title . "$finfo(title) - $g(name) $g(version)" return 0 } ############################################################################### # While not TRULY an 'inquiry' it DOES use Diff to recursively FIND files ############################################################################### proc inquire-diff {} { global opts finfo set cnt 0 set MSG [set msg {}] # Will ask Diff which files DIFFER in the given directories (recursively) # N.B> RE creates 3 filename FIELDS out of the TWO (trailing) fnames by # FIRST knowing how many OTHER args preceded it. Besides the OVERALL # match field (#0) returned, the OTHER 3 returned fields will be: # 1st unique prefix, common suffix value, 2nd unique prefix set cmd [formOpts egnSrchCmd] set xtractFNre \ "^diff(?: +\[^ ]*){[expr [llength $cmd] - 1]} +(.+?)(.*) (.+?)\\2\$" lappend cmd $finfo(f,1) $finfo(f,2) show-status "Executing {$cmd}" lassign [run-command $cmd] dOUT dERR dRC # DO NOT RECORD $dRC as g(returnValue) in this context !! # It would be inappropriate as the EXIT code if {$dRC < 0 || $dRC > 1 || $dERR != ""} { set MSG "Diff FAILED (rc=$dRC):\n$dERR" } elseif {$dRC == 0} { set msg "Diff reports NO diffs between: $finfo(f,1) $finfo(f,2)" } # Parses output using a "RegExp 'recognizer'" to accomodate OTHER engines # which would (most likely) produce distinctly different syntactic forms # N.B> DO NOT simplify this into a "switch -regexp"... (--> TCL bug!) # Somehow "switch" would PREVENT the $xtractFNre RE from matching foreach line [split $dOUT "\n"] { switch -glob -- $line { {Files *} { # GNU Diff -r output syntax (of ALL files): WITH '-q' option: set fpath [regexp -inline -- {^Files (.+) and (.+) differ$} $line] set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 1]]] set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 2]]] } {diff --git *} { # GIT Diff bears a marked resemblance to what "Diff -r" produces, but # also MANGLES the filenames slightly. But the BIGGEST pain is it wont # honor attempts to EXCLUDE files by name (Claims it can via ":!file", # but doesnt WORK, at least NOT in a NON-repo environment)! set fpath [regexp -inline -- $xtractFNre $line] # Need to carefully REMOVE the ficticious A/B naming prefixes foreach {n f} "1 [lindex $fpath 1] 3 [lindex $fpath 3] 0" { if {[string match {[ab]/.} $f} { lset fpath $n [string range $f 2 end] } elseif {[string match {[ab]/} $f} { lset fpath $n [string range $f 1 end] } { break } } # Can only acccept BOTH if ABOVE loop properly processed EACH if {!$n} { set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 1][lindex $fpath 2]]] set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 3][lindex $fpath 2]]] } } {diff *} { # GNU Diff -r output syntax (of NON-BINARY files): WITHOUT '-q' option: # (data parrots the ORIGINAL $cmd except w/ SPECIFIC filenames) # N.B> side-benefit: Encountered BINARY files will NOT be picked-up # because Diff CHANGES their wording (to one we DONT look for!) # Thus suppress POSSIBLE "failure" report (based off the Diff Rcode) if {$MSG!={}} {set MSG {}} # N.B> Stripping out the filenames here requires a Regexp that KNOWS # how many OTHER options were present on the command GENERATING # the output lines being parsed now - (see earlier for its defn) set fpath [regexp -inline -- $xtractFNre $line] set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 1][lindex $fpath 2]]] set finfo(lbl,[incr cnt]) [shortNm [set finfo(pth,$cnt) \ [lindex $fpath 3][lindex $fpath 2]]] } default { continue } } } # PUSH-return errors (and signal their existence by returning ODD count) if {[string length "$MSG$msg"]} { if {$MSG!={}} { uplevel 1 set MSG "{$MSG}" } if {$msg!={}} { uplevel 1 set msg "{$msg}" } incr cnt } return $cnt } ############################################################################### # Request git to supply relevant target argument(s) ############################################################################### proc inquire-git {revs} { global finfo set MSG [set msg {}] # Git diff requires 0-2 commit-ish "somethings" (hash, HEAD, etc...) # # As such, we expect those args to come thru as 'revs'; 'pths' would only # be useful to LIMIT the list being constructed (if we allowed them). # Git differs from most SCMs in that it has an intermediate "pocket" # (called the 'index', or 'stage') BETWEEN the working copy (WC) and a # bona-fide "commit" (aka revision). Therefore while the nominal mapping # is: # 'revs': # 0 = HEAD -> WC # 1 = rev -> WC # 2 = revA -> revB # use of a BLANK rev (" ") denotes the Index. Everything else SHOULD be # handled by "git rev-parse" (tags/hashes/branches/expressions/etc.) # # However, WE are responsible for mapping the BLANK rev to the --staged # keyword required to make "git diff" actually access the Index. set cmit(2) [set rev(2) ""] if {$revs == 0} { # Sets up HEAD -> WC set cmit(1) [set rev(1) "HEAD"] } elseif {$revs <= 2} { # Sets up (R1 or Index) -> (WC or Index or R2) if {"" == [string trim [set cmit(1) [set rev(1) $finfo(rev,1)]]]} { set cmit(1) "--staged" } if {$revs == 2} { # Sets up R1 -> R2 (but just NOT Index -> Index)!!! if {"" == [string trim [set cmit(2) [set rev(2) $finfo(rev,2)]]]} { if {"--staged" != $cmit(1)} {set cmit(2) "--staged"} { set MSG "BOTH revisions cannot specify the Git Index" return 1; # (Would've resulted in Index -> WC) } } } } # NORMALLY we would only extract the first pairing and simply RECORD # the others for later processing...but Git is a local-access SCM, thus # latency SHOULD NOT be an issue - just go DO IT ALL right now... # # Ask Git which files ACTUALLY differ between the given endpoint(s) # (but limit it to those files seemingly modified - NO add/del) set cmd "git diff --diff-filter=M --name-only $cmit(1) $cmit(2)" lassign [run-command $cmd] gOUT gERR gRC if {$gRC != 0 || $gOUT == ""} { if {$gRC == 0} { set msg "Git Diff claims NO diffs using args: $cmit(1) $cmit(2)" } else {set MSG "Git Diff FAILED:\n$gERR"} set gitRC 1 } { set gitRC 0 } set git_root [exec git rev-parse --show-toplevel] set cnt 0 foreach file [split $gOUT "\n"] { # Ordinarily, 2-Revs would mean no possible WC interaction ... # But if either referred to the Index, then we need to check it # # Look for an "unmerged" situation (only shows up in the Index) # Git-assigned tag #s are: 1:ancestor 2:ours 3:theirs # (N.B> but unknown if they will extract here in that order) if {($revs < 2 || $cmit(1) == "--staged" || $cmit(2) == "--staged") \ && (1< [llength [set xx [split [exec git ls-files -s $file] "\n"]]])} { foreach i {3 2 1} { # Process each given item (in theirs/ours/ancestor order) foreach Gtag $xx { if {$i == [lindex $Gtag end-1]} {break} } # Label the pieces and ... if {$i > 1} { set finfo(pth,[incr cnt]) [set f [tmpfile "git_$i"]] set finfo(tmp,$cnt) "" set finfo(lbl,$cnt) "[shortNm $file] (GIT Cflct-" if {$i == 2} { append finfo(lbl,$cnt) "ours)" } \ else { append finfo(lbl,$cnt) "theirs)" } } else { set finfo(apth,[expr {$cnt/2}]) [set f [tmpfile "tg_$i"]] set finfo(albl,[expr {$cnt/2}]) "Ancestor (GIT Cflct)" set finfo(atmp,[expr {$cnt/2}]) "" } # ... grab the file content using its SHA1 id set cmd "git cat-file blob [lindex $Gtag end-2]" lassign [run-command $cmd $f] na gERR gRC if {!$gRC} { continue } # BUT - erase it ALL if ANY of it fails set MSG "Git couldn't extract Conflict item($i): $file\n$gERR" set gitRC 1 ; # Let caller know we didn't get EVERYTHING if {$i == 1} {array unset finfo "a*,[expr {$cnt/2}]"} if {$i <= 2} {array unset finfo "\[ptl]*,$cnt"} if {$i < 3} {incr cnt -1} if {$i <= 3} {array unset finfo "\[ptl]*,$cnt"; incr cnt -1} } continue } # Otherwise its (supposedly) a plain old difference foreach i {1 2} { incr cnt if {$rev($i) != ""} { if {" " == [string index "$rev($i)" 0]} { set finfo(lbl,$cnt) "[shortNm $file] (Git$cmit($i))" } { set finfo(lbl,$cnt) "[shortNm $file] (Git $rev($i))"} # Git is a "local-machine" access method (no latency) so doing # them ALL right now should not be a burden. # If that proves wrong, THIS is where to fix it. set finfo(pth,$cnt) [tmpfile "tkd__[file tail $file]"] set finfo(tmp,$cnt) "" set cmd "git show $rev($i):$file" lassign [run-command $cmd $finfo(pth,$cnt)] na gitERR gRC if {$gRC} { if [string match "*exists on disk*" $gitERR] { # (the file simply is not *from* the requested 'rev') # Maybe it is an uncommitted (yet staged) file ? # Action: do nothing, let the tmp file remain empty. # This will end up as looking like 1 big 'add' or 'del' # depending on which rev (1 or 2) could not find it. } else { # Instead, we just let it fall into this catchall, # and ensure that the PAIR OF FILES gets skipped... # NOT just the one that failed (tmpfils remain unused). Dbg "FAILED: 'git show $rev($i):$file':\n$gitERR" if {$i == 1} {incr cnt -1; break} {incr cnt -2} } set gitRC 1 } } else { # Just point at the REAL 'working copy' file (allows editting) set finfo(lbl,$cnt) "[shortNm $file] (Git--WC)" set finfo(pth,$cnt) $git_root/$file } } } if {$gitRC} { if {$MSG!={}} { uplevel 1 set MSG "{$MSG}" } if {$msg!={}} { uplevel 1 set msg "{$msg}" } incr cnt } return $cnt } ############################################################################### # Request svn to supply relevant target argument(s) ############################################################################### proc inquire-svn {revs} { global finfo set MSG [set msg {}] # 'svn diff --summarize' tells us WHAT changed across a range of revisions # # rev is what we will tell svn cat to access # cmit is how we express the range to 'svn diff' set cmit(2) [set rev(2) ""] if {$revs == 0} { # Sets up BASE -> WC set cmit(1) [set rev(1) "BASE"] } elseif {$revs <= 2} { # Sets up R1 -> (WC or R2) set cmit(1) [set rev(1) $finfo(rev,1)] if {$revs == 2} { # Finish seting up R1 -> R2 set cmit(2) ":[set rev(2) $finfo(rev,2)]" } } # Ask Svn which items got committed between the given endpoint(s) # do we need/want "--depth files" ??? # N.B> this might get messy with URL/PEG/date notations!!! set cmd "svn diff --summarize -r $cmit(1)$cmit(2)" lassign [run-command $cmd] svnOUT svnERR svnRC if {$svnRC || $svnOUT == ""} { if {$svnRC == 0} { set msg "Svn diff claims NO diffs using rev: $cmit(1)$cmit(2)" } else {set MSG "Svn diff FAILED:\n$svnERR"} set svnRC 1 } # Expected output form should look like lines of: # "flgs filename" # (indices) 0-------7 8---------> # # where flgs can be: # D -deleted # A -added # M -modified # xM -(2nd M) properties modified # Note, "svn diff --summarize" unfortunately reports a CONFLICTED file # as 'M' as well, so we need to analyze a bit further # (because diffing of the embedded 'markers' is not very usefull) set cnt 0 foreach ln [split $svnOUT "\n"] { if {[lindex $ln 0] eq "M"} { set file [string range $ln 8 end] # If *is* a CONFLICTed file, split it up and store the finfo data if {$revs < 2 && [string match "C*" [exec svn status -q $file]]} { # SVN gives us a couple ways to go: # We COULD split-up the conflicted file, or simply GRAB the 3 # files that it stores as "extra" files for us - we will # try the latter (provided all 3 exist), else... if {[file exists $file.mine] \ && 2 == [llength [set Flist [glob -path $file .r*]]]} { # So we have 3 files (2 w/distinct Revs, the EARLIER # of which IS the ancestor) - assign them accordingly # First, parse out the two Rev values in the filenames set x [string length $file] set r0 [string replace [lindex $Flist 0] 0 $x+1 {}] set r1 [string replace [lindex $Flist 1] 0 $x+1 {}] # Then attach them ALL into finfo (as Edittable) foreach x "$file.r[max $r0 $r1] $file.mine" { set finfo(pth,[incr cnt]) "$x" set finfo(lbl,$cnt) "[shortNm $x] (SVN Cflct-" if {$cnt & 1} { append finfo(lbl,$cnt) "theirs)" } \ else { append finfo(lbl,$cnt) "mine)" } } set finfo(apth,[expr $cnt/2]) $file.r[min $r0 $r1] set finfo(albl,[expr $cnt/2]) "[shortNm $x] (SVN Ancestor)" } else {set cnt [split-conflictfile $file $cnt SVN]} continue } # otherwise its just plain old difference foreach i {1 2} { incr cnt if {"" != $rev($i)} { if {[get-file-rev $file $cnt $rev($i) SVN]} { if {$i == 1} {incr cnt -1; break} {incr cnt -2} set svnRC 1 ;# remember to PUSH msgs up another level } } else { # Just point at REAL 'working copy' files (allows editting) set finfo(lbl,$cnt) "[shortNm $file] (SVN--WC)" set finfo(pth,$cnt) $file } } } } if {$svnRC} { if {$MSG!={}} { uplevel 1 set MSG "{$MSG}" } if {$msg!={}} { uplevel 1 set msg "{$msg}" } incr cnt } return $cnt } ############################################################################### # Request cvs to supply relevant target argument(s) ############################################################################### proc inquire-cvs {revs} { global finfo set MSG [set msg {}] # 'cvs diff --brief' tells us what changed # # rev is what we will tell cvs update -p to access # cmit is how we express the range to 'cvs diff' set cmit(2) [set rev(2) ""] if {$revs == 0} { # Sets up BASE -> WC set cmit(1) [set rev(1) "BASE"] } elseif {$revs <= 2} { # Sets up R1 -> (WC or R2) set cmit(1) [set rev(1) $finfo(rev,1)] if {$revs == 2} { # Finish seting up R1 -> R2 set cmit(2) " -r [set rev(2) $finfo(rev,2)]" } } # Ask CVS what changed between the given endpoint(s) set outfile [tmpfile "cvsout" 1] set cmd "cvs diff -l --brief -r $cmit(1)$cmit(2)" lassign [run-command $cmd $outfile] na cvsERR cvsRC # cvsRC can be non-zero in many cases, # eg.: if a file doesn't have one of the revs. # Thus it isn't very meaningful or helpfull here; however, # cvsERR should at least contain "cvs diff: Diffing ." regardless. # Yet in the empty case, cvsRC is then zero (rather confusing). # Due in part to these issues (and what TCL presumes about errors) we were # thus forced to place the cmd output into a file, to AVOID Tcl replacing # it (in cvsOUT) with its OWN error msgs. # SO - we rewrite cvsOUT FROM that file to SEE the case when it's empty, # and we will deduce Success (or not) out of the messaging provided set fp [open $outfile r] set cvsOUT [read $fp] close $fp file delete $outfile set cvsRC 0 if {[string match {*Diffing*} $cvsERR] } { if {$cvsOUT == ""} { set msg "CVS diff claims NO diffs using -r $cmit(1)$cmit(2)" set cvsRC 1 } } # Expected output form will look like: # Index: File2.txt # =================================================================== # RCS file: /home/userid/path-into-repository/File2.txt,v # retrieving revision 1.5 # diff --brief -r1.5 File2.txt # Files /var/tmp/cvsdBUe0v and File2.txt differ # cvs diff: File3.txt was removed, no comparison available # cvs diff: FileAdd.txt is a new entry, no comparison available # Index: Ftrunk.txt # =================================================================== # RCS file: /home/userid/path-into-repository/Ftrunk.txt,v # retrieving revision 1.5 # diff --brief -r1.5 Ftrunk.txt # Files /var/tmp/cvs3Wrp6F and Ftrunk.txt differ # Note, cvs diff --brief doesn't report a conflicted file differently, and # cvs update -p will throw an error (unlike svn cat -p) making identifying # such files imperative - we also need its Revision (to locate an ancestor) # - UNLESS 2 Revs were provided (as that precludes using ANY WC files) set cnt 0 foreach ln [split $cvsOUT "\n"] { if {[string match "Index: *" $ln]} { # Grab the filename ... set fn [lindex $ln 1] set Cflct 0 ;# ... then check for a CONFLICTed file (presumed: NO) if {$revs < 2} { # Sadly, CVS does not provide RELATIVE revision references # (cant ask for 'parent' Rev of a file) so are forced to ask for # a 'cvs status' to both check for CONFLICT and GET its revision # THEN simulate a 'parent' conversion ourselves (subtract 0.1) foreach ln [split [exec cvs status $fn] "\n"] { if {!$Cflct && [string match "*Unresolved Conflict" $ln]} { set Cflct 1 } \ elseif {$Cflct && [string match "*Working rev*" $ln]} { # We want the last digits (Cf) of its revision value (Cr) set Cflct [lindex [set Cr [split [lindex $ln 2] "."]] end] lset Cr {end} [incr Cflct -1] ;# Compute PARENT Revision! break } } } # If *is* a CONFLICTed file, split it up and store as finfo data # N.B> "split..." will INCREMENT cnt (which is why we pass it in) if {$Cflct} { set cnt [split-conflictfile $fn $cnt CVS] # OK - When CVS conflicts a file, it ALSO plants the prior # data as a hidden file in the WC - THAT is *ALMOST* our # ancestor - actually its the ancestor PLUS the users mods # (what existed just BEFORE the "update" ran). We COULD go # get the REAL ancestor, but this may be good enough ... # Grab it if it exists if {[file exists [set Afn ".#$fn.[join $Cr "."]"]]} { set finfo(apth,[expr {$cnt / 2}]) "$Afn" set finfo(albl,[expr {$cnt / 2}]) "[shortNm $Afn] (CVS Cflct)" } # (some CVS admins MAY have set up processes to delete it # after a few days wait time - perhaps THAT is when we # should try extracting the REAL one?) continue } # otherwise its a plain old difference foreach i {1 2} { incr cnt if {"" != $rev($i)} { if {[get-file-rev $fn $cnt $rev($i) CVS]} { if {$i == 1} {incr cnt -1; break} {incr cnt -2} set cvsRC 1 } } else { # Just point at REAL 'working copy' files (allows editing) set finfo(lbl,$cnt) "[shortNm $fn] (CVS--WC)" set finfo(pth,$cnt) $fn } } } } if {$cvsRC} { if {$MSG!={}} { uplevel 1 set MSG "{$MSG}" } if {$msg!={}} { uplevel 1 set msg "{$msg}" } incr cnt } return $cnt } ############################################################################### # Set up the display ############################################################################### proc create-display {} { global g w pref opts tmpopts # these are the five major areas of the GUI: # menubar - the menubar (duh) # toolbar - the toolbar (duh, again) # client - the area with the text widgets and the graphical map # status - a bottom status line # merge - a separate window monitoring the results of all merge actions # 'identify' major frames/windows and store them in a global array # # Status window MAY have been pre-built due to excessive network latency # If so, re-hide it until we can buildout the remainder of the display ... # Otherwise its ALREADY hidden, just build it along with everything else if {[set prebuilt [winfo exists .status]]} { wm withdraw . } { set w(status) .status } set w(client) .client set w(menubar) .menubar set w(toolbar) .toolbar set w(popupMenu) .popupMenu set w(merge) .merge # 'identify' other windows that conditionally MAY exist later... set w(srch) .srch set w(prefs) .pref set w(scDialog) .scDialog set w(mFdiag) .mFdiag # now, simply build all the REQUIRED pieces build-toolbar build-client build-menus if {!$prebuilt} { build-status } build-merge frame .separator1 -height 2 -borderwidth 2 -relief groove frame .separator2 -height 2 -borderwidth 2 -relief groove # Create a static list of Text widget actions that, when access'ing, will # NOT alter the display height nor count-of all text lines (a plot speedup) # N.B> Its UNDOCUMENTED how this list gets searched, except that each is # a 'string'. Investigation (in TCL srcCode) indicates linear # first-found with length checks on each prior to byte compares. # # So BEST order is: HIGHEST LIKELIHOOD EARLIEST; but then ?abbreviations? # OUR assessment of order thus presumes fullwords outrank minimal abbrev, # which outranks other LEGAL abbrev, but ARRANGED as merged GROUPS based # on likelihood of repetitive USAGE in this tool. CONVENIENTLY(?) OUR use # of abbreviations mostly falls on words NOT BELONGING in this list anyway. # Statistical measurement would be best; perhaps we'll rig one ... someday set w(benign) { dlineinfo xview count index mark bbox cget get\ dump search compare debug peer sync syncpending } # IN ADDITION, we need a 2nd static list: a TxtWidget subcmd-SYNONYM map # supporting our "Read Only" strategy (see 'textROfcn' for how this works) set w(ROsynonym) {INSERT ins DELETE del REPLACE rep SEE see} # And LASTLY a datum that TRACKS when TK has finished computing lineHeights # so syncscroll "gets it right" when the data MAY have been questionable... # normal STATE (& Default) is 3 (see table below) set w(SYNCnow) 3 # ...WHICH IN TURN necessitates a rather CRYPTIC 'state-transition' table # to tell 'textROfcn' WHEN 'scrolling' (particularly syncscroll) is ALLOWED # by describing HOW 'w(SYNCnow)' should TRANSITION to depict the present # status of COMPLYING with and/or REMEMBERING a needed scroll request. # States denoted as NEGATIVE mark WHEN to issue the SYNC-scroll !! # # EVERY transition records INTO w(SYNCnow) above which is a 3bit-field # (Rqstd, ReadyRight, ReadyLeft) # # Each PAIR(L/R) of ROWs defines how to transit that specific widget # in receipt of each DENY/LEFT/RIGHT/RQST notification (in any order) # Table Format is: # ( t w o r o w s ) DENY scroll MsgGrp 0 # ( o n e r o w ) LEFT Ready MsgGrp 1 # ( t w o r o w s ) unused: (2ndLeft & 1stRight 'Ready's) # ( o n e r o w ) RIGHT Ready MsgGrp 2 # ( t w o r o w s ) RQST scroll MsgGrp 3 # (N.B> list FORMAT was DICTATED by the SPECIFIC indexing strategy!) set w(SYNCtbl) { { { 0 0 2 2 4 4 6 0 0 2 2 4 4 6}\ { 0 1 0 1 4 5 4 0 1 0 1 4 5 4} } { { 1 1 3 3 -1 5 6 1 1 3 3 5 5 -3}\ {} } { {}\ { 2 3 2 3 -2 5 6 2 3 2 3 6 -3 6} } { { 4 -1 6 -3 4 -1 -3 4 -1 6 -3 4 -1 -3}\ { 4 5 -2 -3 4 -3 -2 4 5 -2 -3 4 -3 -2} } } # syncscroll OFF syncscroll ON # States (0 - 6) States # Now fit all the widgets together and MANAGE it... # Note this effectively "declares" the remaining 'pack'er cavity # to be just BELOW the client, but ABOVE the status bar. # (EXACTLY where DbgUI will appear if/when sourced in !!) # DbgUI is a custom standalone bind-investigation debugging tool . configure -menu $w(menubar) pack $w(toolbar) -side top -fill x -expand n pack .separator1 -side top -fill x -expand n pack .separator2 -side top -fill x -expand n if {!$prebuilt} { pack $w(status) -side bottom -fill x -expand n } pack $w(client) -side top -fill both -expand y # APPLY the users preferences by calling the proc that gets invoked when # the user presses "Apply" from the preferences window. That proc uses a # global variable ("tmpopts") which would ordinarily have the NEW values # from the dialog. # Since we haven't USED the dialog, populate this array DIRECTLY ! # N.B> 'prefapply' GENERALLY looks for CHANGES among 'tmpopts'/'opts' # CAUSING update ACTIONS - precluded by making them *IDENTICAL*. # We simply need it to ENSURE these settings are what is "in effect" when # it comes to those values affecting "configurable elements" array set tmpopts [array get opts] prefapply # Make sure temporary files get deleted #bind . {del-tmp} # Next, arrange for line numbers to be redrawn when just about anything # happens to ANY of our text widgets programatically. # This runs much faster than you might think. # N.B> Note: traces go to the NON-wrapped widget (xxx'_') to avoid # responding to "fake" subcmnds handled by the WRAPPER directly. trace add exec $w(LeftText)_ leave "plot-line-info Left" trace add exec $w(RightText)_ leave "plot-line-info Right" trace add exec $w(mergeText)_ leave "plot-merge-info" bind $w(LeftText) "list plot-line-info Left" bind $w(RightText) "list plot-line-info Right" bind $w(mergeText) "list plot-merge-info" # Lastly, we make any wheel scrolling over the Info windows work # (even though they themselves dont ACTUALLY scroll - they repaint) # 'eval' simply eliminates vars from within the quoted bind-scripts # (???- found no way to just FORWARD the event to the Text widget) foreach side {Left Right merge} { foreach evt {Button-4 Button-5 Shift-Button-4 Shift-Button-5} { eval bind $w(${side}Info) <$evt> \ "{event generate $w(${side}Text) <$evt> -when head}" } foreach evt {MouseWheel Shift-MouseWheel} { eval bind $w(${side}Info) <$evt> \ "{event generate $w(${side}Text) <$evt> -delta %D -when head}" } } # Watch for the user to toggle scrollbar syncing # (we want to make sure they sync up immediately) trace add var opts(syncscroll) write toggleSyncScroll # Attach all remaining bindings (mostly User-assigned shortcut HOTkeys) # to NEARLY every widget we know !! (plus some 'client' specialty items) setBinds {*}[lrange [DFSobj Wdg $w(client)] 1 end] $w(merge) {.} # ...and ADVERTISE those HOTkeys into their pertinent MENU entries # N.B> DANGEROUS: 'glob-matching' doesnt support "ORed" filtering - so # grab the "gen*, nav*, mrg*" prefs with some extra slop involved foreach key [array names pref {[gnm][ear][nvg]*}] { if {[info exists w(Accel,$key)]} { foreach {mnu idx} $w(Accel,$key) { $mnu entryconfigure $idx -accelerator "$opts($key)" } } } wm deiconify . focus -force $w(acTxWdg) update idletasks # Need this to make our L/R 'pane'-resize emulation behave logically # (cant have it appealing to its Toplevel for MORE space) grid propagate $w(client) false # This may appear even stranger: # Now that the main window has been built AND preferences applied, there # is an EXCELLENT chance that its REQUESTED size has been curtailed by # forcing a geometry modification onto it, keeping it from being screen # clipped on its intial display. # It is THOSE dimensions we want the newly built merge window to # center above. So we will use an unusual cmd syntax into centerWindow to # possibly override the main window dimensions, while ALLOWING the actual # w(merge) size to be picked up. # But first - we need to let the merge window actually FINISH with its # ation (or even WE wont get the correct size...) # Luckily, 'centerWindow' brackets its action BETWEEN 2 'update' calls... scan [winfo geometry .] "%dx%d" W H centerWindow $w(merge) "0 0 $W $H" } ############################################################################### # Odd recursive little procedure generates a LIST of tree-structured objects # (eg. widgetnames -OR- subdirectories) originating and including the SEED # name and all DEEPER names found from it (N.B> w/Dirs subject to exclusion) ############################################################################### proc DFSobj { Obj seed } { lappend them $seed switch $Obj { "Dir" { foreach seed [glob -n -d $seed -type d *] { if {![xclude $seed] } { lappend them {*}[DFSobj Dir $seed] } } } "Wdg" { foreach seed [winfo children $seed] { lappend them {*}[DFSobj Wdg $seed] } }} return $them } ############################################################################### # When the user changes the "sync scrollbars" option, a trace fires to sync # the left and right viewports, but only WHEN they've just turned the option ON ############################################################################### proc toggleSyncScroll {args} { global opts if {$opts(syncscroll)} { centerCDR } } ############################################################################### # show the popup menu, reconfiguring some entries based on where user clicked # (notably - over the MAP window becomes somewhat Left/Right ambiguous) ############################################################################### proc show-popupMenu {X Y} { global g w set win [winfo containing $X $Y] if {$win != $w(mapCanvas)} { # Turn this back ON (as it MAY have been turned off last time) $w(popupMenu) entryconfigure "Edit*" -state normal # Ensure w(acTxWdg) is proper for USE by above entry if {[string match {.client.left*} $win]} { set w(mPopW) [set w(acTxWdg) $w(LeftText)] } else { set w(mPopW) [set w(acTxWdg) $w(RightText)] } } { set w(mPopW) $win # Turn this OFF when we are NOT over the Text (or other L/R) windows # (Re: no way to know which SIDE it would apply to) $w(popupMenu) entryconfigure "Edit*" -state disabled } # Cant find what doesnt exist... $w(popupMenu) entryconfigure "Find Near*" -state \ [expr {$g(count) ? "normal" : "disabled"}] # Only allow clipboard copy if the primary selection is ours to begin with # AND is still PRESENTLY selected (as opposed to being FORMERLY selected) if {[selection own] == "$win" && ![catch "$win index sel.first"]} { set selstatus "normal"} {set selstatus "disabled"} $w(popupMenu) entryconfigure "Copy Selection" -state $selstatus # We must GRAB where we ASKED the menu to popup - needed by "Find Nearest" # which ordinarily would utilize a mousePt to determine what line was meant # (but which we CANT pass-thru via menu Ops - so we'll fake an "end-run") # N.B> (See the "moveNearest" menuitem for where these get re-introduced) tk_popup $w(popupMenu) [set w(mPopX) $X] [set w(mPopY) $Y] } ############################################################################### # Manipulates the list of filepairs of a multi-file diff # (functions even when only ONE pair exists - although its mostly pointless) ############################################################################### proc multiFile {command args} { global g w opts finfo # Special 'global' - is logically PRIVATE to this routine # N.B> needed because we CANT tie the 'radiobutton' widgets DIRECTLY into # finfo(fCurpair), or we LOSE the KNOWLEDGE if a PRIOR value existed # (due to the widget SETTING its attached VAR BEFORE invoking its CMD)! # Think of this as allowing the cmd to VALIDATE it wasn't chosen TWICE. global mFactivE # Convenience internal names set cvs $w(mFdiag).cv set vsb $w(mFdiag).sb # Default operation is to NOT invoke a Diff (unless determined otherwise) set diffit 0 switch -- $command { prev { # choose previous file if {$finfo(fCurpair) > 1} { set diffit [incr finfo(fCurpair) -1] } } next { # choose next file if {$finfo(fCurpair) < $finfo(fPairs)} { set diffit [incr finfo(fCurpair)] } } jump { lassign $args index # choose designated file (but disallow RE-selection) if {$finfo(fCurpair) != $index} { set diffit [set finfo(fCurpair) $index] } } mrkACK { lassign $args index multiFile threshld $opts(fLMmax) # Mark file listing as SUCCESSFULLY accessed if {$finfo(fPairs) <= $opts(fLMmax)} { # Remember menuslots (0-3) have "dialog/prev/next/separ" $w(multiFileMenu) entryconf [expr {$index + 3}] \ -activebackg {PaleGreen} } { $w(mFlist).b$index config -activebackg {PaleGreen} } set mFactivE $index } mrkNAK { lassign $args index multiFile threshld $opts(fLMmax) # Mark file listing as UN-SUCCESSFULLY accessed if {$finfo(fPairs) <= $opts(fLMmax)} { # Remember menuslots (0-3) have "dialog/prev/next/separ" $w(multiFileMenu) entryconf [expr {$index + 3}] \ -activebackg {Tomato} } { $w(mFlist).b$index config -activebackg {Tomato} } set mFactivE $index } empty { lassign $args which # Destroy given CATEGORY of entries (if they happen to exist) # (presupposes menu ALWAYS has 'dialog, prev, next' as first 3) # (and YES - it DOES remove the trailing menu separator !!) if {$which != "list" && [$w(multiFileMenu) index end] > 2} { $w(multiFileMenu) delete 3 end } if {$which != "menu" &&[winfo exists $w(mFdiag)]} { foreach wdg [winfo children $w(mFlist)] { destroy $wdg } } } reload { # Empty old entries out first, from either category (if any) ... # Reloading DESIRED category thereafter multiFile empty "both" multiFile load $finfo(fPairs) } adjsz { lassign $args cnt # Establish dialog filelist HEIGHT (to know what can scroll) # N.B> invoke as "after idle" so implied 'update' will have run set rgn [list 0 0 [winfo width $w(mFlist)] \ [set i [winfo reqheight $w(mFlist)]]] $cvs configure -scrollregion $rgn -yscrollincr [expr $i / $cnt] \ -height [expr ($i/$cnt) * [min $cnt 5]] # (?? above 'height' works initially EXACTLY as desired - unclear # why it then STOPS (again as desired) after user manually # chooses to resize window (maybe a 'geometry' override?) ??) } scroll {lassign $args mvby # ONLY DO the requested scroll... # IF threshold indicates we ARE using the list right now # AND scrollbar is ACTIVE (ie. there IS more to see) if {$finfo(fPairs) > $opts(fLMmax) && [winfo ismapped $vsb]} { $cvs yview scroll $mvby units } } load { lassign $args cnt # N.B> Cant 'load' what isn't THERE - ensure dialog EXISTs # in case we are ABOUT to populate it! if {![winfo exists $w(mFdiag)] && $cnt > $opts(fLMmax)} { multiFile dialog 0 } # Append entries that exist NOW (caller told us how many that is) # into the TARGETTED location (menu or window) based on threshold set i 0 while {[incr i] <= $cnt} { # N.B> see earlier note on global 'mFactivE' vs (fCurpair) if {$cnt <= $opts(fLMmax)} { if {$i==1} { $w(multiFileMenu) add separator } $w(multiFileMenu) add radiobutton -variable mFactivE \ -value $i -label $finfo(lbl,[expr {$i * 2 - 1}]) \ -command [list multiFile jump $i] } { grid [radiobutton $w(mFlist).b$i -variable mFactivE \ -value $i -text $finfo(lbl,[expr {$i * 2 - 1}]) \ -command [list multiFile jump $i]] -sticky "w" # Unfortunately ALSO must snag Mousewheel events sent # to the buttons (because they OVERLAID the canvas) if {$w(wSys) == "x11"} { bind $w(mFlist).b$i {multiFile scroll -1} bind $w(mFlist).b$i {multiFile scroll 1} } elseif {$w(wSys) == "aqua"} { bind $w(mFlist).b$i \ {multiFile scroll [expr {%D>=0 ? -5:5}]} } bind $w(mFlist).b$i \ {multiFile scroll [expr {%D>=0 ? -1:1}]} ;# Up/Dwn } } # If content went INTO the list, schedule FINDING its extent... # Otherwise its in the menu - Update the Pullright menu LABEL. # Regardless, initiating Diff for this case: CALLERS responsibility if {$cnt > $opts(fLMmax)} { grid $cvs after idle multiFile adjsz $cnt $w(multiFileMenu) entryconf 0 -label "Choose File..." set finfo(fLfmt) 1 } elseif {[winfo exists $w(mFdiag)]} { $w(multiFileMenu) entryconf 0 -label "Reconfig Threshold..." set finfo(fLfmt) 0 } } threshld { lassign $args thresh # New opts(fLMmax) was set, but verify if it "makes a difference" if {($finfo(fLfmt)==0 && $finfo(fPairs) <= $thresh) || ($finfo(fLfmt)==1 && $finfo(fPairs) > $thresh)} { return } # Populate EXISTING data into the desired target location, but # TRANSFER any present STATUS information along with it multiFile load [set cnt $finfo(fPairs)] set i 0 while {[incr i] <= $cnt} { if {$cnt > $opts(fLMmax)} { set mrkACKNAK \ [$w(multiFileMenu) entrycget [expr $i+3] -activebackg] } { set mrkACKNAK [$w(mFlist).b$i cget -activebackg] } if {$mrkACKNAK in {Tomato PaleGreen}} { if {$cnt > $opts(fLMmax)} { $w(mFlist).b$i config -activebackg $mrkACKNAK } { $w(multiFileMenu) entryconf [expr $i+3] \ -activebackg $mrkACKNAK } } } if {$cnt > $opts(fLMmax)} { multiFile empty menu ; set finfo(fLfmt) 1 } { multiFile empty list ; set finfo(fLfmt) 0 } } set { lassign $args Sfrac Efrac # WATCH for making the scrollbar itself VISIBLE, by MONITORING # the scrolling feedback values from the canvas-to-scrollbar $vsb set $Sfrac $Efrac # (should REALLY only toggle when it makes a difference...but) if {$Sfrac>0.0 || $Efrac<1.0} { grid $vsb } { grid remove $vsb } } dialog { lassign $args showit # Reconfig and/or Choose from present list of available multiFiles if {![Dialog NONMODAL $w(mFdiag)]} { wm title $w(mFdiag) "$g(name) FileList" wm transient $w(mFdiag) . wm group $w(mFdiag) . # We don't want the window to be deleted, just hidden from view wm protocol $w(mFdiag) WM_DELETE_WINDOW \ {Dialog dismiss $w(mFdiag)} # Threshold control area is always present # ('scale' wdg is allowed to stretch horiz as needed) set ctl [frame $w(mFdiag).ctl -bd 1 -relief solid] label $ctl.lbl -text "Prefer menu\nat/below:" scale $ctl.menulim -orient horizontal -from 1 -to 25\ -var opts(fLMmax) -tick 0 -command {multiFile threshld} button $ctl.dismiss -text "Dismiss" \ -command "Dialog dismiss $w(mFdiag)" grid $ctl.lbl $ctl.menulim $ctl.dismiss -sticky ew grid columnconfig $ctl 1 -weight 1 # Now construct a scrollable frame (for widgets of filenames) # (simply a frame logically INSIDE a canvas) # N.B> DO NOT supply any dimensions to the INNER frame!! # But create and connect a vert scrollbar for that canvas canvas $cvs -height [expr [winfo reqheight $ctl] *3] -bd 0 \ -yscrollcom {multiFile set} -highlightthick 0 scrollbar $vsb -orient vertical -command "$cvs yview" -bd 0 \ -highlightthick 0 # Put the widget-fillable innerframe (mFlist) WITHIN the canvas $cvs create window 0 0 -anchor nw -window \ [set w(mFlist) [frame $cvs.fl -bd 0]] # Put it all together - CTL goes in 1st row but spans 2 cols # while CVS + VSB make up second row, grid $ctl -columnspan 2 -sticky ew grid $cvs $vsb -row 1 -sticky nsew grid columnconfig $w(mFdiag) 0 -weight 1 grid rowconfig $w(mFdiag) 1 -weight 1 # Remove the list (initially)... loading content restores it # ...but THAT will depend on filecount and Threshold setting # and lastly tell canvas to scroll (+/- Y-only) on Wheel events grid remove $cvs $vsb if {$w(wSys) == "x11"} { bind $cvs {multiFile scroll -1} ;# Up bind $cvs {multiFile scroll 1} ;# Dwn } elseif {$w(wSys) == "aqua"} { bind $cvs \ {multiFile scroll [expr {%D>=0 ? -5:5}]} ;# Big Up/Dwn } bind $cvs \ {multiFile scroll [expr {%D>=0 ? -1:1}]} ;# Up/Dwn } # Config set mFactivE $finfo(fCurpair) # Display it (if request was from the User). if {$showit} { Dialog show $w(mFdiag) } } } # Certain subcmds (chg of CURRENT file) require Diff to be run if {$diffit} { do-diff ; update-display } } ############################################################################### # Resize the text windows relative to each other (ie. NET size chg = ZERO) ############################################################################### proc pane-drag {win x} { set relX [expr $x - [winfo rootx $win]] set maxX [winfo width $win] set frac [expr int((double($relX) / $maxX) * 100)] # LIMIT exchange of traded window real estate to the MIDDLE 90% set L [set frac [min 95 [max $frac 5]]] set R [expr 100 - $frac] grid columnconfigure $win 0 -weight $L grid columnconfigure $win 2 -weight $R #Dbg " new L/R ratio: $L $R" } ############################################################################### # build the main client display (text widgets, scrollbars, that sort of fluff) ############################################################################### proc build-client {} { global w opts tk_patchLevel frame $w(client) -bd 2 -relief flat # set up global variables to reference the widgets, so # we don't have to use hardcoded widget paths elsewhere # in the code # # Text - holds the text of the file # Info - holds meta-data ABOUT 'Text': LineNums, Changebars, etc # VSB - vertical scrollbar # HSB - horizontal scrollbar # Label - label to hold the name of the file set w(LeftText) $w(client).left.text set w(LeftInfo) $w(client).left.info set w(LeftVSB) $w(client).left.vsb set w(LeftHSB) $w(client).left.hsb set w(LeftLabel) $w(client).leftlabel set w(AncfLabel) $w(client).ancFile set w(RightText) $w(client).right.text set w(RightInfo) $w(client).right.info set w(RightVSB) $w(client).right.vsb set w(RightHSB) $w(client).right.hsb set w(RightLabel) $w(client).rightlabel set w(BottomText) $w(client).bottomtext set w(map) $w(client).map set w(mapCanvas) $w(map).canvas # May eventually need this for a 3way diff (see 'alignDecor' for details) button $w(AncfLabel) -bd 0 -image ancfImg -command { simpleEd open $finfo(apth,$finfo(fCurpair)) ro \ fg [$w(mergeText) cget -fg] \ bg [$w(mergeText) cget -bg] \ title "$finfo(albl,$finfo(fCurpair)) - Ancestor" } # We create several widgets twice; once for Left and again for Right # # First up, the labels... # N.B> DO NOT set a WIDTH size on these, we simply want them to # use whatever space is given to them by virtue of the TxtWdgs # they will be positioned above (ie. in the same grid-mgr COLUMN). # THEY should NOT BE the 'pacing item' for determining the window width! Dbg " Assigning labels to headers" label $w(LeftLabel) -bd 1 -relief flat -textvariable finfo(lbl,Left) label $w(RightLabel) -bd 1 -relief flat -textvariable finfo(lbl,Right) # These hold the following text widgets and the scrollbars. The reason # for the frame is purely for aesthetics. It just looks nicer, IMHO, # to "embed" the scrollbars within the text widget # (these won't need to be global) set leftFrame [frame $w(client).left -bd 1 -relief sunken] set rightFrame [frame $w(client).right -bd 1 -relief sunken] scrollbar $w(LeftHSB) -borderwidth 1 -orient horizontal -command \ [list $w(LeftText) xview] scrollbar $w(RightHSB) -borderwidth 1 -orient horizontal -command \ [list $w(RightText) xview] scrollbar $w(LeftVSB) -borderwidth 1 -orient vertical -command \ [list $w(LeftText) yview] scrollbar $w(RightVSB) -borderwidth 1 -orient vertical -command \ [list $w(RightText) yview] # By default, CREATE these at the USERS requested size... # However, will likely be shrunk to keep the INITIAL display onScreen if {2 > [scan $opts(geometry) "%dx%d" width height]} { popmsg "Invalid geometry setting:\n$opts(geometry)\n \ Reverting to 80x30" "Improper syntax..." lassign {80 30} width height } text $w(LeftText) -padx 0 -wrap none -width $width -height $height \ -bd 0 -yscrollcommand "vscroll Left" \ -xscrollcommand "hscroll-sync 1" text $w(RightText) -padx 0 -wrap none -width $width -height $height \ -bd 0 -yscrollcommand "vscroll Right" \ -xscrollcommand "hscroll-sync 2" # Technically, we lack the data to configure this properly until both # primary files have been loaded into the above text widgets. But we # need them right NOW for constructing the overall window layout. # Remaining options happen later via "prefapply" and "cfg-line-info" canvas $w(LeftInfo) -highlightthickness 0 canvas $w(RightInfo) -highlightthickness 0 # this widget is the two line display showing the current line, so # one can compare character by character if necessary. # N.B> Best when font used is Constant-Width! text $w(BottomText) -wrap none -borderwidth 1 -height 2 -width 0 # this is BASICALLY how we highlight those bytes that are different... # the bottom window (lineview) uses a tag to highlight mismatches, # so we need to configure that tag as requested $w(BottomText) tag configure diff {*}$opts(bytetag) # Set up text tags for the 'current diff' (the one chosen by the 'next' # and 'prev' buttons) .vs. any ol' diff region. All diff regions are # given the 'diff' tag initially... # As 'next' and 'prev' are pressed, to scroll through the differences, # one particular diff region is always chosen as the 'current diff', and # is set off from the others via the 'curr' tag -- in particular, so its # obvious which diff regions in the left and right-hand text widgets align. # N.B> THIS DEFINES THE TAG PRECEDENCE ORDER # Any further downstream code should only ever RE-cfg IN THIS ORDER! # Introspecting to obtain this (ordered) list is the PREFERRED method foreach widget [list $w(LeftText) $w(RightText)] { $widget configure {*}$opts(textopt) foreach t {diff curr del ins chg overlap inline} { $widget tag configure ${t}tag {*}$opts(${t}tag) } $widget tag raise sel ;# Keep this on top } # build the map... # we want the map to basically resemble a scrollbar, so we'll # steal some information from one of the scrollbars we just created... set color [$w(LeftVSB) cget -troughcolor] set ht [$w(LeftVSB) cget -highlightthickness] set cwidth [expr {[winfo reqwidth $w(LeftVSB)] - ($ht * 2)}] # At the widget level, its just a frame holding a canvas... frame $w(map) -bd 1 -relief sunken -takefocus 0 -highlightthickness 0 canvas $w(mapCanvas) -width [expr {$cwidth + 1}] \ -yscrollcommand map-resize -background $color -borderwidth 0 \ -relief sunken -highlightthickness 0 # ... but for the REAL map, we want an IMAGE we can draw into INSERTED # in that canvas, along with (dummy) linework for a 'scrollbar thumb' # N.B> coords (number of, nor values) dont matter, as 'map-move-thumb' # REWRITES them as a properly positioned, hollow, 3D rectangle (later on) set w(mapImg) [image create photo] $w(mapCanvas) create image 1 1 -image $w(mapImg) -anchor nw $w(mapCanvas) create line 0 0 0 0 -width 1 -tags thumbUL -fill white $w(mapCanvas) create line 1 1 1 1 -width 1 -tags thumbLR -fill black pack $w(mapCanvas) -side top -fill both -expand y # Complete the scrollbar simulation with bindings for interaction bind $w(mapCanvas) {handleMapEvent B1-Press %y} bind $w(mapCanvas) {handleMapEvent B1-Motion %y} bind $w(mapCanvas) {handleMapEvent B1-Release %y} bind $w(mapCanvas) {handleMapEvent B2-Press %y} bind $w(mapCanvas) {handleMapEvent B2-Release %y} # Again, wheel scrolling over the MAP window SHOULD also work # - but can only target the THEN w(acTxWdg) text widget foreach evt {Button-4 Button-5 Shift-Button-4 Shift-Button-5} { eval bind $w(mapCanvas) <$evt> \ "{event generate \$w(acTxWdg) <$evt> -when head}" } foreach evt {MouseWheel Shift-MouseWheel} { eval bind $w(mapCanvas) <$evt> \ "{event generate \$w(acTxWdg) <$evt> -delta %D -when head}" } # this is a grip for resizing the sides relative to each other. button $w(client).grip -borderwidth 3 -relief raised \ -cursor sb_h_double_arrow -image resize -takefocus 0 bind $w(client).grip {pane-drag $w(client) %X} # use grid to manage the widgets in the left side frame grid $w(LeftVSB) -row 0 -column 0 -sticky ns grid $w(LeftInfo) -row 0 -column 1 -sticky nsew grid $w(LeftText) -row 0 -column 2 -sticky nsew grid $w(LeftHSB) -row 1 -column 1 -sticky ew -columnspan 2 grid rowconfigure $leftFrame 0 -weight 1 grid rowconfigure $leftFrame 1 -weight 0 grid columnconfigure $leftFrame 0 -weight 0 grid columnconfigure $leftFrame 1 -weight 0 grid columnconfigure $leftFrame 2 -weight 1 # likewise for the right... grid $w(RightVSB) -row 0 -column 4 -sticky ns grid $w(RightInfo) -row 0 -column 0 -sticky nsew grid $w(RightText) -row 0 -column 1 -sticky nsew grid $w(RightHSB) -row 1 -column 0 -sticky ew -columnspan 2 grid rowconfigure $rightFrame 0 -weight 1 grid rowconfigure $rightFrame 1 -weight 0 grid columnconfigure $rightFrame 0 -weight 0 grid columnconfigure $rightFrame 1 -weight 1 # use grid to manage the labels, frames and map. We're going to # toss in an extra row just for the benefit of our dummy frame. # the intent is that the dummy frame will match the height of # the horizontal scrollbars so the map stops at the right place... grid $w(LeftLabel) -row 0 -column 0 -sticky ew grid $w(RightLabel) -row 0 -column 2 -sticky ew grid $leftFrame -row 1 -column 0 -sticky nsew -rowspan 2 grid $w(map) -row 1 -column 1 -sticky ns grid $w(client).grip -row 2 -column 1 grid $rightFrame -row 1 -column 2 -sticky nsew -rowspan 2 grid $w(BottomText) -row 3 -column 0 -sticky ew -columnspan 4 grid rowconfigure $w(client) 0 -weight 0 grid rowconfigure $w(client) 1 -weight 1 grid rowconfigure $w(client) 2 -weight 0 grid rowconfigure $w(client) 3 -weight 0 grid columnconfigure $w(client) {0 2} -weight 100 -uniform a grid columnconfigure $w(client) 1 -weight 0 # Cause the variable w(acTxWdg) to be whichever text widget EVER # receives the focus via a mouseclick... bind $w(LeftText) <1> {set w(acTxWdg) $w(LeftText)} bind $w(RightText) <1> {set w(acTxWdg) $w(RightText)} # N.B> We DEPEND on w(acTxWdg) to ONLY specify ONE of the main Text # widgets, so PLANT a trace to ensure it ALWAYS STAYS that way trace add var w(acTxWdg) write { apply {{ary elem op} { upvar $ary gbl if {![string match {.client.[lr]*.text} $gbl($elem)]} { set gbl($elem) $gbl(PREV$elem) } set gbl(PREV$elem) $gbl($elem) }}} # and immediately initialize it ('Right' *IS* arbitrary, but valid)! set w(acTxWdg) $w(RightText) # Finally, we need to WRAP each of the major text procs ... # (See explanation below this proc for WHY) rename $w(RightText) $w(RightText)_ proc $w(RightText) {cmd args} $::textROfcn rename $w(LeftText) $w(LeftText)_ proc $w(LeftText) {cmd args} $::textROfcn rename $w(BottomText) $w(BottomText)_ proc $w(BottomText) {cmd args} $::textROfcn # ... while (JUST the L/R two) REQUIRE binds related to their POTENTIAL # to be scroll-synchronized (owing to an unfortunate, yet necessary, TK # processing-performance solution). # # While tracking was EXPOSED in TK 8.6.5 (via <>) we will # ATTEMPT to emulate it in prior versions (down to our package-require) # N.B> Users TRANSITIONING to TK8.6.5 will do so transparently # # Besides binding the virtual event, we need to KNOW which TK is running, # PLUS a datum per widget (empty) ALL FOR exclusive use in a Pre-TK8.6.5 # EMULATION designed to DRIVE that same binding! set w(TK865) [package vsatisfies $tk_patchLevel 8.6.5-] lassign {} w(SYNCbusy$w(LeftText)) w(SYNCbusy$w(RightText)) bind $w(LeftText) <> { %W SYNCnow %d } bind $w(RightText) <> { %W SYNCnow %d } # REPLACE above binds with below IF you want to SEE the state transitions # that RESULT from receipt of the events. Only uncomment ONE set !! # bind $w(LeftText) <> {Dbg {\tSYNCnow{[%W SYNCnow %d]}} 1 {}} # bind $w(RightText) <> {Dbg {\tSYNCnow{[%W SYNCnow %d]}} 1 {}} } ############################################################################### # This Text-Wdg BODY code will be used as an 'observer' WRAPPER for EITHER # the FIRST (or in the case of the L/R widgets, ALL) of these reasons: # # 1. To implement a READONLY text widget (WITHOUT using "-state disabled") # - BLOCKS all attempts to modify content (via CONVENTIONAL subcmds) # + BUT implements ALTERNATIVE synonyms for use by OUR OWN code # # The REMAINING items are EXCLUSIVELY peculiar to the Primary L/R Widgets: # 2. To watch insert-cursor repositions and update the line comparison window # 3. To implement SAFE synchro-scrolling (AND when active) CDR autoselection # 4. To detect and initiate calculating INLINE diff tagging (when VISIBLE) # # N.B> #3 needs temporary deferral if TK hasnt yet fully updated line heights # yet; but #4 is PARTLY responsible for CAUSING the DELAY in handling #3 # AND (prior to TK8.6.5) there is no OFFICIAL way to quantify the delay! # # PRIOR to TK8.6.5, DETERMINING when TK is "busy" can only be approximated; # SOLUTION: # Created 'fake' widget subcmd SYNCbusy (+ its triggering mechanism) to form # a 'POLL mechanism' that SIMULATES (as best it can) WHEN the TK8.6.5 virtual # event <> SHOULD have occurred. Consider this as a BACKPORT # of the TK8.6.5 approach which AUTOMATICALLY disengages if USING >=TK8.6.5 ############################################################################### set textROfcn { global g w opts set This "[lindex [info level 0] 0]" ;# OUR proc name if {![set ThisID [string match {*left*} $This]]} { ;# (and matching ID) set ThisID 2 } set Othr [string map {right left left right} $This] ;# COMPANION proc name set Real "${This}_" ;# N.B> trailing underscore!! # SHADOWED proc name # N.B> (Not presently NEEDED, but "${Othr}_" WILL access OTHER REAL widget) set D -1 ;# Special Dbg "GROUP" force/enable/disable flag (1/0/-1 resp.) lassign $args a1 a2 a3 a4 ;# (to inspect upto first 4 args OF cmd) set result {} # Read-Only support: # Content modifications are DISALLOWED unless done with OUR "synonyms"... # (nothing more than simple capitalizations of the 'proper' subcmd) # Intent is to prevent modifications from unsanctioned sources (eg. User) # In simpler terms: your basic Read Only Text Widget # ('see' is included because it causes IMPLICIT scrolling, which # must block when it CO-EXISTS with actions that we ALWAYS block) # To MAP synonyms, a static list "w(ROsynonym)" was created ONCE, earlier. # # Beyond the 'Read-Only' synonyms, other 'FAKE' commands exist for special # purposes - yet, ALL such fakes are similarly CAPITALIZED to avoid # confusion with actual widget subcommands. # N.B> HOWEVER - NO fake OR synonym is EVER permitted to be ABREVIATED switch -glob $cmd { ALLOW { if {$a1 == "see" && $a2 in {1 0}} { # Fictitious command "ALLOW"s widget to permit 1 'see' to WORK set w(see$Real) $a2} { set w(see$Real) 0} # "ALLOW' is SPECIFIED on key bindings that PRECEED Class bind # scripts having EMBEDDED "see" actions. BOTH bindings fire in # SEQUENCE, thus only the ones WE 'ALLOW'ed can execute "see" } see { if {[info exists w(see$Real)] && $w(see$Real)} { # CONDITIONALLY permits operation (for certain Class Bindings # notably those providing keyboard insert-point navigation) set w(see$Real) 0 set result [$Real $cmd {*}$args] # ... else "see" IS BLOCKED (NO scrolling w/o our cooperation) # These generally occur as 'follow-on' actions attempting to # ensure visual feedback when TYPING (which *we* BLOCKED)! } { Dbg "$Real: ${cmd}(?): DENIED: ReadOnly" } # ({sniff...} Perfect place for a C-language fall-thru case!) } ins* - del* - r* { Dbg "$Real: $cmd: DENIED: ReadOnly" ;#(<==abbrev 'r'eplace) # BLOCKs actions (NOTHING changes w/o our cooperation) ######## This ENDS the essence of providing READONLY access. ######### # EVERYTHING BELOW is ALL 'special case' code peculiar to TkDiff # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # } t* { if {!$w(TK865) && $opts(showinline2)} { ;# (<==abbrev 't'ag) \ EMULATES triggering virtual event when using an OLDER TK # Monitor (real) tag manipulation subcmnds switch -glob "$a1$a2" { a*inlinetag - re*inlinetag - del*vL* - con*vL* { # catches "add/rem inlinetag" -OR- "conf/del vL" # ?? WHY NO 'remove vL*' ?? # ANY of which THEORETICALLY may change text heights # TECHNICALLY others exist, but THESE matter most to US # and the BACKPORT need not(?) worry about the others # # *BUT* - dont FLOOD the event queue with these (they # tend to occur in flurries) - Only need the FIRST that # would actually MODIFY our current state if {$w(SYNCnow) & $ThisID} { event gen $This <> -data 0 } } } } # Nonetheless, ALWAYS pass them directly to the REAL widget set result [$Real $cmd {*}$args] } SYNCnow { # The <> virtual event handler (ALL TK versions) # # Again, a 'FAKE' subcommand, intended to TRACK scroll usage # until BOTH (or either) Text widgets stop "adjusting" themselves # so ALIGNMENT can be UNEQUIVOCALLY obtained. # # The Virtual Event should be BOUND as to simply PASS its value: # bind $Wdg <> {%W SYNCnow %d} # # N.B> OLDER TK uses tag/SYNCbusy code to TRIGGER event creation # NEWER TK simply HAS the event builtin and sends by itself # TK8.6.5 protocol says we will see a %d=0 BEFORE %d=1 # # Translate args into our state-table indexing strategy # (N.B> we took a small liberty in that our emulation passes the # COUNT of SYNCbusy attempts instead of "1" for THIS Dbg) Dbg {<> [expr {"$a1"=={} ? "RQST" : $a1}] Side($ThisID)} $D if {"$a1" == ""} { set a1 3 } elseif {$a1} {set a1 $ThisID} if {$opts(syncscroll)} { set a2 7 } {set a2 0 } # Then lookup the NEW state, executing a RQST'd scroll as needed if {[set w(SYNCnow) \ [lindex $w(SYNCtbl) "$a1 ${ThisID}-1 $w(SYNCnow)+$a2"]] < 0} { ### State Table ### Msg Row Column YES set w(SYNCnow) [expr abs($w(SYNCnow))]; # Strip the RQST bit Dbg {\tSYNCnow FIRING as ($w(SYNCnow))} $D {} # FORCE the "alignment" scroll (at wherever we ARE just now) # This is actually a SAFE scroll because we are satisfying a # RQST that JUST THIS MOMENT showed as READY. Thus it WILL BE # READY when being processed, and CANT raise a RQST itself. # - INCLUDING its possible syncscroll partner. # $This yview [$Real index @0,0] ;# ORIG way # $Othr YVIEW moveto [lindex [$Real yview] 0];# ALT? way ${Othr}_ yview moveto [lindex [$Real yview] 0];# DIRECT way } # Return the PRESENT state value (in case anyone is watching) # N.B> as this GENERALLY runs by a bind script that mayn't CARE, # the only place it IS viewable is from that RQST requestor # BUT- alternate (commented-out) bind scripts ARE available return $w(SYNCnow) } SYNCbusy { # (DEFINED for PRE TK8.6.5) emulates WHEN to send <>=1 # Polls widget for APPARENT quiescence of computations based on # LACK of change in "Wdg yview" results. Wants CONSECUTIVE match # results(3) to qualify. Its the CALLERS responsibility to AVOID # invoking when using TK 8.6.5 (or greater). # lassign "[$Real yview] $a2 $a3 $a4 0 0 0" F1 F2 a2 a3 a4 incr a4 ;# (N.B> $a4 CAN be eliminated: only counts POLLs needed) if {$F1==$a2 && $F2==$a3} { if {[incr a1]==3} { event gen $This <> -data $a4 -when head set w($cmd$This) {} } { set w($cmd$This) [after 333 $This $cmd $a1 $F1 $F2 $a4]} } { set w($cmd$This) [after 333 $This $cmd 1 $F1 $F2 $a4]} Dbg "SYNCbusy Wdg.mtchd.try($ThisID.$a1.$a4)\n Prv\t$a2 $a3\n \ Cur\t$F1 $F2" $D } YVIEW { # PREVENTs a recursion-firestorm when opts(syncscroll) is true. # Invoked FROM the COMPANION widget to PERFORM a "dual scroll" # (or anytime we only want THIS SIDE to take action) # N.B> BEHAVES like a synonym, but RETAINS its "fake" cmd name # to let THIS widget still go thru visibility checks set result [$Real yview {*}$args] } default { set cmd [string map $w(ROsynonym) $cmd] # Only RECOGNIZED synonyms or ACTUAL cmds are ever PERFORMED ! # Synthetic ('FAKES') must be addressed ABOVE, not exec'd here set result [$Real $cmd {*}$args] } } # The rest of this code applies ONLY to the L/R main display windows: # (N.B> A Text widget NAMING vulnerability is exposed here) if {[string match {.client.[rl]*.text} $This]} { # If the Line comparison window is visible AND the window insertion # cursor MOVED to a NEW line, then update the comparison display if {$opts(showlineview) && $cmd == "mark" && $a1 == "set" && $a2 == "insert" && $w(bLnum) != [set i [file rootname [$Real index insert]]]} { # Remember the screenline number for next time, then update set w(bLnum) $i set left [$w(LeftText)_ get $i.0 $i.0lineend] set rght [$w(RightText)_ get $i.0 $i.0lineend] $w(BottomText) REPLACE 1.0 end "< $left\n> $rght" # find characters that are different, and hilite/tag them if {$left != $rght} { set c 2; # N.B> compensate for OUR "< " or "> " prefixes foreach l [split $left {}] r [split $rght {}] { if {[string compare $l $r] != 0} { $w(BottomText) tag add diff 1.$c "1.$c+1c" $w(BottomText) tag add diff 2.$c "2.$c+1c" } incr c } # but do not draw attention to either of the 'NL' chars $w(BottomText) tag remove diff "1.0 lineend" $w(BottomText) tag remove diff "2.0 lineend" } } # If the view has just CHANGED, its time for VISIBILITY-based tasks # (autoselect and/or INLINE scheduling) and/or syncscroll # # N.B> Beware the subtlty of this test - it tacitly applies to all # 'yview' subcmnds (EXCEPT the introspection one having NO ARGS); # # But ALSO permits 'Y* anything' (a synthetic YVIEW command) OR # "see" to 'slip thru', providing ACCESS to the following visibility # tasks EXCEPT the ability to notify the $Othr widget (-> syncscroll) if {([string match {[Yy]*} $cmd] || $cmd=="see") && $a1 != {}} { # First - if the scroll we JUST DID happenned during an UNSAFE # data period, then we want to ASK that a SECOND scroll be # PROVIDED when the data finally BECOMES stable. # N.B> choosing the Dbg variant simply REPORTs this new state if {!($w(SYNCnow) & $ThisID)} { $This SYNCnow ;# ONLY uncomment ONE!! # Dbg {\tSYNCnow([$This SYNCnow])} 1 {} ;# ONLY uncomment ONE!! } # Next find what PHYSICAL line range (inclusive) is visible # N.B> 10000 ensures we get the LAST-line despite window resizes set TpLn [file rootname [$Real index @0,0]] set BtLn [file rootname [$Real index @0,10000]] # When BOTH syncscroll and autoselect are ACTIVE, choose a NEW CDR if {$opts(syncscroll)} { if {$opts(autoselect) && $g(count) > 0 && $g(startPhase)>1} { # If probe point (Lnum at middle of window) yeilds a region # other than the CDR, AND some portion IS visible right NOW # it becomes the new CDR if {[set i [find-diff [expr ($TpLn+$BtLn)/2]]]!=$g(pos)} { lassign $g(scrInf,[hunk-id $i]) S E if {![set k [hCLIP $S $E $TpLn $BtLn]] || $k/4!=$k%4} { move $i 0 0 ;#N.B> (3rd arg 0) IGNORE repositioning } } } # CRITCAL design concept: Distinction between yview/YVIEW: # YVIEW will NOT induce the "Othr" side to "talk back" # Firestorm would OTHERWISE occur if a yview LEFTscroll was # allowed to CAUSE a yview RIGHTscroll, reversing infinitely if {$cmd=="yview"} { $Othr YVIEW {*}$args } } # PERFORMANCE hook: # Calc of INLINE diff markings, sadly, CAN be compute-intensive # # Accordingly, only DO them if KNOWN will be ONSCREEN (which both # limits AND distributes the time spent). Thankfully, once done, it # need not be calculated AGAIN until applicable UserPrefs change # (which sadly destroys ALL Calcs done to date); OR Split/Combine # manufactures a previously unknow hunk that is NOW "in-view" set INLsched 0 if {$opts(showinline2) && $g(count) > 0 && $g(startPhase)>1} { lassign "[find-diff $TpLn] [find-diff $BtLn]" i j while {$i <= $j} { lassign $g(scrInf,[set hID [hunk-id $i]]) S E if {[string match "*c*" $hID] && ![info exists g(inline,$hID)] && (![set k [hCLIP $S $E $TpLn $BtLn]] || $k/4 != $k%4)} { # Sentinel "empty list" simultaneously prevents FURTHER # scheduling while it exists; yet REMOVING it serves to # CANCEL any "already being-processed" requests set g(inline,$hID) [list] after idle inline-hunk ratcliff $hID sched $TpLn $BtLn 0 # Indicate we scheduled one or more items # (helps determine when SYNCbusy NEEDED, just below) incr INLsched Dbg "SCHEDULED inline $hID" $D } incr i } } # (PRE TK8.6.5): scrolls performed WHILE lineHeights ARE in flux or # WILL BE from any JUST Scheduled INLINING, need to detect when its # again safe (via POLLing) to perform one final ALIGNMENT scroll. # Scrolling BOTH sides (eg. syncscroll) can be even MORE critical # This initiates such POLLing to EMULATE a TK8.6.5 builtin feature. if {!$w(TK865) && (!($w(SYNCnow) & $ThisID) || $INLsched) && $w(SYNCbusy$This) == ""} { # N.B> when queued, are placed BEHIND any inlines SCHEDULED set w(SYNCbusy$This) [after idle $This SYNCbusy 0] if {$opts(syncscroll)} { set w(SYNCbusy$Othr) [after idle $Othr SYNCbusy 0] } } } } return $result } ############################################################################### # Perform inline data re-computation and/or re-tagging across ALL hunks ############################################################################### proc compute-inlines {optNam {flush 1}} { global g w opts # By default, remove ALL inline tags/data (so new ones MAY be added), # (skipped when specifically TOLD that none presently exist) if {$flush} { $w(LeftText) tag remove inlinetag 1.0 end $w(RightText) tag remove inlinetag 1.0 end array unset g "inline,*" # N.B> Unclear if all this CAUSES Vscroll to trigger on its own, which # MIGHT then reschedule a Ratcliff inlining, thereby restoring the # CORRECT view automatically - or if TK delays it -OR- causes it to # trigger when Vscroll is temporarily blocked. But it is the reason # WHY an extra 'vscroll tickle' was added into tail of "prefapply"! # UNCERTAIN if above untagging/unset cmd SEQUENCE might play a role Dbg "W I P E D inlines (ALL)" } # Compute inline data per requested algorithm style # # N.B> Ratcliff has become too compute-intensive to do ALL AT ONE time # (once we added semantic suppression categories). # Just leave them uncomputed and let $w(acTxWdg) scrolling do AS NEEDED. if {$optNam != "showinline2"} { foreach hID $g(diff) { # Remember: only chg-type hunks can EVER have inline diffs # (N.B> deskews when turning 'OFF' to clean-up after flush) # OTHERWISE generate NEW inline DATA, retag AND deskew if {[string match "*c*" "$hID"]} { if {$optNam == "off"} {de-skew-hunk $hID} { inline-hunk byte $hID 0 } } } # But KICK scroll to *LOOK* for Ratcliff (when ON); otherwise is a NOOP } { $w(acTxWdg) SEE @1,1 } } ############################################################################### # Compute, mark and deskew the inline-differences for a given SINGLE HUNK # IMPORTANT: # Depending on both style and effective SIZE of hunk, this proc MAY BE # re-scheduled to work its way thru large Ratcliff-based hunks in segments. # The GUI stays operational, but may feel slightly SLUGGISH until completion. ############################################################################### proc inline-hunk {style hID args} { global g w set D -1 ;# Dbg "GROUP" force/enable/disable flag (1/0/-1 resp.) # First, protect against the hunk DISAPPEARING during CHAINED processing, # - OR if an INPROGRESS calc must restart because its attributes changed. # Otherwise establish default initial values if {![info exists g(scrInf,$hID)] || ([lindex $args end] && ![info exists g(inline,$hID)])} { Dbg " Inline ABORTED" $D ; return } { # Default calcs ALL lines (First->Lim), displaying when 'Lim' reached # (AFTER getting last UN-padded Lnum, to assess active size of hunk) lassign $g(scrInf,$hID) Ls Le P(1) na na P(2) set Lim [set Last [expr {$P(1) ? $Le-$P(1) : $Le-$P(2)}]] lassign "0 $Ls 0 5" First Dsply Wrap heuristic # N.B.> 'First': remains as an INDEX until calcs begin; a LNUM after # 'heuristic': must be MANUALLY tuned for GUI responsiveness } # Ratcliff algorithm CAN require CHAINED processing to maintain UI response # So limit calcs to a NEXT (or final) HUERISTIC-based PORTION of the data # N.B> But arrange to get VISIBLE tagging done BEFORE most OFFSCREEN ones # by MAYBE splitting hunk into two BLOCKS (tail-first, then head) # (makes us look more responsive than we really are) # # Key items being juggled below (in passed order) are: # Cmd - which BLOCK (head/tail) we are processing per chained iteration # Wrap - (!0) OFFSET where we STARTED the 'tail' portion (IFF done first) # Lim - endpoint (inclusive) LNUM of current PORTION # Dsply - LNUM where we should begin Tagging (endpt is heuristic based) # Last - hard endpoint (inclusive) LNUM where current 'Cmd' terminates # First - OFFSET into hunk where CURRENT calculations should begin # This basically "orients" the data to acheive a visual speed illusion # Will sequence as: sched -> tail* -> (wrap to) head* -> done # OR sched -> head* -> done # Where '*' means distinct (REPEATING) heuristic-derived Calcs + Tagging # # RECOVER the 6 values from PRIOR chained-portion and adjust as necessary if {$style == "ratcliff"} { switch [lindex $args 0] { sched { lassign $args Cmd Wmin Wmax # N.B> 'sched' is the PRIMARY entry point (from scroll tracking) Dbg {: $hID} $D "SCHEDULING" # Derive which strategy for the PORTION that gets displayed first # Test looks for hunk SPANNING window top edge: ('tail' strategy) # CRITICAL: Vars are CURRENTLY set as for the 'head' strategy! if {$Ls < $Wmin && $Le <= $Wmax && $Le >= $Wmin} { set First [expr $Wmin-$Ls] ;# adjust to begin @1st visible line # ALSO sets Wrap as eventual 'First' AFTER 'wrapping' to 'head' lassign "tail $First $Wmin $Last" Cmd Wrap Dsply } { set Cmd "head" } # (mnemonics: WrapIdx Lim Dsply@ Last@ 1stIdx Dbg {: $Cmd Wi$Wrap Lm$Lim D@$Dsply L@$Last Fi$First} $D "PERFORM as" } tail { lassign $args Cmd Wrap Lim Dsply tLast First # Watch for when to "wrap" to the 'head' approach (and cancel Wrap) if {$First + $Ls > $Lim} { lassign "head 0 $Last $Ls 0" \ Cmd Wrap Lim Dsply First Dbg {: $Cmd $Wrap $Lim $Dsply $Last $First} $D "REwritten as" # otherwise simply MAINTAIN 'tail' viewpoint for affected Vars } { set Last $tLast } } head { lassign $args Cmd Wrap Lim Dsply Last First # Just keep USING values which were passed till done }} # Finally, APPLY the heuristic to keep the UI responsive throughout if {$First + $Ls + $heuristic < $Lim} { set Lim [expr $First + $Ls - 1 + $heuristic] } } else { Dbg "hID($hID) is @ SCREEN line #$Ls (for Lnum correlation)" $D } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Perform the CURRENT inline difference calculation (for EITHER style) # N.B> Note subtle transform of 'First' from Hunk offset into LineNum for {set i [incr First $Ls]} {$i <= $Lim} {incr i} { inline-$style $hID [expr $i - $Ls] \ [$w(LeftText) get $i.0 $i.end] [$w(RightText) get $i.0 $i.end] Dbg {Calc'd Lnum $i (Ofst [expr $i-$Ls]) until Lim ($Lim)} $D } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # if {$style=="ratcliff"} { # Place an EARLY SUBSET of tags onscreen NOW ? Dbg {?DISPLAY?: i($i) Lim($Lim) Last($Last) Dsply($Dsply)} $D if {$i < $Last && $i > $Dsply + ($heuristic * 2)} { remark-inline $hID $Dsply [incr Dsply [expr ($heuristic * 3) - 1]] incr Dsply ; # Further-adjust for FUTURE display start positions # Otherwise just flush whatever remains when endpoint is hit } elseif {$i > $Last} { remark-inline $hID $Dsply $Last } { Dbg " : NOT DONE" $D } # Reschedule any REMAINING portion into a CHAINED timeslot (as needed) # N.B> Sends current (w/reset Lim) values (NXT iteration will readjust) if {$i <= $Last || $Wrap} { after 25 inline-hunk $style $hID \ $Cmd $Wrap $Last $Dsply $Last [expr $i-$Ls] } { Dbg " Inline completed" $D } } { remark-inline $hID } } ############################################################################### # Functionality: Inline diffs # Athr: Michael D. Beynon : mdb - beynon@yahoo.com # Date: 04/08/2003 : mdb - Added inline character diffs. # 04/16/2003 : mdb - Rewrote longest-common-substring to be faster. # - Added byte-by-byte algorithm. # 08Oct2017 : mpm - Simplified byte-by-byte alg. # - Revised generated output data format (both alg.) # 12Jun2018 : mpm - Rewrote lcs-string (again) to be even faster. # # The recursive version is derived from the Ratcliff/Obershelp pattern # recognition algorithm (Dr Dobbs July 1988), where we search for a longest # common substring between two strings. This match is used as an anchor, # around which we recursively do the same for the two left and two right # remaining substrings (omitting the anchor). # This precisely determines the location of the intraline tags. # # 05Sep2021 : mpm - Redesigned to allow semantic-matching within the LCS # 19Mar2022 : mpm - Re-engineer to ADD mistakenly NONhandled "-E" option # # (L)ongest (C)ommon (S)ubstring WITH (v)arying (b)lank/(c)ase Support # Emulates the following optional Diff MATCH-SUPPRESSION options: # -i Case insensitivity (Cign) # -w Any WhtSpc at all (Wign) # -b Paired WhtSpc of different lengths (Wcnt) # -E Paired WhtSpc ending @COMMON Column (Wtab) # -Z WhtSpc at E-O-Line (Weol) (but see initialization) # ### N.B> C R I T I C A L: caller at LIBERTY to INTERCHANGE all (1<->2) AT WILL! proc LCSvbc {ops s1 of1 ln1 SP1 M1eol LCSB1 LCSE1 s2 of2 ln2 SP2 M2eol LCSB2 LCSE2} { upvar $LCSB1 LcsB1 $LCSE1 LcsE1 ;# LONGER exemplar str (eg. haystack) upvar $LCSB2 LcsB2 $LCSE2 LcsE2 ;# SHORTER exemplar str (eg. needle ) # Initializations (N.B> Bit(1)==Weol was handled by 'inline-ratcliff') lassign "[expr $of1+$ln1] [expr $of2+$ln2] 0 16 8 4 2" \ M1 M2 best Cign Wign Wcnt Wtab # Basis of loops is to proceed similar to that of "strstr(haystack,needle)", # but looking for ANY/EVERY POSSIBLE SUBSTR within both strings to "match", # PLUS the rules for matching are OPTIONALLY more semantic than "identical". # Loop structure: 1st steps through s1 (once); 2nd thru s2 (repetitively); # 3rd simply "matches" next avail char (or meta-group) # 'Continue's indicate EXTENDING the current match; 'break' is can't. # Outer 2 loops abort when remaining bytes incapable of a NEW 'best' # 'SkpN's REMOVE one entire MATCH-element PREFIX (often 1 char) for {lassign "$of1 $of1" S1 E1} { $E1 < ($M1-($ln2<$best ? $best-$ln2:0))} { set E1 [incr S1 [expr ($skp1 ?$skp1:1)]]} { for {lassign "$of2 $of2 0" S2 E2 skp1} { $E2 < ($M2-($ln2<$best ? 0:$best))} { set E2 [incr S2 [expr ($skp2 ?$skp2:1)]]} { for {lassign "$S1 0" E1 skp2} { $E1 < $M1 && $E2 < $M2} { set skp2 [expr ($skp2 ? $skp2 : $E2-$S2)] set skp1 [expr ($skp1 ? $skp1 : $E1-$S1)]} { # We build a LCS one matched ITEM (often a single char) at a # time, *BUT* Tcl is NOT very adept at "aggregate expressions" # - so we PRE-DERIVED certain key values needed. Go GRAB them # (as SPARINGLY as possible), starting w/actual CHARs + if its # WhtSpc (<0) and/or its EFFECTIVE Column position, EXPRESSED # as MAGNITUDE only - (BECAUSE WhtSpc is coded AS NEGATIVE!). set C1 [string index $s1 $E1] ; set C1sp [lindex $SP1 $E1] set C2 [string index $s2 $E2] ; set C2sp [lindex $SP2 $E2] # WhtSpc (INSIGNIFICANT or NON-EXISTENT) ####### # aka - Identical matching and/or # Capitalization meaningless (diffopt: -i) ##### if {($C1sp>0 && $C2sp>0) || !($ops&14)} { for {set i 0} {$E1<$M1 && $E2<$M2 && ("$C1"=="$C2" || ($ops&$Cign && [string tolower "$C1"] == [string tolower "$C2"]))} { incr i } { set C1 [string index $s1 [incr E1]] set C1sp [lindex $SP1 $E1] set C2 [string index $s2 [incr E2]] set C2sp [lindex $SP2 $E2] } # CONTINUE presuming we collect ANTHING contiguously... if {$i} { # When WhtSpc suppression is active but STOPS ON one, # 'backing-up' 1 position (IFF WAS a WhtSpc MATCH) # makes NEXT CYCLE simpler to parse AFTER we continue. if {$E1<$M1 && $E2<$M2 && ($ops&14) && (($C1sp<0) ^ ($C2sp<0)) && [lindex $SP1 $E1-1]<0} { incr E1 -1; incr E2 -1 } continue } # WhtSpc ############### # totally meaningless (diffopt: -w) -OR- # count Varying meaningless (diffopt: -b) } elseif {($ops&$Wign && (($C1sp<0) || ($C2sp<0))) || ($ops&$Wcnt && $C1sp<0 && (($C1sp<0) == ($C2sp<0)))} { while {$E1 < $M1 && $C1sp<0} { set C1sp [lindex $SP1 [incr E1]] } while {$E2 < $M2 && $C2sp<0} { set C2sp [lindex $SP2 [incr E2]] } continue; # Columnar aligned meaningless (diffopt: -E) ##### } elseif {$ops&$Wtab && $C1sp<0 && $C2sp<0} { # First PROBE where EACH WhtSpc ENDS ... for {set j [set i 0]} \ {$E1+$i<$M1 && [lindex $SP1 $E1+$i]<0} \ {incr i} {set j $i} for {set k [set i 0]} \ {$E2+$i<$M2 && [lindex $SP2 $E2+$i]<0} \ {incr i} {set k $i} # ... and if thats the SAME COLUMN - it MATCHED if {[lindex $SP1 $j] == [lindex $SP2 $k]} { incr E1 $j ; incr E2 $k ; continue } # any @EOL meaningless (diffopt: -Z) ##### # (PRE-handled at initialization) } break; # <<==-- ITEM did *N O T* Match ############## } # Record best seen (based on len of consumed bytes from BOTH strs) # (position values noted are ABSOLUTE within each ORIGINAL string # representing the byte where marking turns ON and then, OFF) if {[set i [expr $E1-$S1]] + [set j [expr $E2-$S2]] > $best} { set LcsE1 [expr [set LcsB1 $S1] + $i] set LcsE2 [expr [set LcsB2 $S2] + $j] set best [expr [set skp1 $i] + $j] # Altering skp1 AVOIDS time spent on ONLY(?) fail attempts... break ;# ... BREAKING here allows that to take effect NOW } } } return $best } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Recursive Ratcliff/Obershelp DFS walk mechanism # N.B> UNLIKE 'LCSvbc' above, these are THE REAL (1<->2) based variable sets # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # proc ROwalk {hID pairID ops s1 off1 len1 SP1 M1eol s2 off2 len2 SP2 M2eol} { global g # Bgn[12]/End[12] demarcate where LCS was FOUND in EACH string # (N.B> due to semantic 'ops', they might NOT be a common length) lassign {0 0 0 0 0} Bgn1 End1 Bgn2 End2 cnt if {$len1>0 && $len2>0} { # LCS Alg wants the LONGER string as its first argset, # (eg. XXX(haystack, needle) # (while not (strictly) commutative, it *IS* deterministic # and WILL tend to execute quicker when configured this way) if {$len2 < $len1} { set cnt [LCSvbc $ops $s1 $off1 $len1 $SP1 $M1eol Bgn1 End1 \ $s2 $off2 $len2 $SP2 $M2eol Bgn2 End2] } else { set cnt [LCSvbc $ops $s2 $off2 $len2 $SP2 $M2eol Bgn2 End2 \ $s1 $off1 $len1 $SP1 $M1eol Bgn1 End1] } # A ZERO indicates no 'LCS' AT ALL between s1/s2; otherise do the left # AND right substring-pairs lying to EACH side of the LCS (if present) if {$cnt > 0} { if {$Bgn1 > $off1 || $Bgn2 > $off2} { # left incr cnt [ROwalk $hID $pairID $ops \ $s1 $off1 [expr $Bgn1-$off1] $SP1 $M1eol\ $s2 $off2 [expr $Bgn2-$off2] $SP2 $M2eol] } if {$End1<$off1+$len1 || $End2<$off2+$len2} { # right incr cnt [ROwalk $hID $pairID $ops \ $s1 $End1 [expr $off1+$len1-$End1] $SP1 $M1eol\ $s2 $End2 [expr $off2+$len2-$End2] $SP2 $M2eol] } } } # When one or both strings do not subdivide, the REMAINDER becomes marked # Yet option "-w"(8) can STILL affect WHICH chars to NOT mark # RIGHT-side markings: if {$len2>0 && ($len1<1 || !$cnt)} { # Continue processing further for "-w" (aka Wign) if {($ops & 8)} { for {incr len2 $off2} {[set mark $off2] < $len2} {} { if {[string is space [string index $s2 $off2]]} { incr off2 ; continue } while {($off2 < $len2) && ![string is space [string index $s2 $off2]]} { incr off2} lappend g(inline,$hID) r $pairID $mark $off2 } } elseif {$len2} {lappend g(inline,$hID) r \ $pairID $off2 [expr $off2+$len2]} } # LEFT-side markings: if {$len1>0 && ($len2<1 || !$cnt)} { # Continue processing further for "-w" (aka Wign) if {($ops & 8)} { for {incr len1 $off1} {[set mark $off1] < $len1} {} { if {[string is space [string index $s1 $off1]]} { incr off1 ; continue } while {$off1 < $len1 && ![string is space [string index $s1 $off1]]} {incr off1} lappend g(inline,$hID) l $pairID $mark $off1 } } elseif {$len1} {lappend g(inline,$hID) l \ $pairID $off1 [expr $off1+$len1]} } return $cnt } ############################################################################### # Gateway to the Ratcliff/Obershelp Alg. for marking inline differences # Returns COUNT of "matched" chars - if ==L1+L2 then lines considered identical ############################################################################### proc inline-ratcliff {hID pairID s1 s2} { global g opts if {![set L1 [string length $s1]] || ![set L2 [string length $s2]] } { return 0 } # To AVOID excessive repetition of certain derivations (WhtSpc/Columns) we # do them ONCE here and PROVIDE them for usage later. # Create PARALLEL-indexed lists that denote what COLUMN number each char # represents AND if that char *is* WhtSpc (negative==YES) or not. set Tsz $opts(tabstops) set col 0 # Do ONCE for the first string ... foreach ch [split $s1 {}] { if {[string is space $ch]} { lappend SP1 -[incr col [expr ("$ch"=="\t"? $Tsz-($col%$Tsz):1)]] } { lappend SP1 [incr col] } } # ... and again for the other string set col 0 foreach ch [split $s2 {}] { if {[string is space $ch]} { lappend SP2 -[incr col [expr ("$ch"=="\t"? $Tsz-($col%$Tsz):1)]] } { lappend SP2 [incr col] } } # Dispense with the ENTIRE "-Z" suppression category IMMEDIATELY (if reqd) # (remember to collect the count of 'matched' chars) set col 0 if {$opts(inlSuprs)&1} { while {$L1 && [lindex $SP1 $L1-1]<0} {incr L1 -1 ; incr col} while {$L2 && [lindex $SP2 $L2-1]<0} {incr L2 -1 ; incr col} } # THEN begin the Algorithm PASSING all the info it needs # N.B> Return code is a count of matched bytes incr col [ROwalk $hID $pairID $opts(inlSuprs) \ $s1 0 $L1 $SP1 $L1 $s2 0 $L2 $SP2 $L2] return $col } ############################################################################### # Gateway to the (rather simplistic) "Byte" Alg. for marking inline differences # Returns NON-zero count of total items marked ############################################################################### proc inline-byte {hID pairID s1 s2} { global g if {![set len1 [string length $s1]] || ![set len2 [string length $s2]] } { return 0 } set lenmin [min $len1 $len2] set cnt 0 set size 0 for {set i 0} {$i <= $lenmin} {incr i} { if {[string index $s1 $i] == [string index $s2 $i]} { # start/continue a NON-diff region if {$size} { # which ENDS a diff region lappend g(inline,$hID) r $pairID [expr $i-$size] $i lappend g(inline,$hID) l $pairID [expr $i-$size] $i set size 0 incr cnt } } else { incr size } } if {$size} { # ended in a diff region lappend g(inline,$hID) r $pairID [expr $i-$size] $len2 lappend g(inline,$hID) l $pairID [expr $i-$size] $len1 incr cnt } return $cnt } ############################################################################### # create (if necessary) and show the find dialog ############################################################################### proc srch-text {} { global g w if {![Dialog NONMODAL $w(srch)]} { wm title $w(srch) "$g(name) Find" wm transient $w(srch) . wm group $w(srch) . # we don't want the window to be deleted, just hidden from view wm protocol $w(srch) WM_DELETE_WINDOW {Dialog dismiss $w(srch)} frame $w(srch).content -bd 2 -relief groove pack $w(srch).content -side top -fill both -expand y -padx 0 -pady 5 frame $w(srch).buttons pack $w(srch).buttons -side bottom -fill x -expand n set wrapd [message $w(srch).buttons.msg -aspect 1000] button $w(srch).buttons.doit -text "Find Next" -command "srchit $wrapd" button $w(srch).buttons.dismiss -text "Dismiss" \ -command { Dialog dismiss $w(srch) $w(acTxWdg) yview [$w(acTxWdg) index @0,0] } pack $w(srch).buttons.dismiss -side right -pady 5 -padx 0 pack $w(srch).buttons.doit -side right -pady 5 -padx 1 pack $w(srch).buttons.msg -side left -expand 1 -pady 5 -padx 1 set ff $w(srch).content.findFrame frame $ff -height 100 -bd 2 -relief flat pack $ff -side top -fill x -expand n -padx 0 -pady 5 label $ff.label -text "Find what:" -underline 2 entry $ff.entry -textvariable g(findString) checkbutton $ff.searchCase -text "Ignore Case" -indicatoron true \ -variable g(findIgnoreCase) -offvalue "" -onvalue "-nocase" checkbutton $ff.keepSyncd -text "Stay Sync'd" -indicatoron true \ -variable g(staySyncd) -offvalue 0 -onvalue 1 grid $ff.label -row 0 -column 0 -sticky e -rowspan 2 grid $ff.entry -row 0 -column 1 -sticky ew -rowspan 2 grid $ff.searchCase -row 0 -column 2 -sticky nw grid $ff.keepSyncd -row 1 -column 2 -sticky sw grid columnconfigure $ff 0 -weight 0 grid columnconfigure $ff 1 -weight 1 grid columnconfigure $ff 2 -weight 0 # we need this in other places... set w(findEntry) $ff.entry bind $ff.entry "srchit $wrapd" set of $w(srch).content.optionsFrame frame $of -bd 2 -relief flat pack $of -side top -fill y -expand y -padx 10 -pady 10 label $of.directionLabel -text "Search Direction:" -anchor e radiobutton $of.directionForward -text "Down" -indicatoron true \ -variable g(findDirection) -value "-forward" radiobutton $of.directionBackward -text "Up" -indicatoron true \ -variable g(findDirection) -value "-backward" label $of.windowLabel -text "Window:" -anchor e radiobutton $of.windowLeft -text "Left" -indicatoron true \ -variable w(acTxWdg) -value $w(LeftText) radiobutton $of.windowRight -text "Right" -indicatoron true \ -variable w(acTxWdg) -value $w(RightText) label $of.searchLabel -text "Search Type:" -anchor e radiobutton $of.searchExact -text "Exact" -indicatoron true \ -variable g(findType) -value "-exact" radiobutton $of.searchRegexp -text "Regexp" -indicatoron true \ -variable g(findType) -value "-regexp" grid $of.directionLabel -row 1 -column 0 -sticky w grid $of.directionForward -row 1 -column 1 -sticky w grid $of.directionBackward -row 1 -column 2 -sticky w grid $of.windowLabel -row 0 -column 0 -sticky w grid $of.windowLeft -row 0 -column 1 -sticky w grid $of.windowRight -row 0 -column 2 -sticky w grid $of.searchLabel -row 2 -column 0 -sticky w grid $of.searchExact -row 2 -column 1 -sticky w grid $of.searchRegexp -row 2 -column 2 -sticky w grid columnconfigure $of {0 1} -weight 0 grid columnconfigure $of 2 -weight 1 set g(findType) "-exact" set g(findDirection) "-forward" set g(findIgnoreCase) "-nocase" set g(lastSearch) "" # TENTATIVELY try for Text window (PROVIDED it HAS the focus) # (N.B> remember its TRACED to only PERMIT setting BY a TextWdg) set w(acTxWdg) [focus] # On creation, flop it centerred (then let user put it anywhere) centerWindow $w(srch) } # Only config on (re)display is to ensure message starts empty $w(srch).buttons.msg configure -text {} # Put it onscreen (NON MODAL) Dialog show $w(srch) $w(findEntry) } ############################################################################### # do the "Edit->Copy" functionality, by copying the current selection # to the clipboard ############################################################################### proc do-copy {} { clipboard clear -displayof . # figure out which window has the selection... catch { clipboard append [selection get -displayof .] } } ############################################################################### # search for the text in the find dialog ############################################################################### proc srchit {wrapWdg} { global g w if {[set win $w(acTxWdg)] == "$w(LeftText)"} { set Otherwin $w(RightText) } { set Otherwin $w(LeftText) } if {$g(lastSearch) != ""} { if {$g(findDirection) == "-forward"} { set start [$win index "insert +1c"] } { set start insert } } { set start 1.0 } # Eval needed as findIgnoreCase may turn into an EMPTY (eg. NON) Arg set result [eval $win search $g(findDirection) $g(findType) \ $g(findIgnoreCase) -- $g(findString) $start] if {[string length $result] > 0} { $wrapWdg configure -text {} # if this is a regular expression search, get the whole line and try # to figure out exactly what matched; otherwise we know we must # have matched the whole string... if {$g(findType) == "-regexp"} { set line [$win get $result "$result lineend"] if {$g(findIgnoreCase)} { regexp -nocase -- $g(findString) $line matchVar } { regexp -- $g(findString) $line matchVar } set length [string length $matchVar] } { set length [string length $g(findString)] } set g(lastSearch) $result $win mark set insert $result $win tag remove sel 1.0 end $win tag add sel $result "$result + ${length}c" $win SEE $result if {$g(staySyncd)} { $Otherwin YVIEW [$win index @0,0] } focus $win } { bell ;# MAY be SILENT? (thats Annoying); Visually hint we found NADA! $wrapWdg configure -text {Nothing found} -bg Tomato after 1250 $wrapWdg config -bg $w(bgnd) -text {{Next attempt restarts}} set g(lastSearch) {} } } ############################################################################### # Build the menu bar AND the popup menu (Do AFTER client has been built) ############################################################################### proc build-menus {} { global g w opts finfo # We are building TWO distinct menu TREEs here: popUp and menuBar # Generate THEM and then we can let the factory build them all out # N.B> menubar is strange in that it LACKS a native way to indicate it HAS # focus - hence the elaborate 'takefocus'-proc to provide SOME visual # feedback (the activebackg) that you've TAB'd to the right place!! # The 'bind' simply exists to extinguish the feedback on a next TAB # (but DEPENDS on the TK IMPLEMENTATION of that named virtual event) set pM [menu $w(popupMenu)] set mB [menu $w(menubar) -activebackg $w(selcolor) -takefocus \ {apply {wdg { return [expr {[$wdg activate 0]=={}}] }}}] bind $mB <> { %W activate none } # Export NAMING of cascaded nodes (factory uses the short local synonyms) # N.B> do NOT pre-CREATE such menus - Factory will do that set w(fileMenu) [set fM $w(menubar).file] set w(multiFileMenu) [set mFM $fM.multi] set w(viewMenu) [set vM $w(menubar).view] set w(helpMenu) [set hM $w(menubar).help] set w(editMenu) [set eM $w(menubar).edit] set w(mergeMenu) [set gM $w(menubar).merge] set w(markMenu) [set mM $w(menubar).marks] # Data specification for driving the MENU building Factory ############################################################# # Menu Type Label { positional type-specific args } # Ul: underline # Mu: menu # Items enclosed in [ ] Cm: command # are optional as Ac: accelerator-link # depicted Vr: state-variable # Ov: ON-value # Tp: Tooltip text # # # # # # # # # # # # # # # # # .abc separator {} { } # .def cascade Lb { Ul Mu [Tp] } # .mno command Lb { Ul Cm [Ac] [Tp] } # .xyz checkbutton Lb { Ul [Cm] [Ac] Vr Ov Tp } foreach {Mu Ty Lb Ul} [subst -nocommands { $pM comm "First Diff" {0 {move first} navFrst} $pM comm "Previous Diff" {0 {move -1} navPrev} $pM comm "Center Current Diff" {0 {centerCDR} navCntr} $pM comm "Next Diff" {0 {move 1} navNext} $pM comm "Last Diff" {0 {move last} navLast} $pM separator {} {} $pM comm "Find Nearest Diff" \ {13 {moveNearest \$w(mPopW) menu \$w(mPopX) \$w(mPopY)}} $pM separator {} {} $pM comm "Find..." {1 {srch-text} genFind} $pM comm "Edit" {0 {do-edit \$w(mPopX) \$w(mPopY)} genEdit} $pM separator {} {} $pM comm "Copy Selection" {5 {do-copy} } $mB casc "File" {0 $fM} $fM comm "New..." {0 "do-new-diff" {} "Select new input parameters and compute a new Diff"} $fM casc "File List" {5 $mFM "Choose a different file pair from those derived from the present input"} $mFM comm "Reconfig Threshold..." {0 {multiFile dialog 1} {} "Adjust where filelist is displayed (menu or dialog)"} $mFM comm "Previous File" {0 {multiFile prev} genPvfile "Choose the previous file pair"} $mFM comm "Next File" {1 {multiFile next} genNxfile "Choose the next file pair"} $fM separator {} {} $fM comm "Recompute Diffs" {0 {reCalcD user} genRecalc "Recompute all difference regions for the current file"} $fM separator {} {} $fM comm "Write Report..." {0 {rpt-gen popup} {} "Configure and produce Diff textual content and statistical output"} $fM separator {} {} $fM comm "Exit" {1 {do-exit} genXit "Immediately terminate $g(name)"} $mB casc "Edit" {0 $eM} $eM comm "Copy" {0 {do-copy} {} "Copy the currently selected text to the clipboard"} $eM separator {} {} $eM comm "Find..." {0 {srch-text} genFind "Pop up a dialog to search for a string within either file"} $eM separator {} {} $eM comm "Ignore CDR" {0 {ignore-hunk} {} "Suppress the CDR to no longer be seen as a Difference region"} $eM comm "Split..." {0 {splcmbDlg 0} {} "Split the current diff at specified bounds"} $eM comm "Combine..." {2 {splcmbDlg 1} {} "Combine the current diff region with ADJACENT neighbor(s)"} $eM separator {} {} $eM comm "Edit File 1" {10 \ {do-edit [winfo rootx $w(LeftText)].0 [winfo rooty $w(LeftText)].0} {} "Launch an editor for the left side File"} $eM comm "Edit File 2" {10 \ {do-edit [winfo rootx $w(RightText)].0 [winfo rooty $w(RightText)].0} {} "Launch an editor for the right side File"} $eM separator {} {} $eM comm "Preferences..." {0 {customize} {} "Pop up a window to customize $g(name)"} $mB casc "View" {0 $vM} $vM checkb "Utilize Suppressions" {0 {reCalcD ignSuprs RevAlgn} {} opts(ignSuprs) 2 "If set, applys suppression options during the Diff"} $vM checkb "Ignore Blank Lines" {7 {reCalcD ignoreEmptyLn RevAlgn} {} opts(ignoreEmptyLn) 8 "If set, suppress empty lines from becoming a Diff"} $vM checkb "Ignore RE-matched Lines" {7 {reCalcD ignoreRegexLn RevAlgn} {} opts(ignoreRegexLn) 4 "If set, suppress Diffs from lines matching Regular Expression(s)"} $vM separator {} {} $vM checkb "Show Line Numbers" {3 {do-show-Info showln} {} opts(showln) 1 "If set, show line numbers beside each line of each file"} $vM checkb "Show Change Bars" {6 {do-show-Info showcbs} {} opts(showcbs) 1 "If set, show the changebar column for each line of each file"} $vM checkb "Show Diff Map" {10 {do-show-map} {} opts(showmap) 1 "If set, display the graphical 'Diff Map' in the center of the display"} $vM checkb "Auto Center" \ {0 {if {\$opts(autocenter)} {centerCDR}} {} opts(autocenter) 1 "If set, moving to another diff region centers the diff on the screen"} $vM checkb "Auto Select" {6 {} {} opts(autoselect) 1 "If set, automatically selects the nearest diff region while scrolling"} $vM checkb "Show Line Comparison Window" \ {21 {do-show-lineview} {} opts(showlineview) 1 "If set, display the window with byte-by-byte differences"} $vM checkb "Show Inline Comparison (byte)" \ {26 {do-show-inline showinline1} {} opts(showinline1) 1 "If set, display inline byte-by-byte differences"} $vM checkb "Show Inline Comparison (recursive)" \ {31 {do-show-inline showinline2} {} opts(showinline2) 1 "If set, display inline recursive based differences"} $vM separator {} {} $vM checkb "Synchronize Scrollbars" {0 {} {} opts(syncscroll) 1 "If set, scrolling either window will scroll both windows"} $vM separator {} {} $vM comm "First Diff" {0 {move first} navFrst "Go to the first difference"} $vM comm "Previous Diff" {0 {move -1} navPrev "Go to the diff region just prior to the current diff region"} $vM comm "Center Current Diff" {0 {centerCDR} navCntr "Center the display around the current diff region"} $vM comm "Next Diff" {0 {move 1} navNext "Go to the diff region just after the current diff region"} $vM comm "Last Diff" {0 {move last} navLast "Go to the last difference"} $mB casc "Mark" {3 $mM} $mM comm "Bookmark Current Diff" {0 {bkmark creat} {} "Create a Bookmark for the current difference region"} $mM comm "Clear Current Bookmark" {0 {bkmark erase} {} "Clear the Bookmark for the current difference region"} $mB cascade "Merge" {0 $gM} $gM checkb "Show Merge Window" {9 {do-show-merge 1} {} g(showmerge) 1 "Pops up a window showing the current merge results"} $gM comm "Write Merge File..." {6 {merge-write-file} {} "Write the merge file to disk AFTER confirming the filename first"} $mB cascade "Help" {0 $hM} $hM comm "On Concepts+Syntax" {3 {help-concept gui} {} "Show help on the command line arguments"} $hM comm "On GUI" {3 {help-GUI} {} "Show help on how to use the Graphical User Interface"} $hM comm "On Preferences" {3 {help-prefs} {} "Show help on the user-settable preferences"} $hM separator {} {} $hM comm "About $g(name)" {0 {about-TkD} {} "Show information about this application"} $hM comm "About Wish" {6 {about-wish} {} "Show information about the TK Windowing-Shell (Wish)"} $hM comm "About Diff" {6 {about-diff} {} "Show information about the diff-engine"} }] { # THIS is the MENU factory (which processes the above list) # N.B> for those items HAVING accelerators, THEY will be attached # LATER - all we do NOW is DEFINE to which menuItems they should GO switch -glob $Ty { ca* { lassign $Ul Ul mU Tp $Mu add cascade -label $Lb -underline $Ul -menu [menu $mU] if {$Tp!={}} { set g(tooltip,$Lb) "$Tp" } } co* { lassign $Ul Ul Cm Ac Tp $Mu add command -label $Lb -underline $Ul -command $Cm if {$Ac!={}} { lappend w(Accel,$Ac) $Mu [$Mu index end] } if {$Tp!={}} { set g(tooltip,$Lb) "$Tp" } } ch* { lassign $Ul Ul Cm Ac Vr Ov Tp $Mu add checkbutton -label $Lb -underline $Ul -vari $Vr -onval $Ov if {$Ac!={}} { lappend w(Accel,$Ac) $Mu [$Mu index end] } if {$Cm!={}} { $Mu entryconfig [$Mu index end] -command $Cm } set g(tooltip,$Lb) "$Tp" } s* { $Mu add separator } } } ### Silly extra things easier to do from OUTSIDE the factory... # # Alternate tooltip (for when TkDiff REMOVES the "..." from the label) set "g(tooltip,Write Merge File)" \ "Write the merge file to disk USING the command line specified name" # It is not readily apparent that the first 3 View Menu items will FORCE # a Diff to occur - try to (subtley) warn the user of this with a HILITE verify alertD pushtomenu $vM # And this simply ISN'T a user-modifiable binding (as expected by factory) $pM entryconfigure "Find Near*" -accelerator "Dbl-Click" # Establish the bindings to provide menuItem Tooltips foreach m "$fM $mFM $eM $vM $mM $gM $hM" { bind $m <> {showTooltip menu %W} } } ############################################################################### # Show explanation of an item (menu/toolbutton) in the status bar at the bottom # PRIMARILY used only for menu items: # Still works for buttons PROVIDED 'set_tooltips' was NOT CALLED for a popup # (for us, thats the Bookmark toolbuttons) ############################################################################### proc showTooltip {type wdg} { global g switch -- $type { menu { if {[catch {$wdg entrycget active -label} label]} { set label "" } if {[info exists g(tooltip,$label)]} { set g(statusInfo) $g(tooltip,$label) } else { set g(statusInfo) $label } } button { if {[info exists g(tooltip,$wdg)]} { set g(statusInfo) $g(tooltip,$wdg) } else { set g(statusInfo) "" } } } update idletasks } ############################################################################### # Build the toolbar, in text and/or image mode ############################################################################### proc build-toolbar {} { global w g opts # Create the toolbar AND the dynamic (reusable) Bookmark popup menu set w(bkmenu) [menu [set tb [frame $w(toolbar) -bd 0]].bkmenu] # Remember: ORDER OF CONSTRUCTION prescribes focus-Tabbing sequence ... # (so, get any non-focusable yet needed separators/labels out of the way) foreach nam { 1 2 3 4 5 6 } { toolsep $tb.sep$nam } set w(navLbl) [label $tb.navLbl -pady 0 -bd 2 -relief groove -text "Diff:"] set w(mrgLbl) [label $tb.mrgLbl -pady 0 -bd 2 -relief groove -text "Merge:"] set w(bkmLbl) [label $tb.bkmLbl -pady 0 -bd 2 -relief groove -text "BkMark:"] # The combo box set w(combo) $tb.combo ::combobox::combobox $w(combo) -bd 1 -editable 0 -width 20 -command moveTo # (do these NOW (no point in kludging up 'setBind'); FIXES focus-Tabbing) bind $w(combo) <> "[bind all <>] ; break" bind $w(combo) <> "[bind all <>] ; break" # Next, the simple BUTTONS (table driven enforces visual/naming uniformity) # Using a "factory" approach cuts down on the code verbosity somewhat. # (N.B> See "ANNOYANCE" below for details on 'TW' field) foreach {nam txt TW cmd tip} { rediff "Rediff" 40 {reCalcD user} {"Recompute and redisplay ALL difference regions"} ignCDR "Ignore CDR" 76 {ignore-hunk} {"Ignore Current diff region"} splitCDR "Split..." 44 {splcmbDlg 0} {"Split Diff region at specified bounds"} cmbinCDR "Combine..." 76 {splcmbDlg 1} {"Combine Diff region with ADJACENT neighbor(s)"} find "Find..." 44 {srch-text} {"Search for a string within either file"} firstCDR "First" 34 {move first} {"Move to First Diff region"} lastCDR "Last" 34 {move last} {"Move to Last Diff region"} prevCDR "Prev" 34 {move -1} {"Move to Preceding Diff region"} nextCDR "Next" 34 {move 1} {"Move to Following Diff region"} ctrCDR "Center" 46 {centerCDR} {"Center Current Diff region"} bkmSet "Set" 26 {bkmark creat} {"Bookmark this CDR"} bkmRls "Clear" 34 {bkmark erase} {"Clear this CDR bookmark"} } { set_tooltips [set w(${nam}_im) \ [toolbutton $tb.${nam}_im -image ${nam}Img -command $cmd]] $tip # TK ANNOYANCE: '-width -1' CLAIMS to produce a minimal btn WIDTH ... # # Instead it does EXACTLY the same as not specifying ANY at all: just # USES an 'average width' TIMES the #-of-Lbl-chars which wastes TONS # of space - Even MORE SO w/proportional fonts! # # We will CONSTRAIN it OURSELF by injecting an extra frame WE control # (mildly ugly approach, but SHOULD work multi-platform: +/- ?fonts?) # (We DO the same for -height, but thats just a constant 22 pixels) set_tooltips [set w(${nam}_tx) \ [toolbutton [frame $tb.${nam}_tx -width $TW -height 22 -bd 0].btn \ -text $txt -command $cmd]] $tip } # The remaining items (managing of EXISTING bookmarks) dont need Tooltips # (next two lines forms a ?'mini-widget'?: a scrollable frame of widgets) # (with the FOLLOWING two being its 'scroller btns') set w(bkmCvs) [canvas $tb.bCvs -height 22 -xscrollcom {bkmark set} \ -bd 0 -highlightthick 0] set w(bkmSF) [frame $w(bkmCvs).f -bd 0] # N.B> NEVER supply any dimensions to w(bkmSF)!! (details in 'bkmark') set w(bkmSL) [button $tb.bSL -image arroWl -command {bkmark scroll -1}] set w(bkmSR) [button $tb.bSR -image arroWr -command {bkmark scroll 1}] # Finally - INSERT our widget-fillable frame INSIDE the scrollable canvas $w(bkmCvs) create window 0 0 -anchor nw -window $w(bkmSF) # Last, do the RADIO buttons (N.B> are NOT part of focus-Tabbing) # A 2nd Factory is easier as each requires a specific extra term ('val'). # Focus-Tabbing is DISALLOWED (too easy to accidently toggle them that # way and NOT notice it) so they have no effect on the focus sequence # Besides - hotkeys exist for them anyway - so keyboard remains viable # N.B> Somehow UNAFFECTED by text-style oversizing (???) Whatever.... foreach {nam val txt cmd tip} { mrgC1 1 "L" {do-merge-choice 1} {"select the diff on the left for merging"} mrgC2 2 "R" {do-merge-choice 2} {"select the diff on the right for merging"} mrgC12 12 "LR" {do-merge-choice 12} {"select the diff on the left then right for merging"} mrgC21 21 "RL" {do-merge-choice 21} {"select the diff on the right then left for merging"} } { set_tooltips [set w(${nam}_im) \ [radiobutton $tb.${nam}_im -variable g(toggle) -takefocus 0 \ -image ${nam}Img -indicatoron 0 -selectcolor $w(selcolor) \ -value $val -command $cmd]] $tip set_tooltips [set w(${nam}_tx) \ [radiobutton $tb.${nam}_tx -variable g(toggle) -takefocus 0 \ -text $txt -indicatoron 1 \ -value $val -command $cmd]] $tip } # Assemble each piece WHERE it belongs, # choosing the Txt/Img variations as needed, cfg-toolbar true } ############################################################################### # By default, (Re-)Populate Toolbar w/preferred button styling (IFF misaligned) # (BUT when init==1): COMPOSE & MAP the Toolbar widgets where they belong ############################################################################### proc cfg-toolbar {{init 0}} { global w opts # (shorten some NEEDED variables, and provide a meta-pgming translation) lassign "$w(toolbar) $opts(toolbarIcons) _tx _im" tb I btn(0) btn(1) # Generally, we only need to SWAP OUT certain toolbar items in response # to the user toggling a preference (txt .vs. iconic buttons) BECAUSE # the 'grid' by default REMEMBERS all the items we ever put into it ... if {$init} { # ...BUT - if this IS the VERY FIRST invocation we must 'grid' it ALL # (plus make any final 1-TIME adjustments to various specific items) # "grid" makes this marginally harder because its ugly to config items # one-by-one AND get everything in ONE row (unlike "pack"), but we NEED # "grid" because it "remembers" where an item WAS if we simply UNMAP it. # Worse is we need CERTAIN items (toolbuttons) to be "stacked" into the # SAME grid-CELL so we can TOGGLE which variant of each IS mapped. # # So this may look weird as code - but dont argue with success! # First, list it all out (in left-to-right order): the ENTIRE Toolbar ! # - BUT (for now) ONLY as their "image" identities... THEN "grid" it, # AND THEN "grid" it AGAIN (after switching to their "text" forms) # # This should result in 'grid' KNOWING all of them, AND stacking BOTH # versions (_tx & _im) of any such toolbuttons INTO the SAME grid-CELL. set theRow [list $tb.combo $tb.sep1 $tb.rediff_im $tb.ignCDR_im \ $tb.splitCDR_im $tb.cmbinCDR_im $tb.find_im $tb.sep2 \ $tb.mrgLbl $tb.mrgC12_im $tb.mrgC1_im $tb.mrgC2_im \ $tb.mrgC21_im $tb.sep3 $tb.navLbl $tb.firstCDR_im \ $tb.lastCDR_im $tb.prevCDR_im $tb.nextCDR_im $tb.sep4 \ $tb.ctrCDR_im $tb.sep5 $tb.bkmLbl $tb.bkmSet_im \ $tb.bkmRls_im $tb.sep6 $tb.bSL $tb.bCvs $tb.bSR] grid {*}$theRow -padx 0 -sticky w # N.B> Phooey! The SIMPLE DIRECT way out didn't (QUITE yet) work..... # (see last line of this code-block: was FORMERLY the NEXT line!) # # It's NOT that it won't DO the OVERLAY, its that when mentioning a # KNOWN slave, it fails to 'increment' the COL for it as we imagined... # *BUT* ... there's ANOTHER way (via a "set theory" operation): # 1st REMOVE all the common items, THEN let them be added a 2ND time # to ensure any new 'OTHER' items FALL into their CORRECT columns! grid forget {*}[regsub -all {[^ ]+_im} $theRow {}] # # NOW we can RE-add everything AGAIN with it ALL being managed properly grid {*}[string map {_im _tx} $theRow] -row 0 -padx 0 -sticky w # Certain items (walk ALL the slaves) need just a bit more configuring # (including some tiny bits of UN-configuring from just above) # N.B> '-sticky' (like others) REWRITES its value - NOT merges! foreach item [grid slaves $tb] { if {[string match {*_im} $item]} { grid $item -pady 2 } \ elseif {[string match {*_tx} $item]} { grid $item -pady 2 # Time to put the REAL textbtn inside its frame - if it IS one! # (just dont LET it GRAB more space than we've ALLOWED it) if {[winfo exists $item.btn]} { pack propagate $item false pack $item.btn -fill both -expand yes } } \ elseif {[string match {*.bCvs} $item]} { grid $item -sticky ew } \ elseif {[string match {*sep?} $item]} { grid $item -padx 2 -pady 2 -sticky nsw } \ elseif {[string match {*.bS?} $item]} { $item config -repeatdelay 200 -repeatinterval 300 if {[string match {*R} $item]} { grid $item -padx 0 -sticky e } \ else { grid $item -padx 0 } } } # Sadly, theres no "grid $slave -column" to ASK "What col is it IN?", # instead yank it from the WHOLE slave-attr LIST (& mark it 'Stretchy') grid columnconfig $tb [lindex [grid info $tb.bCvs] 3] -weight 1 # Initially, HIDE the Bkmark scroll-btns (they'll come/go dynamically) grid remove $tb.bSL $tb.bSR # N.B> 'falling-thru' to below WILL UNMAP the UNDESIRED button forms } # Verify we have the DESIRED toolbtn FORM (txt/img) set as visible/hidden # N.B> There MAY be nothing to DO (if the Icon toggle hasnt been CHANGED) # (spin over ALL items partly because 'winfo' doesnt offer glob-specs) foreach item [winfo children $tb] { if {[string match {*_[it][mx]} $item] && ([winfo ismapped $item] || $init) && ![string match "*$btn($I)" $item] } { # out with the old, in with the new grid remove $item grid [string map {_tx {} _im {}} $item]$btn($I) } } # Pgmr: Useful in identifying toolbar spacing/occupancy/stacking issues!! # foreach item [grid slaves $tb] {Dbg "[grid info $item]\t<-- $item" true} # Ensure 'relief' on ALL toolbutton items AGREE with the CURRENT setting if {$opts(relief)=="flat" && $I} { set newB 0 } { set newB 1 } # BUT, Radiobuttons IGNORE relief settings if they have an image, so make # THEIR borderwidth = 0 if the CURRENT RELIEF is intended to be flat foreach wdg [concat [info comm $tb.*$btn($I)] [info comm $tb.cvs.f.*]] { if {[string match {*.mrgC[12]*_im} $wdg]} { $wdg configure -relief $opts(relief) -bd $newB -selectc $w(selcolor) } { $wdg configure -relief $opts(relief) } } # Changing Icon<->Txt buttons MAY affect size of the Bookmark Scroll region after idle bkmark adjSz -1 } ############################################################################### # Construct the status window (a place for hints and/or SHORT messaging) ############################################################################### proc build-status {} { global g w frame $w(status) -bd 0 set w(statusLabel) $w(status).label set w(statusCurrent) $w(status).current set w(statusMrgL) $w(status).mrgL set w(statusMrgR) $w(status).mrgR # MacOS has a resize handle in the bottom right which will sit on top of # whatever is placed there. So, we add a little bit of whitespace there. # It's harmless, so let's just do it on all of the platforms. label $w(status).blank -image nullImg -width 16 -bd 1 -relief sunken label $w(statusCurrent) -textvariable g(statusCurrent) -anchor e \ -width 14 -borderwidth 1 -relief sunken -padx 4 -pady 2 label $w(statusMrgL) -textvariable g(statusMrgL) -anchor e \ -borderwidth 1 -compound right -image mrgC1Img -relief sunken label $w(statusMrgR) -textvariable g(statusMrgR) -anchor e \ -borderwidth 1 -compound left -image mrgC2Img -relief sunken label $w(statusLabel) -textvariable g(statusInfo) -anchor w -width 1 \ -borderwidth 1 -relief sunken -pady 2 pack $w(status).blank -side right -fill y pack $w(statusCurrent) -side right -fill y -expand n pack $w(statusMrgR) -side right -fill y -expand n pack $w(statusMrgL) -side right -fill y -expand n pack $w(statusLabel) -side left -fill both -expand y } ############################################################################### # handles simulated-scroll events over the map # Provides 3 modes: # B1-click (over trough) pages, B1-motion (over thumb) drags, or B2-click jumps # Once a button is down, the mode locks and mouse X-location becomes irrelevant ############################################################################### proc handleMapEvent {event y} { global g w opts switch -- $event { B1-Press { if {! $g(mapScrolling)} { set ty1 [lindex $g(thumbBbox) 1] set ty2 [lindex $g(thumbBbox) 3] if {$y >= $ty1 && $y <= $ty2} { # this captures the negative delta between the mouse press # and the top of the thumbbox. It's used so when we scroll # by moving the mouse, we can keep this distance constant. # (this is how all scrollbars work, and what is expected) set g(thumbDeltaY) [expr -1 * ($y - $ty1 - 2)] set g(mapScrolling) 3 } else { set g(mapScrolling) 1 } # Either way, mode is set and other mouse events are locked out } } B2-Press { # Set mode and lock out other mouse events if {! $g(mapScrolling)} { set g(mapScrolling) 2 } } B2-Release - B1-Motion { if {$g(mapScrolling) & 2} { if {$g(mapScrolling) == 3} { incr y $g(thumbDeltaY) } # Show text corresponding to map location $w(acTxWdg) yview moveto [expr $y.0 / $g(mapheight).0] # Release our mouse event lock (B2-click completed) if {$g(mapScrolling) == 2} { set g(mapScrolling) 0 } } } B1-Release { show-status "" if {$g(mapScrolling) & 1} { set ty1 [lindex $g(thumbBbox) 1] set ty2 [lindex $g(thumbBbox) 3] # if we release over the trough (*not* over the thumb) # just scroll by the 'size' of the thumb (eg. 1 page); ... # otherwise we must have been dragging the thumb and we're done if {$y < $ty1 || $y > $ty2} { # (when "syncscroll" is set, the other window will follow) $w(acTxWdg) yview scroll [expr {$y < $ty1 ? -1 : 1}] pages } # Release our mouse event lock (B1 click/drag completed) set g(mapScrolling) 0 } } } } # makes a toolbar "separator" proc toolsep {w} { label $w -image [image create photo] -highlightthickness 0 -bd 1 -width 0 \ -relief groove return $w } proc toolbutton {w args} { global opts # create the button # Dflts for '-bd' AND '-pady' =1 (generally whats wanted anyway; don't set) button $w {*}$args # add minimal tooltip-like support bind $w [list toolbtnEvent %W] bind $w [list toolbtnEvent %W] bind $w [list toolbtnEvent %W] bind $w [list toolbtnEvent %W] $w configure -relief $opts(relief) return $w } # handle events in our fancy toolbuttons... proc toolbtnEvent {event w {isToolbutton 1}} { global g opts switch -- $event { "" - "" { showTooltip button $w if {$opts(fancyButtons) && $isToolbutton && [$w cget -state] == \ "normal"} { $w configure -relief raised } } "" - "" { set g(statusInfo) "" if {$opts(fancyButtons) && $isToolbutton} { $w configure -relief flat } } } } ############################################################################### # move the map thumb to correspond w/current shown text (just like a scrollbar) ############################################################################### proc map-move-thumb {y1 y2} { global g w # Scale the thumb height (subject to a minumum size big enough to 'grab') set thumbheight [max $g(thumbMinHeight) \ [expr {round(($y2-$y1) * $g(mapheight))}]] # L/R edge positions (-3 so right edge remains INSIDE our border) set x1 0 if {[info exists g(mapwidth)]} { set x2 [expr {$g(mapwidth) - 3}] } {set x2 0} # B/T edge positions (-2 so bottom edge remains INSIDE our border) # but ensure top edge wont exceed the top of the map itself # N.B> Computationally, we want to POSITION the thumb by its CENTER # such that when the thumbheight hits minimum, the EXCESS spreads to # BOTH edges (unless either edge encroaches its window limit). set y1 [max 0 [expr {int((($y1 + $y2)/2)*$g(mapheight))-($thumbheight/2)}]] set y2 [expr {$y1 + $thumbheight}] if {$y2 > $g(mapheight)} { set y2 [expr {$g(mapheight) - 2 }] set y1 [expr {$y2 - $thumbheight}] } # extra offset values for upcomming drawing trick set dx1 [expr {$x1 + 1}] set dy1 [expr {$y1 + 1}] # Draw two L-shapes (1 light, 1 dark) aligned for a 3d appearance $w(mapCanvas) coords thumbUL $x1 $y2 $x1 $y1 $x2 $y1 $w(mapCanvas) coords thumbLR $dx1 $y2 $x2 $y2 $x2 $dy1 # Record bounding box (for use in event handler, eg., dragging, etc) set g(thumbBbox) [list $x1 $y1 $x2 $y2] } ############################################################################### # Attach bindings needed by each provided widget (per naming conventions) ############################################################################### proc setBinds {args} { global opts # Assign bindings based primarily on the "role" each widget plays in the UI # PRIMARY are: - the major Text windows # - their matching Info Canvas # - toplevels that house the primary appl displays (no dialogs) # however, several MINOR windows (scrollbars, labels) having a L/R "sense"; # EVEN the DiffMap is adequate for supporting a majority of the POPup menu. # All of these are valid as a bindtag (btag) so do whichever was passed-in, # although SOME will just be quietly IGNORED ("grip", "Ancestor file"). # OUR DESIRE is to permit "input command access" from most ANYWHERE. foreach btag $args { if {[string match {.client.*} $btag]} { # Skip client elements we dont care about: # ancFile, grip, frames if {[string match {.client.[ag]*} $btag] || [winfo class $btag]=="Frame"} { continue } if {[string match {*.info} $btag]} { # The Info widget is actually a Canvas PAIRED with a Text widget # In our configuration, they share equivalent Y-coords # (w/acceptable X) and can thus OPERATE as-if the event happened # OVER that Text widget. Info widgets must pretend their dblclick # occurred within the COMPANION "*.text" widget instead (because # a canvas doesn't HAVE any "line indices" to locate (but the # widget relative coords STILL work because of physical alignment) set companion [string replace $btag end-3 end "text"] bind $btag \ [subst {moveNearest $companion xy %x %y ; break}] bind $btag $opts(genEdit) { do-edit %X %Y } } elseif {[string match {*.text} $btag]} { # OUR Text wdgs are (intentionally) READONLY, yet DO take keystrokes # First some 'built-in' specific "features" for the L/R Text windows bind $btag {moveNearest %W xy %x %y ; break} bind $btag {moveNearest %W mark insert ; break} bind $btag $opts(genEdit) { do-edit %X %Y } # Next, we want 'focus-Tabbing' to work properly everywhere ... # But the default Text CLASS bindings would presume that # a typed or should be "insert"ed instead # # So we'll reach AROUND the Text Class to the "all" bindtag where # 'focus-Tabbing lives, install them here, AND "break" so the # class rules NEVER see it. This LEAVES the Text Class unmodified # and thus fully functional for uses OUTSIDE the ones setup here. bind $btag <> "[bind all <>] ; break" bind $btag <> "[bind all <>] ; break" # ALL ABOUT cursor-based SCROLLING: # These following (assidiously named) 20 bindings are all about # POSITIONING the insert cursor (and MAYBE forming a selection) # via the keyboard. But each EXPECTS to scroll the window AS # NEEDED, for visual feedback (and user confirmation) which is # EXACTLY the same reason TYPING does (so the users SEES what # they are doing). Thus scrolling is tied up with TYPING as # well as OTHER uses. # Yet our R/O widget BLOCKs TYPING - thus ALSO needs to BLOCK # the visualization aid ($widget see insert) it issues, because # one CANT POSSIBLY 'see' what HASNT been ALLOWED to HAPPEN! # This becomes easier to understand when realizing that OTHER # forms of scrolling (scrollbar, mouse) DO NOT update the # insert cursor! # Thus were cursor-based scrolling NOT blocked, a simple key # touch would then cause a RADICAL scrollBACK to wherever the # insert cursor was last left, to ENTER a key that WE, in turn, # WONT LET OCCUR! And the user then asking # "what the .... just happened?" # Sadly, there are "precedence" issues around trying to # OVERRIDE the TYPING binding () WITHOUT just # "removing" it, which we CANT do, as we have OTHER instances # that truely NEED it to exist. # A (classic) solution MIGHT be to CLONE the Class bindings, # hack them up and use the RESULT as the Class for the R/O # widgets. That felt dangerous at best (interactions are both # subtle AND widespread). # OUR "solution" was to provide a ficticious widget cmd: # 'ALLOW' # bound to EXACTLY THE SAME BINDINGS as all the PERMITTED # movements (general positioning and selection creation) but # NOT to typing; binding them ALL to the widget tag (ie. just # AHEAD of the Class invocations but WITHOUT a 'break'). Each # call *ALLOW*s 'see' to NOT BE BLOCKED for 1 invocation only! # Thus as BOTH bindings WILL FIRE, we are SIMPLY PERMITTING # the Class actions to function, while BLOCKING others, ALL # without making ANY modification to the Class bindings! # The only thing we MIGHT get *wrong* is failing to "ALLOW" # yet one more binding (or one too many); which is INFINITELY # easier to fix than hacking even FURTHER on a CLONED class # (endlessly?). # These are ALL targetted on the Arrowkeys with Mods= S/C/SC # (should also note that literals always WIN against virtuals in event # precedence battles ... IE.: which are you choosing to 'Give up' ? # These TWENTY bindings RESTORES Key-based cursor movement (as # pertains to SCROLLING) in support of simple movement AND the # creation of "selections". Each works by issuing a FAKE widget # cmd to OUR 'ROfcn' PERMITTING the (implicitly following) Text # Class-binding 'see' request to operate normally. Think of it # as "arming" the Class binding to function as designed. # # Distinction is that Class rules that ATTEMPT Ins/Del/Repl OPS # must also NOT have THEIR requests to 'see' permitted, thereby # ENSURING a **COMPLETE BLOCKAGE** of any modification effects! foreach A {"" Select} { foreach B {Next Prev} { foreach C {Char Line Word Para} { bind $btag <<$A$B$C>> {%W ALLOW see 1} } } set B "Line" foreach C {Start End} { bind $btag <<$A$B$C>> {%W ALLOW see 1} } } # That leaves the DiffMap+Labels, (and NOT-clickable ScrlBars) ... } elseif {![string match {.client.*sb} $btag]} { # ScrlBars shouldnt Dbl-click at ALL (because they will MOVE), # but Labels will simulate the click ASIF it was IN Textwin # (because labels dont have '@x,y' addressable lines) if {[string match {.client.*label} $btag]} { set companion [string replace $btag end-4 end ".text"] bind $btag \ [subst {moveNearest $companion xy %x %y ; break}] # We let DiffMap move, because it treats the XY as a POSITION # within the WHOLE of the content, not an analog of the Textpos } {bind $btag {moveNearest %W xy %x %y ; break}} } # ...(plus the fall-thru of everything above) which ALL needs # the binding to provide the Popup menu (so its just EVERYWHERE) bind $btag <3> {show-popupMenu %X %Y} # Anything ELSE has to be one of the two 'toplevel' frames we use... # Each is assigned ALL of the GLOBALLY defined bindings (because they # will act REGARDLESS of which 'contained' widget holds the focus). # This works because EVERY widget includes ITS toplevel as a bindtag # **BUT** requires the CHOICE of the bound-keys to not BE subject # to exclusivity (ie. anyone using a 'break') } else { bind $btag $opts(navCntr) { centerCDR } bind $btag $opts(navNext) { move 1 } bind $btag $opts(navPrev) { move -1 } bind $btag $opts(navFrst) { move first } bind $btag $opts(navLast) { move last } bind $btag $opts(genFind) { srch-text } bind $btag $opts(genNxfile) { multiFile next } bind $btag $opts(genPvfile) { multiFile prev } bind $btag $opts(genXit) { do-exit } bind $btag $opts(genRecalc) { reCalcD user } bind $btag $opts(mrgLeft) { do-merge-choice 1 } bind $btag $opts(mrgRght) { do-merge-choice 2 } bind $btag $opts(mrgLtoR) { do-merge-choice 12 } bind $btag $opts(mrgRtoL) { do-merge-choice 21 } } } } ############################################################################### # Bookmark handler: User toolbar-btns that Jump-Move to PARTICULAR diff regions # # Has a wealth of SUBCMDs (w/indiv arg fmts), including SOME to simply avoid # the need for yet MORE support fcns to encapsulate involved data derivations # -- makes the REMAINDER easier to read; Think: data-accessors w/better names # Thus: # Note: 'slv' is a GRID MANAGED window (eg: .win.a.b.c) # '{mn mx}' is a floating point value PAIR # most OTHER values are simply integers # # Primary-level (user) capabilities: # subcmd arg # ======= ======== # jump hNDX what a bookmark executes (jump to region # hNDX) # creat ?hNDX? creates a bookmark (dflt = CDR) # erase ?hNDX? destroys a bookmark (dflt = CDR) # scroll +/-num scroll the displaylist of bookmarks (num positions) # denote hNDX permit a user-specified identifier for chosen BMark # rptgen hNDX toggle inclusion for report generation purposes # eraseall destroys ALL bookmarks # # Internal-level functors: # mpop {hNDX x y} request popup-menu for designated hunk @ X,Y # set {mn mx} FEEDBACK from scrolled-widget stating current view # hNDX to reconfig when hunk-ndx/hunk-id relation chgs # adjSz col modify config AFTER ins/del of $col by eventloop # # Private primitives: (post-event-loop data accessors) to OBTAIN: # winCol slv grid column within master where $slv exists # viewSz slv Max VIEWABLE extent of provided-slaves MASTER ############################################################################### proc bkmark {cmd args} { global g w report # (apologies for our PRESUMPTION that 'grid info' produces a FIXED sequence) # Documentation only states indices 0 & 1 of ("-in $mstr -column $N -xx...) # Grid provides no OTHER means of NEEDED introspection switch -glob -- $cmd { winCol { # -> the grid-column index a MANAGED window object occupies return [lindex [grid info $args] 3] } viewSz { lassign [grid info $args] na mstr na col # -> pixel width of VIEWABLE $mstr area of given MANAGED slv return [lindex [grid bbox $mstr $col 0] 2] } adjSz { lassign $args col # Things to account for with the addition/loss of a Bmark button # (can involve grid configuration AND/OR scrolling considerations) # N.B> when called with "col<0", only re-analyzes for being resized # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # As a rule, you MUST NOT USE any of the above 'primitives' UNTIL # giving the eventloop a chance to spin AGAINST the changed item! # THATS why THIS subcmd is BEST invoked by "after idle"! # Make certain the scrolling canvas TRACKS where the last btn ENDS # (but also SNAG just that now NEW width value for further use) $w(bkmCvs) configure -scrollregion [concat 0 0 \ [set i [winfo reqwidth $w(bkmSF)]] \ [winfo reqheight $w(bkmSF)]] # Check if NOW is the time to toggle BOTH scroller btns visibility if {[winfo ismapped $w(toolbar).bSL]} { if {$i < ([bkmark viewSz $w(bkmCvs)] \ + (2 * [winfo reqwidth $w(toolbar).bSL])) } { grid remove $w(toolbar).bSL $w(toolbar).bSR } } elseif {$i > [bkmark viewSz $w(bkmCvs)]} { grid $w(toolbar).bSL $w(toolbar).bSR } # When 'col' is INTERIOR to the known grid, there is NOW a "gap" in # the COL numbering (because a btn WAS destroyed). Close that up # by shifting grid column assignments DOWNWARD of any ABOVE 'col' # (just like the DISPLAY did when it slid the graphics over) if {$col >= 0 && $col < [lindex [grid size $w(bkmSF)] 0] - 1} { foreach wdg [grid slaves $w(bkmSF)] { if {$col < [set j [bkmark winCol $wdg]]} { grid $wdg -column [incr j -1] } } } } jump { set hNDX $args # What the button actually does... GO there move $hNDX 0 1 } scroll { # For now -'units' is 1 button-widget size at a time # (unsure if something smaller ?1/4 btn? and FASTER is better) $w(bkmCvs) xview $cmd $args units } set { lassign $args Sfrac Efrac # Simply use scrolling feedback to (en/dis)able indiv scroller btns # - ensures auto-repeat STOPS firing when max travel is reached! # (uses 'catch' to map all the fractional junk to 'normal') set L(0.0) [set R(1.0) disabled] ; # <- keyed values that matter foreach {wdg val} "$w(bkmSL) $Sfrac $w(bkmSR) $Efrac" { if {[catch "set need \$[string index $wdg end]($val)"]} { set need normal } if {"$need"!= [$wdg cget -state]} {$wdg configure -state $need} } } creat { if {$args=={}} {set hNDX $g(pos)} {lassign $args hNDX} # Make a whole new bookmark if {! [winfo exists [set wdg $w(bkmSF).mark[hunk-id $hNDX]]]} { # Major graphic trick - Bookmark is both an image AND text... # Image is a graphics MASK with strategic transparent holes. # Text lays ON TOP of it. Size is CLAMPED per the image such # that Bgnd color ONLY shows thru holes, where not overlayed # by the text. Allows us to differentiate via color if/when # we so choose (likely in the future) toolbutton [frame $wdg -width [image width bkmImg] -bd 0 \ -height [image height bkmImg] ].btn -bd 0 \ -compound center -image bkmImg -text "\[$hNDX\]" \ -default disabled -command "bkmark jump $hNDX" \ -bg \#40d040 # Locking the frame size HALTS button from appealing for MORE # (excessive) text space, and only THEN can we shove the button pack propagate $wdg false ; # inside its EXACT sized jail! pack $wdg.btn # Doing Tooltip THIS way wont PopUp: simply reports as 'Status' # N.B> future possibility: # Should we WANT a 2nd category of bookmark, we only need # to change its -bg color, and perhaps call 'set_tooltip' # to OVERRIDE the 'statusbar binding' with a 'popup' one set g(tooltip,$wdg.btn) "\[$hNDX]: Jump to this diff region" # EACH Bmark takes the 'NEXT' avail column (but see cmd=erase) if {![set col [llength [grid slaves $w(bkmSF)]]] && [winfo reqwidth $w(bkmSF)] == 1} { # Apologies about weird if-test, but ONLY want this ONCE # per SESSION on the VERY FIRST Bmark! We are thus USING # the idea that TK originally creates the FRAME the btn # was JUST created into as 1x1, UNTIL the event-loop can # ACTUALLY get a chance to INSERT it (coming shortly). # Note that should the user ever REMOVE the LAST btn, # the FRAME actually RETAINS its THEN size (and does NOT # return to the original 1x1) PRESERVING our 1-time only. # # Now we want to set up for a full btns-worth of scrolling # We need the ACTUAL gridded size so emulate the '-padx 1' $w(bkmCvs) configure -xscrollincrement \ [expr {[winfo reqwidth $wdg] + 2}] } grid $wdg -row 0 -column $col -padx 1 # Finish-up by attaching the dynamic menu hook, then assessing # its addition AFTER implied events (object resizings) complete bind $wdg.btn "bkmark mpop $hNDX %X %Y" after idle bkmark adjSz $col } update-display } erase { if {$args=={}} {set hNDX $g(pos)} {lassign $args hNDX} # Destroy the given bookmark set hID [hunk-id $hNDX] if {[winfo exists [set wdg $w(bkmSF).mark$hID]]} { if {$hID in $report(BMrptgen)} { set report(bkmYN) 0 # Must not remain in the report content bkmark rptgen $hNDX } unset -nocomplain g(tooltip,$wdg.btn) # It makes a difference what grid COL this Bmark occupied... set col [bkmark winCol $wdg] bind $wdg.btn {} destroy $wdg # Finish-up AFTER implied events (object resizings) are handled after idle bkmark adjSz $col } update-display } eraseall { # Destroy ALL EXISTING bookmark(s) set bookmarks [info commands $w(bkmSF).mark*] # N.B> not to worry about "grid column' numbering -> goes to zero if {[llength $bookmarks] > 0} { foreach wdg $bookmarks { # Silly, but we need the frame to then KILL both IT + BTN if {[string match *.btn $wdg]} { continue } unset -nocomplain g(tooltip,$wdg.btn) bind $wdg.btn {} destroy $wdg } set report(BMrptgen) [list] after idle bkmark adjSz 0 } update-display } "[0-9]*[acd]*[0-9]" { lassign $args hNDX # Re-config diffnum <-> hunk-id relationship (ie. Re-number hunk) if {[winfo exists [set wdg $w(bkmSF).mark$cmd]]} { $wdg.btn config -text "\[$hNDX]" -bd 1 -pady 1 \ -command "bkmark jump $hNDX" set g(tooltip,$wdg.btn) \ [regsub {[0-9]+} $g(tooltip,$wdg.btn) $hNDX] bind $wdg.btn "bkmark mpop $wdg $hNDX %X %Y" } } denote { lassign $args hNDX # Ask for, then modify, the tooltip text per the users input set tID "tooltip,$w(bkmSF).mark[hunk-id $hNDX].btn" set i [string first ":" $g($tID)] set curVal [string range $g($tID) [expr $i+1] end] if [Prompt "Your annotation for Diff-region \[$hNDX]:" $curVal] { if {$curVal=={} && [string index $w(val.prompt) 0] != " "} { set w(val.prompt) " $w(val.prompt)" } set g($tID) [string replace $g($tID) $i end ":$w(val.prompt)"] } } rptgen { lassign $args hNDX # TOGGLE the participation of hNDX in a "Bkmark" report generation if {$hNDX != $report(bkmYN)} { # ALREADY present: must remove it set i [lsearch -exact $report(BMrptgen) [hunk-id $hNDX]] set report(BMrptgen) [lreplace $report(BMrptgen) $i $i] } else { lappend report(BMrptgen) [hunk-id $hNDX] } } mpop { lassign $args hNDX x y # Empty, Config, then popup, the BMark menu for the specific button $w(bkmenu) delete 0 end $w(bkmenu) add command \ -label "annotate" -command "bkmark denote $hNDX" set report(bkmYN) \ [expr {[hunk-id $hNDX] in $report(BMrptgen) ? $hNDX : 0}] $w(bkmenu) add checkbutton -variable report(bkmYN) -onvalue $hNDX \ -label "in-report" -command "bkmark rptgen $hNDX" tk_popup $w(bkmenu) $x $y } } } ############################################################################### # Customize the display (among other things). # # N.B> Editting within the 'Behavior' category REQUIRES the use of a local GRAB # which, in turn, is used to BLOCK access to focus-Tabbing into major controls # of the dialog (Categories, Save, and Help buttons) PREVENTING keyboard invokes # of such controls. That same "grab aversion" CAN ALSO be caused by usage of a # "combobox" (which MAY do a GLOBAL grab) in whichever category is then active. ############################################################################### proc customize {} { global g w pref opts tmpopts # FIXME: It takes 2 tries to map this dialog on the Mac if {![Dialog NONMODAL $w(prefs)]} { wm title $w(prefs) "$g(name) Preferences ([file tail $g(rcfile)])" wm transient $w(prefs) . wm group $w(prefs) . # we don't want the window to be deleted, just hidden from view wm protocol $w(prefs) WM_DELETE_WINDOW {Dialog dismiss $w(prefs)} # the button frame... # N.B> Unusual 'takefocus' prevents the Behavior tab from letting # the keyboard Tab-traverse INTO these buttons until AFTER a local # grab is no longer in-force ON that particular tab-page! frame $w(prefs).btns -bd 0 button $w(prefs).btns.dismiss -width 8 -text "Dismiss" \ -command {prefdismiss $w(prefs)} button $w(prefs).btns.apply -width 8 -text "Apply" \ -command {prefapply $w(prefs).btns.apply} button $w(prefs).btns.save -width 8 -text "Save" \ -command {prefsave $w(prefs).btns.save} -takefocus \ {apply {wdg { return [expr {[grab current $wdg]=={}}] }}} button $w(prefs).btns.help -width 8 -text "Help" \ -command {help-prefs} -takefocus \ {apply {wdg { return [expr {[grab current $wdg]=={}}] }}} pack $w(prefs).btns -side bottom -fill x pack $w(prefs).btns.dismiss -side right -padx 10 -pady 5 pack $w(prefs).btns.help -side right -padx 10 -pady 5 pack $w(prefs).btns.save -side right -padx 1 -pady 5 pack $w(prefs).btns.apply -side right -padx 1 -pady 5 # a series of radiobuttons to act as a poor mans notebook tab frame $w(prefs).notebook -bd 0 pack $w(prefs).notebook -side top -fill x -pady 4 # The relief makes these work, so we don't need to use the selcolor # Radiobuttons without indicators look rather sucky on MacOSX, # so we'll tweak the style for that platform # These are also subject to non-Tab-traversal when grab is active set indicatoron [expr {$w(wSys) == "aqua"}] foreach page {General Display Behavior Appearance Engine} { set frame $w(prefs).f$page set rb $w(prefs).notebook.f$page radiobutton $rb -command "setPrefPage $frame" -selectcolor $w(bgnd)\ -variable g(prefPage) -value $frame -height 2 -text $page \ -indicatoron $indicatoron -borderwidth 1 -takefocus \ {apply {wdg { return [expr {[grab current $wdg]=={}}] }}} pack $rb -side left frame $frame -bd 2 -relief groove -width 400 -height 300 } # This Pref is supportted internally, # yet won't give the user a way to directly edit (right now, anyway). # Still, we need to ensure tmpopts knows about it set tmpopts(customCode) $opts(customCode) # General # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set frame $w(prefs).fGeneral set row 0 foreach key {diffcmd xcludeFils tmpdir editor ignoreRegexLnopt filetypes geometry } { label $frame.l$row -text "$pref($key): " -anchor w set tmpopts($key) $opts($key) if {$key == "ignoreRegexLnopt" || $key == "filetypes"} { ::combobox::combobox $frame.e$row -listvar tmpopts($key) \ -width 50 -command "editLstPref $key" } elseif {$key=="diffcmd"} { entry [set W $frame.e$row] -width 50 -bd 2 -relief sunken \ -textvariable tmpopts($key) -state readonly \ -validate key -vcmd "verify alertD $key $W 1" # Added to FIND key->widget (when needed later) # N.B> 'egnOpt' is meaningless but simplifies parsing later dict set w(prefD) $key "0 egnOpt $W {}" # We also want a SPECIAL binding for when the mouse HOVERS to # show us the CURRENT value, in those circumstances where it # is warning of being overwritten.... bind $W "if {\$tmpopts($key)!=\$opts($key)} {\ show-status \"CURRENT Diff command: \$opts($key)\"}" bind $W "if {\$tmpopts($key)!=\$opts($key)} {\ show-status {} }" } else { entry $frame.e$row -width 50 -bd 2 -relief sunken \ -textvariable tmpopts($key) } # Declare "-state" on some of these as slaved to other controls if {[string match {*opt} $key]} { linkState $frame.e$row tmpopts([string range $key 0 end-3]) } grid $frame.l$row -row $row -column 0 -sticky w -padx 5 -pady 2 grid $frame.e$row -row $row -column 1 -sticky ew -padx 5 -pady 2 incr row } # Some of these labels are long, we'll need font measure set Fnt [$frame.l[expr {$row-1}] cget -font] # this is just for filler... label $frame.filler -text {} grid $frame.filler -row $row incr row # Option fields # Note that the order of the list is used to determine the layout. # So, if adding something to the list pay attention to what it affects. # # Remaining layout is a 2-col, row-major order (ie. cols vary fastest) # an 'x' means an empty column; a '-' means an empty row # (Note: rows must be fully filled - even if that means a trailing 'x') set col 0 foreach key { ignSuprs autocenter - ignoreEmptyLn autoselect - ignoreRegexLn autoSrch syncscroll scmPrefer - predomMrg x} { if {$key != "x"} { if {$key == "-"} { frame $frame.f${row} -bd 0 -height 4 grid $frame.f${row} -row $row -column 0 -padx 20 -pady 4 \ -columnspan 2 -sticky nsew set col 1 ;# forces NEXT column to zero and increments row } else { set tmpopts($key) $opts($key) if {"$key" == "scmPrefer"} { set f [frame $frame.c${row}$col -bd 0] label $f.l -text "$pref($key): " -anchor w pack $f.l -side left # Hmm, annoying - we need two of these, but want to # treat the value as the list of BOTH - # this'll take some work # FIXME: the spinbox widget is cut off on the Mac, # even with -width increased foreach {val} {0 1} { # set it to reassemble values when EITHER changes spinbox $f.s$val -width 7 -repeatinterval 400 \ -values [list None {*}$g(scmS) Auto] \ -command "apply {{ndx v} { global tmpopts lset tmpopts($key) \$ndx \$v }} $val %s" -state readonly eval $f.s$val set [lindex $tmpopts($key) $val] pack $f.s$val -side top } } elseif {"$key" == "predomMrg"} { set f [frame $frame.c${row}$col -bd 0] label $f.l -text "$pref($key): " -anchor w pack $f.l -side left foreach {nam val} {Left 1 Right 2} { radiobutton $f.r$val -text $nam -value $val \ -variable tmpopts($key) pack $f.r$val -side left } } else { set W [checkbutton $frame.c${row}$col -indicatoron 1 \ -text "$pref($key)" -variable tmpopts($key)] # Each 'ign(ore...)' toggle CAN cause a RedoDiff case # Alert via 'inform' color hiliting to that widget. # Also re-encode the ONvalues as NON-OVERLAPPED bits # attaching the check-cmd & record in the dictionary # N.B> weird 'switch' VALUE-test means DONT DO w/B==0 # (B==1 is RESERVED(key==diffcmd) not handled here) if {[switch -glob $key { ign*E*Ln { set B 8 } ign*R*Ln { set B 4 } ignS* { set B 2 } default { set B 0 } }]} { $W config -command "verify alertD $key $W $B" \ -onvalue $B # Added to FIND key->widget (when needed later) # N.B> 'egnOpt' is meaningless but helps parsing dict set w(prefD) $key "0 egnOpt $W {}" } } grid $frame.c${row}$col -row $row -column $col -sticky w \ -padx 5 } } if {![set col [expr {$col ? 0 : 1}]]} { incr row } } # The bottom row and right col should stretch to take up any extra room grid columnconfigure $frame 0 -weight 0 grid columnconfigure $frame 1 -weight 1 grid rowconfigure $frame $row -weight 1 # pack this window for a brief moment, and compute the window # size. We'll do this for each "page" and find the largest # size to be the size of the dialog pack $frame -side right -fill both -expand y update idletasks set maxwidth [winfo reqwidth $w(prefs)] set maxheight [winfo reqheight $w(prefs)] pack forget $frame # Appearance # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set frame $w(prefs).fAppearance set row 0 foreach key {textopt difftag deltag instag chgtag currtag bytetag inlinetag overlaptag} { set tmpopts($key) $opts($key) label $frame.l$row -text "$pref($key): " -anchor w entry $frame.e$row -textvariable tmpopts($key) -bd 2 -relief sunken grid $frame.l$row -row $row -column 0 -sticky w -padx 5 -pady 2 grid $frame.e$row -row $row -column 1 -sticky ew -padx 5 -pady 2 incr row } # tabstops are placed after a little extra whitespace, since it is # slightly different than all of the other options (ie: it's not # a list of widget options) frame $frame.sep$row -bd 0 -height 4 grid $frame.sep$row -row $row -column 0 -stick ew -columnspan 2 \ -padx 5 -pady 2 incr row set key "tabstops" set tmpopts($key) $opts($key) label $frame.l$row -text "$pref($key):" -anchor w entry $frame.e$row -textvariable tmpopts($key) -width 3 \ -bd 2 -relief sunken -vcmd {verify integer %P %S} \ -validate key -invcmd "verify revert %W $key %s" grid $frame.l$row -row $row -column 0 -sticky w -padx 5 -pady 2 grid $frame.e$row -row $row -column 1 -sticky w -padx 5 -pady 2 incr row # Option fields # Note that the order of the list is used to determine the layout. # So, if adding something to the list pay attention to what it affects. # # Remaining layout is a 2-col, row-major order (ie. cols vary fastest) # an 'x' means an empty column; a '-' means an empty row # (Note: rows must be fully filled - even if that means a trailing 'x') set col 0 foreach key {inform adjcdr mapins mapchg mapdel mapolp} { if {$key != "x"} { if {$key == "-"} { frame $frame.f${row} -bd 0 -height 4 grid $frame.f${row} -row $row -column 0 -padx 20 -pady 4 \ -columnspan 2 -sticky nsew set col 1 ;# forces NEXT column to zero and increments row } else { # button 'active' bg shows color as contrasted w/Txt fg set tmpopts($key) $opts($key) set b $frame.b${row}$col button $b -text "$pref($key)" -activebackgr $tmpopts($key) \ -activeforeground [$w(LeftText) cget -fg] \ -command [expr {"$key"!="inform" ? "clrpick $b $key" : \ "clrpick $b $key;verify alertD pushtomenu $w(viewMenu)"}] grid $b -row $row -column $col -sticky ew -padx 5 -pady 2 } } if {![set col [expr {$col ? 0 : 1}]]} { incr row } } # The bottom row and right col should stretch to take up any extra room grid columnconfigure $frame 0 -weight 0 grid columnconfigure $frame 1 -weight 1 grid rowconfigure $frame $row -weight 1 pack $frame -side right -fill both -expand y update idletasks set maxwidth [max $maxwidth [winfo reqwidth $w(prefs)]] set maxheight [max $maxheight [winfo reqheight $w(prefs)]] pack forget $frame # Display # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set frame $w(prefs).fDisplay # Option fields # Note that the order of the list is used to determine the layout. # So, if adding something to the list pay attention to what it affects. # # Remaining layout is a 2-col, row-major order (ie. cols vary fastest) # an 'x' means an empty column; a '-' means an empty row # (Note: rows must be fully filled - even if that means a trailing 'x') set row 0 set col 0 foreach key { toolbarIcons fancyButtons - showln tagln - showcbs tagcbs - showmap colorcbs - tagtext showinline1 x showinline2 showlineview inlSuprs - x fLMmax } { if {$key != "x"} { if {$key == "-"} { frame $frame.f${row} -bd 0 -height 4 grid $frame.f${row} -row $row -column 0 -padx 20 -pady 4 \ -columnspan 2 -sticky nsew set col 1 ;# forces NEXT column to zero and increments row } else { set tmpopts($key) $opts($key) if {$key=="fLMmax"} { scale $frame.c${row}$col -orient horizontal -tick 0 \ -from 1 -to 25 -var tmpopts($key) \ -label $pref($key) -length [font measure $Fnt " $pref($key) "] # N.B> '-length' mitigates stupid label truncation! } elseif {$key=="inlSuprs"} { # We need several buttons COMBINING into a single value # this'll take some work set f [frame $frame.c${row}$col -bd 0] label $f.l -text " w/$pref($key): " -anchor w pack $f.l -side top # We need five distinct buttons, but want to # treat the value as a composition of ALL - foreach {typ val} { Case 16 Blanks 8 #Blanks 4 @TabX 2 @EOL 1} { checkbutton $f.b$val -text $typ -indicatoron 1 \ -onvalue $val -variable w($key$val) \ -command "set tmpopts($key) \[pickSuprs $key $val]" set w($key$val) [expr {$tmpopts($key) & $val}] pack $f.b$val -side left } } else { checkbutton $frame.c${row}$col -indicatoron 1 \ -text "$pref($key)" -variable tmpopts($key) } # Manage each widget EXCEPT 'fancybuttons' on MacOS 'Aqua' if {$key != "fancyButtons" || $w(wSys) != "aqua"} { grid $frame.c${row}$col -row $row -column $col -padx 5\ -sticky w } } } if {![set col [expr {$col ? 0 : 1}]]} { incr row } } # add validation to ensure only one of the showinline* options is set trace add var tmpopts(showinline1) write "monitor-inline $f" trace add var tmpopts(showinline2) write "monitor-inline $f" # The bottom row and right col should stretch to take up any extra room grid columnconfigure $frame 0 -weight 0 grid columnconfigure $frame 1 -weight 1 grid rowconfigure $frame $row -weight 1 pack $frame -side right -fill both -expand y update idletasks set maxwidth [max $maxwidth [winfo reqwidth $w(prefs)]] set maxheight [max $maxheight [winfo reqheight $w(prefs)]] pack forget $frame # Behavior (aka bindings) # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set frame $w(prefs).fBehavior # Option fields # Note that the order of the list is used to determine the layout. # So, if adding something to the list pay attention to what it affects. # # Remaining layout is a 2-col, row-major order (ie. cols vary fastest) # an 'x' means an empty column; a '-' means an empty row # (Note: rows must be fully filled - even if that means a trailing 'x') set row 0 set col 0 foreach key {Navigation navFrst x navLast x navNext x navPrev x navCntr - Merge\ Choice mrgLeft x mrgRght x mrgLtoR x mrgRtoL - Generic genEdit x genFind x genNxfile x genPvfile x genRecalc x genXit } { if {$key != "x"} { if {$key == "-"} { frame $frame.f${row} -bd 0 -height 10 grid $frame.f${row} -row $row -column 0 -padx 20 -pady 4 \ -columnspan 2 -sticky nsew set col 1 ;# forces NEXT column to zero and increments row } else { set b $frame.b${row}$col if {$col} { set tmpopts($key) $opts($key) label $b -text $pref($key) -takefocus 1 -relief sunken\ -highlightthickness 1 bind $b "getKey view %W $key" bind $b "getKey prep %W $key" bind $b "getKey rlse %W $key" } else { label $b -text $key -width 20 } grid $b -row $row -column $col -sticky ew -padx 5 -pady 2 } } if {![set col [expr {$col ? 0 : 1}]]} { incr row } } # The bottom row and right col should stretch to take up any extra room grid columnconfigure $frame 0 -weight 0 grid columnconfigure $frame 1 -weight 1 grid rowconfigure $frame $row -weight 1 pack $frame -side right -fill both -expand y update idletasks set maxwidth [max $maxwidth [winfo reqwidth $w(prefs)]] set maxheight [max $maxheight [winfo reqheight $w(prefs)]] pack forget $frame # Engine configuration # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set frame $w(prefs).fEngine set row 0 # Break page into two subframes for thw TWO engine commands we need # Then insert an entrybox for each into their first row # We will then populate any additional options by looping over each set LF1 [labelframe $frame.lf1 -text $pref(egnCmd)] set LF2 [labelframe $frame.lf2 -text $pref(egnSrchCmd)] entry $LF1.e$row -relief sunken -bd 2 -textvar tmpopts(egnCmd) \ -validate key -vcmd "verify egnCfg $LF2 %P egnSrchCmd" entry $LF2.e$row -relief sunken -bd 2 -textvar tmpopts(egnSrchCmd) \ -validate key -vcmd "verify egnCfg $LF2 %P egnCmd" grid $LF1.e$row -row $row -column 1 -columnspan 2 -sticky ew grid $LF2.e$row -row $row -column 1 -columnspan 2 -sticky ew # Option fields # Note that the order of the list is used to determine the layout. # So, if adding something to the list pay attention to what it affects. # # Remaining layout is a 2-col, row-major order (ie. cols vary fastest) # an 'x' means an empty column; a '-' means an empty row # (Note: rows must be fully filled - even if that means a trailing 'x') # (First 5 "egn*" Wdgs get a UNIQUE BIT-val 'onval' derived from $pwr2) foreach LF "$LF1 $LF2" {pwr2 row col keys} { 16 1 0 {- egnCase eopCase egnBlanks eopBlanks egn#Blanks eop#Blanks egn@TabX eop@TabX egn@EOL eop@EOL egnTabSiz eopTabSiz} 16 1 0 {- egnSCase eopSCase egnSBlanks eopSBlanks egnS#Blanks eopS#Blanks egnS@TabX eopS@TabX egnS@EOL eopS@EOL egnSTabSiz eopSTabSiz egnXcludFil eopXcludFil}} { foreach key $keys { if {$key != "x"} { if {$key == "-"} { frame $LF.f${row} -bd 0 -height 4 grid $LF.f${row} -row $row -column 0 -columnspan 2 \ -padx 20 -pady 4 -sticky nsew set col 1 ;# forces NEXT col to zero and increments row } else { set tmpopts($key) $opts($key) # There are TWO SETS (Diff/Srch) of suppressions: # create a unique PREFIX (per set) to group their # values collectively # ## N.B> BUNCHES of structure in the KEY NAMES: beware! if {[string match {???S*} $key] || [string match {???XcludFil} $key]} { set PfX "egnSOpt"} {set PfX "egnOpt"} if {[string match {eop*} $key]} { # This gets weird with a 'hidden' 3rd col despite # the LAYOUT pretending there is only TWO # (because we need a LABEL for the entry widget) set V [string match {*[SF]i[zl]} $key] label $LF.c${row}$col -text "via cmd flag:" entry $LF.e${row}$col -relief sunken -bd 2 \ -vcmd "verify $PfX $LF.c${row}0 %P %S $V" \ -invcmd "verify revert %W $key %s" \ -validate key -textvar tmpopts($key) grid $LF.e${row}$col -row $row -column 2 -sticky ew } elseif {$pwr2} { # The FIRST 5 checkboxes have specific $pwr2 ONvals set W [checkbutton $LF.c${row}$col -indicatoron 1 \ -text $pref($key) -variable w($PfX$pwr2) \ -onvalue $pwr2 -command "pickSuprs $PfX $pwr2" ] # Init widget var FIRST, afterward always REFLECT # the value OUTWARD back to the actual key setting set w($PfX$pwr2) $tmpopts($key) trace add var w($PfX$pwr2) write "apply {{k a i o}\ {set ::tmpopts(\$k) \$::w(\$i)}} $key" # Provide access to wdg AND var for later: # BECAUSE w($PfX$pwr2) is whats TIED to widget! # # Also the 'egnOpt' set of widgets must watch for # ALERTS indicating "diffcmd" has been ALTERRED! if {$PfX=="egnOpt"} { $W config -command [concat [$W cget -command] \ ";set tmpopts(diffcmd) \[formOpts egnCmd];" \ "verify alertD $key $W $pwr2"] dict set w(prefD) $key "$pwr2 $PfX $W" } # Decrement PowerOf2 for nxt time: 16->8->4->2->1->0 set pwr2 [expr {$pwr2/2}] } { set W [checkbutton $LF.c${row}$col -indicatoron 1 \ -text $pref($key) -variable tmpopts($key)] # Despite not being $pwr2-based, it STILL belongs # to its $PfX group, one of which needs more.... if {$PfX=="egnOpt"} { $W config -command \ "set tmpopts(diffcmd) \[formOpts egnCmd] ;\ verify alertD $key $W 0" # Provide access to wdg AND var for later: # (bit==0 says use "$key" - NOT "$PfX") dict set w(prefD) $key "0 $PfX $W" } } # Add logical predecessor link (ie. UpTree) to items # that can be turned OFF (supports dynamic hiliting) if {$PfX=="egnOpt" && [string match {egn*} $key]} { dict lappend w(prefD) $key ignSuprs } grid $LF.c${row}$col -row $row -column $col -sticky w \ -padx {5 0} } } if {![set col [expr {$col ? 0 : 1}]]} { incr row } } } # Collect ALL the keys, for which 'ignSuprs' was set as its UpTree link # and append THEM onto the value for 'ignSuprs' (eg. DownTree links) dict lappend w(prefD) "ignSuprs" \ [dict keys [dict filter $w(prefD) value {* ignSuprs}]] # Establish page layout compliance w/optional widgets BEFORE we measure $LF2.e0 validate # Assemble the labelframes into the page grid $LF1 -row 0 -column 0 -padx 8 -pady 8 -sticky ew grid $LF2 -row 1 -column 0 -padx 8 -pady 8 -sticky ew # Stretch last column (horiz) of labelframes to use extra space from... grid columnconfigure $LF1 2 -weight 1 grid columnconfigure $LF2 2 -weight 1 # ... whatever space THEY get passed from the surrounding page frame grid columnconfigure $frame 0 -weight 1 pack $frame -side right -fill both -expand y update idletasks set maxwidth [max $maxwidth [winfo reqwidth $w(prefs)]] set maxheight [max $maxheight [winfo reqheight $w(prefs)]] pack forget $frame # # # # # # # Assemble all the page/Tabs and Display one # # # # # # # setPrefPage [set g(prefPage) $w(prefs).fGeneral] # compute a reasonable FIRST location for the window... centerWindow $w(prefs) "$maxwidth $maxheight" } # Config Dialog RE-display: BEGIN with NO alert (USUALLY agrees at start) # THEN reinstate alert (via validation) if it was DEFERRED from last time if {[info exists g(deferD)]} { foreach key $g(deferD) { switch -glob $key { ign*E*Ln { set B 8 } ign*R*Ln { set B 4 } ignS* { set B 2 } diffcmd { set B 1 } default { set B 0 } } verify alertD $key [lindex [dict get $w(prefD) $key] 2] $B } unset g(deferD) Dbg "REINSTATED hilite: alertD STILL [dict get $w(prefD) alertD]" 1 } { dict set w(prefD) alertD 0 } # Too helpful to whack - can FORCE simply by PREFIXing to it: 1$g(debug) if {[set prefDbg $g(debug)]} { Dbg "PREF DICT:" $prefDbg foreach {key data} $w(prefD) { Dbg "$key {$data}" $prefDbg "\t" } } # FINALLY - display it! Dialog show $w(prefs) } ############################################################################### # Hotkey-edit event handler to display/capture/decode/establish global hotkeys # N.B> $wdg is EITHER the 'label' or an 'entry' depending on HOW FAR the # edit process has progressed - pay attention to binds, focus, and grabs # NOTE: does NOT "apply" the new binding - that happens during 'prefapply' ############################################################################### proc getKey {cmd wdg key args} { global w tmpopts opts pref switch $cmd { view { # Simply SHOW the user what the binding currently is $wdg config -text $tmpopts($key) set w(savLblBg) [$wdg cget -background] } prep { $wdg config -bg $opts(inform) # N.B> magic numbers to AVOID responding to Modifier keys (we hope) # (see Tcl manpage 'keysyms' to decode values) bind $wdg "if {(%N<65505 || %N>65518) && (%N!=65407)} { getKey edit %W $key %s %K}" focus $wdg ;# Make sure next keystroke is SEEN by above binding } rlse { # Perhaps (maybe?) needs to come here as well as # (ie. when we unmap it during 'edit' - or does that happen anyway?) $wdg config -text $pref($key) -bg $w(savLblBg) bind $wdg {} } edit { # Hide the label widget and pop an entry widget to take its place # (LOADING said entry widget with the VERY NEXT KEYSTROKE) # Entry widget NAME simply appends 'E' to the Label it replaces set tmpopts($key) [keyMods {*}$args] entry ${wdg}E -bg $opts(inform) -textvar tmpopts($key) grid ${wdg}E {*}[grid info $wdg] focus ${wdg}E ;# Trade focus to newly created widget grid remove $wdg ;# THEN Unmap (but dont forget) Label # ( N.B> this 'deactivates' its attached binding) update idletask # Now ensure "editting" is TERMINATED if user tries to go elsewhere bind ${wdg}E "getKey insert %W $key {*}$args" bind ${wdg}E "getKey cancel %W $key" bind ${wdg}E "getKey chkfocs %W $key {*}$args" bind ${wdg}E "getKey chkcncl %W $key %X %Y" # Buttonpress is tricky - COULD depend on WHERE it occurs ... # thus grab the pointer to make sure WE get to evaluate it # (should be SAFE -because- current toplevel is NOT MODAL) grab ${wdg}E } chkfocs { Dbg {$cmd $key as $tmpopts($key) via $wdg} # N.B> Only ${wdg}E widgets should call this subcommand # While not as critical for "Click-to-Type", "Focus-follows-Mouse" # could prematurely trigger a focus-loss in mid-edit which would # (due to trying to support focus-Tabbing AS an 'accept/insert'), # be MISTAKEN as such. Thus TRY to differentiate (if possible). # # (TK ?? Un-documented: [focus] reports EMPTY even when mouse # is moved OUT (in FfM mode) of the current Toplevel YET stays # WITHIN the "." Toplevel; But WILL report a value for a NEW # current Toplevel (such as the popup Help dialog): strange?!! # However, as the Help dialog is then FROZEN by the grab, # it becomes useless, thus we now prevent it from popping up # (which obviates any need to check for and deal with it NOW) # # Whatever - so if a Focus-Tab has occurred, we SHOULD see a new # window reported and we can therefore ACCEPT the pending edit if {[set win [focus -displayof [winfo toplevel $wdg]]] != {}} { Dbg { focus went to $win} # Presumption is user just used a [Tab] to complete the edit getKey insert $wdg $key {*}$args } } chkcncl { Dbg {$cmd $key as $tmpopts($key) via $wdg} # Decide if user is simply MOVING the entry insertcursor or DOING # something un/related IMPLYING we should CANCEL (or ACCEPT?) it. # N.B> Only ${wdg}E widgets should call this subcommand # SKIP: "Save" (is pointless); "Help" would be hung by the grab # N.B> ${wdg}E MAY no longer exist (if cancelled by Dismiss here) if {[winfo exists $wdg] && "$wdg" != "[set win [winfo containing {*}$args]]"} { # Somewhere else ... must we cancel? if {"$win" == "$w(prefs).btns.dismiss"} { Dbg { Was $win - need to cancel} getKey cancel $wdg $key $win invoke return -code break } elseif {"$win" == "$w(prefs).btns.apply"} { # sortof makes sense, if you think of it as a "shortcut" Dbg { Was $win - need to accept} getKey insert $wdg $key $win invoke return -code break } # Hmmm, we COULD notice a click on a DIFFERENT bind target and # cancel/switch (or accept/switch) to IT, but lets NOT for now # FYI - method: "event generate" TO the new widget window, # but after doing WHAT (accept/cancel)? } # Everything else should be fine. If we are still within the prefs # toplevel, the grab is in effect (pretty sure that applies to our # main windows as well) so NOTHING should happen as it wont ever be # DELIVERED anywhere else. However, if its outside the TOOL, we # WONT KNOW it, because the grab was NOT global...so we simply # pause and wait for the user to get back to us. } cancel - insert { Dbg {$cmd $key as $tmpopts($key) via $wdg (being destroyed)} # N.B> Only ${wdg}E widgets should call these subcommands if {$cmd != "cancel"} { # Re-instate angle-brackets (even if user TRIED to add them) # (Note: also prevents specifying virtual events) set tmpopts($key) "<[string map {< {} > {}} $tmpopts($key)]>" } else { set tmpopts($key) $opts($key) } # Whack the entry widget and RESTORE the LABEL widget back in place # (Derives original Label widget name FROM the given Entry widget) # Grab is implicitly released as its target ($wdg) is killed destroy $wdg grid [string replace $wdg end end] update idletask } } } ############################################################################### # Presumptious little routine to decode a Keypress into ALL its contributors ############################################################################### proc keyMods {state key} { global w # List of 'power-of-2' bit masks is used to recognize the modifers: # N.B> Certain bit patterns (Alt) were found as platform specific (win32)? foreach {bit nam} { 131072 "Alt" 128 "Mod5" 64 "Mod4" 32 "Mod3" 16 "Mod2" 8 "Mod1" 4 "Control" 2 "Lock" 1 "Shift" } { if {$state & $bit} { lappend modifiers $nam } } # MacOS doesn't seem to LIKE having 'Key' as a modifier - skip it... UNLESS # its a single DIGIT which WOULD be MISTAKEN as a Button; instead of a Key! if {$w(wSys) != "aqua" || [string match {[0-9]} $key]} { lappend modifiers Key $key } { lappend modifiers $key } # Platforms apparently define "preferred" names for certain modifiers # Some of this is platform derived, others (Aqua) was manpage derived set map(win32) [list "Mod1" "Num" "Mod3" "Scroll"] set map(aqua) [list "Mod1" "Command" "Mod2" "Option" ] set map(x11) [list "Mod1" "Alt" "Mod3" "Scroll"] return [string map $map($w(wSys)) [join $modifiers "-"]] } ############################################################################### # Formulate/return the DESIGNATED Cmd w/all ACTIVE options (not incldg Files) ############################################################################### proc formOpts {cmd} { global tmpopts opts # Each command OPERATES from ITS distinct context despite SHARED keys # N.B> When ADDing keys to the Engine page, need to put them HERE as well set keys {} switch $cmd { egnSrchCmd { upvar 0 opts ctx if {[lindex $opts($cmd) 0] ne [lindex $opts(egnCmd) 0]} { lappend keys egnSCase eopSCase egnSBlanks eopSBlanks \ egnS#Blanks eopS#Blanks egnS@TabX eop@STabX \ egnS@EOL eopS@EOL egnSTabSiz eopSTabSiz } else { # If names match then SHARE the keys/vals FROM the "egnCmd" lappend keys egnCase eopCase egnBlanks eopBlanks egn#Blanks \ eop#Blanks egn@TabX eop@TabX egn@EOL eop@EOL \ egnTabSiz eopTabSiz } lappend keys egnXcludFil eopXcludFil } egnCmd { upvar 0 tmpopts ctx if {$ctx(ignSuprs)} { lappend keys egnCase eopCase egnBlanks eopBlanks egn#Blanks \ eop#Blanks egn@TabX eop@TabX egn@EOL eop@EOL \ egnTabSiz eopTabSiz } } } # Certain keys need VALUES (and ANY might be config'd as "unused") set cmd $ctx($cmd) foreach {key opt} $keys { if {!$ctx($key)} { continue } # Keys w/VALUES have to worry about missing data and/or formatting if {[string match {*[FS]i[lz]} $key]} { set fmt [string match { *} $ctx($opt)] ;# seperate Val from Key? switch $key$fmt { egnSTabSiz0 - egnTabSiz0 { lappend cmd $ctx($opt)$ctx(tabstops) } egnSTabSiz1 - egnTabSiz1 { lappend cmd [string range $ctx($opt) 1 end] $ctx(tabstops) } egnXcludFil0 - egnXcludFil1 { # This is specified multiple times (once per pattern) foreach val $ctx(xcludeFils) { if {$fmt} { lappend cmd [string range $ctx($opt) 1 end] $val } { lappend cmd $ctx($opt)$val } } } } # Otherwise its JUST the optionflag all by itself } { lappend cmd $ctx($opt) } } return $cmd } ############################################################################### # Manipulating SUPPRESSION state transitions during Prefs editting, needs to # keep 5 widget-tracked (and potentially) 1 'combined') bit values in concert # AND enforce the cascaded precedence arrangement of LEGAL combinations # (N.B> Oh yeah, there are also THREE distinct SETS of 5 widgets - stay sharp!) ############################################################################### proc pickSuprs {key bit} { global w tmpopts opts # The (fundamentally boolean) values $w(${key}N) have a powers-of-two # NAMING and 'ON-value's connotation as each DESCRIBEs a specific BIT # Bit(16) is permitted to freely toggle, irrespective of any others, as # may bits (1 or 2) PROVIDED the higher PRECEDENCE bits (4 or 8) ARE zero. # Collectively, this establishes a 3 Tier "8->4->(2 or 1)" precedence # ranking among ONLY the lower 4 (out of 5) bits # # Based on what Bit just CHANGED, clear any from the WRONG rankings... switch $bit { 1 - 2 { lassign {0 0} w(${key}8) w(${key}4) } 4 { if {($w(${key}8) & 8)} { set w(${key}8) 0 } { lassign {0 0} w(${key}2) w(${key}1) } } 8 { lassign {0 0 0} w(${key}4) w(${key}2) w(${key}1) } } # ...then simply REBUILD the combined value (returning the result). return [expr $w(${key}16)+$w(${key}8)+$w(${key}4)+$w(${key}2)+$w(${key}1)] } ############################################################################### # A collection of (various) entry widget per-keystroke data content validators # (most used by Preferences - but 'occupancy' is EXCLUSIVELY for NewDiff use) # PLUS subsequent logic fragments that deal with interactions RELATED to them. ############################################################################### proc verify {subcmd args} { global w tmpopts opts # Establish a DEFAULT return status set result 1 # (individual subcmds -SPECIFICALLY real VALIDATORS- override as needed) switch -- $subcmd { revert { lassign $args W key oldV # REAL Validator: (but always returns TRUE) # Erase keystroke from widget display (by RELOADING its -textvar) # N.B> expected to be invoked via "entry -invcmd ..." - MUST NOT be # done until AFTER returning: '-validate none' WOULD become set! after idle "$W config -validate key ; set tmpopts($key) \"$oldV\"" } egnSOpt - egnOpt { lassign $args W newV chr V # REAL Validator (the options themselves): # Only blanks are DISALLOWED (unless its the PERMITTED pad-flag) set result [expr {$chr!=" " || [string first " " $newV $V] <0}] # Passed checkbox widget is DISABLED if value is fewer than 2 chars if {[string length $newV] - ([string index $newV 0]==" ") < 2} { # Also DE-hilite widget (unneeded for egnSOpt, but harmless) $W deselect ; verify hlit $W 1 1 ; alignState $W 0 } { alignState $W 1 } } egnCfg { lassign $args LFR Vc1 vc2 # MONITORING Validator: (returned status always TRUE) # Checks 1 or BOTH conditions (based on WHICH widget called): # - When editting the egnCmd, must reflect into "diffcmd" # (AND trigger the Alert, it in turn, causes). if {$vc2 == "egnSrchCmd"} { after idle { set tmpopts([set Key "diffcmd"]) [formOpts egnCmd] verify alertD $Key [lindex [dict get $w(prefD) $Key] 2] 1 } } # - Yet ALWAYS watches BOTH engine commands for 1st-word agreement # tripped by changes in 1st WORD in EITHER of the 2 Engine cmds. # First decide which WAY (manage -or- remove) the Option rows ... # ... then go DO it (basically one row at a time) # (kinda presumptious about names and layout), Eh...feeling lazy. if {[lindex $Vc1 0] ne [lindex $tmpopts($vc2) 0]} { foreach row {2 3 4 5 6 7} { # Doing this when UNNECESSARY has no detrimental effect grid $LFR.c${row}0 $LFR.c${row}1 $LFR.e${row}1 } } { foreach row {2 3 4 5 6 7} { # (loop lets a PREV UNmanaged state "do nothing" gracefully) foreach Wdg [grid slaves $LFR -row $row] {grid remove $Wdg} } } } hlit { lassign $args W newV oldV # REAL Validator: # Rather simple - hilite 'alert' status of given Wdg WHEN provided # values DIFFER (else DE-hilite) - BUT respect and/or deal with # the potentially varying STATE of that widget (disabled-> no chg!) set result [expr {"$oldV"!="$newV"}] # N.B> HOWEVER - 'state' MAY depend both on method of invocation # (Keyboard/mouse) AND the defn of widget (entry/checkbutton) # with regard to WHICH attribute should RECEIVE the hilite switch [$W cget -state] { readonly { # ENTRY widget: # ('disabled' color IS the 'normal BG' for a readonly) $W config -readonlybackground [expr {$result ? \ $tmpopts(inform) : [$W cget -disabledbackground]}] } active - normal { # CHECKBUTTON: 'active' occurs for mouse hover (thus click) # 'normal' covers most everything else regardless of Widget $W config -background [expr {$result ? \ $tmpopts(inform) : $w(bgnd)}] } default { # Only expected when W-state: 'disabled' (rare possibility) set result 0 } } } alertD { lassign $args key W bit # MONITORING Validator: (returned status always TRUE) # LOTS OF WORK for mostly GUI-fluff to WARN user that the Pref edit # LEADS to EXECUTING Diff (which wipes any EXISTING temporal work). # Hilites Apply-Btn if ANY contributors exist AND the 'W'dg # itself if IT is one of those RESPONSIBLE (there can be several) # Implies to user both IF and WHY the Diff will occur when APPLIED # and affords the opportunity to NOT CAUSE such changes casually switch -glob $key { reset { # Used when Apply/Dismiss-ing dialog to "start fresh" for # NEXT time (in lieu of destroying/rebuilding the Dialog). # Forcibly DE-HILITEs most everything! Does NOT ALTER ANY # state variables (except during a DISMISS of INLINE items) # N.B> Dismiss/Apply ITSELF assigns the ACTUAL Pref value dict for {K data} $w(prefD) { lassign $data bit PfX Wdg if {[string match {[ie]gn*} $K] && $PfX=="egnOpt"} { # Force EVERY alert hilite OFF. verify hlit $Wdg 0 0 # Snag 'diffcmd' widget as it passes by (used shortly) } elseif {$K=="diffcmd"} { set W $Wdg } } verify hlit $W $tmpopts(diffcmd) $opts(diffcmd) # Marginally related: these 'hidden' widgetVars need to # piggyback on any RESET being performed as well. # (has no effect when performing APPLY, as ALREADY set) foreach bit {16 8 4 2 1} { set w(inlSuprs$bit) [expr {$opts(inlSuprs) & $bit}] } # Last, dont forget to de-hilite the Apply button itself # N.B> Associated alert-contrib Bits RESETs at RE-display verify hlit $w(prefs).btns.apply 0 0 return $result } ign*R*Lnopt - ign*R*Ln { # Hilite depends on TWO (related) keys, # and what values EACH will ultimately have - # Whats awkward is BOTH trying to HILIT the SAME widget # (the toggle). # If any LIST items EXIST and the toggle CHANGED, - OR - # is PRESENTLY on and the ITEMS were changed, then HILIT; # Otherwise HILITE is either forced OFF *or* left unchanged if {[string match {*opt} $key]} { # (ONLY invoked when a physical LIST change occurred) if {$tmpopts(ignoreRegexLn)} { set OnOff \ [verify hlit $W $tmpopts($key) $opts($key)] } { return $result } # This handles whenever the TOGGLE is flipped } elseif {[llength $tmpopts(${key}opt)]} { set OnOff \ [verify hlit $W $tmpopts($key) $opts($key)] } { set OnOff 0 } } ign*E*Ln { set OnOff [verify hlit $W $tmpopts($key) $opts($key)] } pushtomenu { # (really just a util fcn tangentally related to "alertD") # The first 3 View->menuitems need to USE the HILITE color # to ALSO warn of an impending Diff. Simply PUSH that color # into them should that color HAPPEN to become changed. foreach item {0 1 2} { $W entryconfig $item -activebackground $opts(inform) } return $result } diffcmd - ignSuprs { # When executing via "diffcmd", SOMEONE already changed it; # otherwise "ignSuprs" was toggled (ON-or-OFF) thus it must # be recomputed (which will come thru here a SECOND time). if {$key=="ignSuprs"} { set tmpopts(diffcmd) [formOpts egnCmd] } set OnOff [verify hlit $W $tmpopts(diffcmd) $opts(diffcmd)] # However, if "ignSuprs" was just TOGGLED Off, then it # BLOCKED any Engine-based CHANGES and could thus BECOME # the NEW reason for a different 'diffcmd'. Re-evaluate if # any Engine elements should therefore DE-hilite by passing # a FICTICIOUS keyname (which is BASICALLY a simulation of # a 'fall-thru' switch-case which TCL doesn't support!) if {$key=="ignSuprs"} { verify alertD egnOpt } } default { # These are specific Engine pref toggles tweaked On/Off # - determine if that results in a CHANGE in the alert # status (particularly when being turned OFF!). # Must assess ALL the POSSIBLE reasons, reflecting EACH # status as they MAY BE inter-related! dict for {K data} $w(prefD) { lassign $data bit PfX Wdg PrD if {[string match {egn*} $K] && $PfX=="egnOpt"} { # Next align any alert hilites (either ON or OFF). # FORCE an OFF when predecessor (PrD) is ALSO OFF. # N.B> 'bit' chooses WHERE TO FIND values needed if {$bit} { incr AnyToggled \ [verify hlit $Wdg [expr {$tmpopts($PrD) ? \ $opts($K) : $w($PfX$bit)}] $w($PfX$bit)] } { incr AnyToggled \ [verify hlit $Wdg [expr {$tmpopts($PrD) ? \ $opts($K) : $tmpopts($K)}] $tmpopts($K)] } # Snag 'ignSuprs' widget as it passes by (need below) } elseif {$K=="ignSuprs"} { set W $Wdg } } # If ALL above verifys are OFF, RE-verify $PrD widget *VIA* # "diffcmd" (NOT "ignSuprs"!!!) so that ALL it DOES is # the 'verify hlit' (but CONTINUING UpTree) - BUT USE # the 'bit' value for ignSuprs so it removes any Apply-btn # hilite IFF DE-hiliting "ignSuprs" was ALSO accomplished. if {!$AnyToggled} { verify alertD diffcmd $W 2 } return $result } } # Weird boolean expression SETS a specific BIT per the OnOff value # Odder YET - 'dict update' CAUSES "isApplied" to BECOME a localVar # to CONTAIN that updated value - which THEN hilites the Apply btn! dict update w(prefD) alertD isApplied \ "set isApplied \[expr {(\$isApplied & ~$bit)+($bit * $OnOff)}]" verify hlit $w(prefs).btns.apply 0 $isApplied } integer { lassign $args newV digit # REAL Validator: # Fairly simple - # IF proposed value is still an integer - accept - else dont. # # N.B> allows SURROUNDING blanks UNLESS 'digit' (%S) was PROVIDED # (Note: w/o '-strict' completely EMPTY is considered VALID) if {$digit=={} || [string match {[0-9]} $digit]} { set result [string is integer $newV] } elseif {$digit!={} && $digit==" "} { set result 0 ;# caller disallows any 'padding' blanks } { set result [string is integer $newV] } } occupancy { lassign $args Wdg newV # MONITORING Validator: (returned status always TRUE) # Designed for the newDiff 'revision' fields # Disables the LABEL (W) when the ENTRY value (newV) is empty ... # (a GUI feedback trick to discern an EMPTY .vs. BLANK field) # # BUT also monitors the main PAIR of Rev entry-widgets to warn # user about using entry widget #2 w/o using #1 # (because 'assemble-args' would then READ #2 as-if #1) # (grab instance number of widget - not applicable if none exists) if {[string is digit [set ndx [string index $Wdg end]]]} { set Other([set Other(2) 1]) 2 ;# (meta-pgm identity value) # Next, derive meta-addressable names for PAIRED entry widget append W($ndx) [file rootname $Wdg] \ [string map {l e} [file ext $Wdg]] set W($Other($ndx)) [string repl $W($ndx) end end $Other($ndx)] # finally adjust the bkgnd of #2 if it is USED when #1 is empty if {($ndx==2 && "$newV" != "" && ![$W(1) index end]) \ || ($ndx==1 && "$newV" == "" && [$W(2) index end])} { $W(2) configure -bg Tomato } { $W(2) configure -bg [$W(1) cget -bg] } } # Simple length check determines STATE of the (provided) label-wdg $Wdg configure -state [expr {[string length $newV] ? "normal" : "disabled"}] } } # Each REAL validator has its OWN rules for acceptance, just return result return $result } ############################################################################### # Align status of passed widget(s) to agree with passed var($index) bool value # N.B> 3 variants - "...Tr..." interfaces with traced array variables (which # 'linkState' CREATEs by naming the Controll-ED WIDGET & Controll-ING Var) # Basic version allows a LIST of widgets to be supplied for alignment ############################################################################### proc linkState {Wdg Var} { uplevel trace add variable $Var write "{alignTrState $Wdg}" } proc alignTrState {widget name elem op} { upvar $name var alignState $widget $var($elem) } proc alignState {wdgLst boolean} { foreach W $wdgLst { $W configure -state [expr {$boolean ? "normal" : "disabled"}] } } ############################################################################### # Specialized color-picker invoked by button (feedback to specific button -bg) ############################################################################### proc clrpick {wdg key} { global pref tmpopts set color [tk_chooseColor -initialcolor [$wdg cget -activebackground] \ -parent [file rootname $wdg] -title "Choose $pref($key)"] if {"$color" != ""} { $wdg configure -activebackground [set tmpopts($key) $color] } } ############################################################################### # Manage user interaction with any pref represented via a 'list of values' ############################################################################### proc editLstPref {key args} { global pref tmpopts # Empty values simply have no effect and are ignored # (we sortof use it as feedback that we "accepted" the add/delete) foreach {wdg value} $args { if {![string length "[string trim "$value"]"]} {return} } # Ugh - the combobox widget apparently has a *global* GRAB in progress ... # So we CANT really popup modal dialogs for confirmations, etc. # Instead, we will ENCAPSULATE the notices/feedback/actions to occur # *after* this callback (and combobox) are DONE (and the grab is gone) # # N.B> "subst + backslashing" is needed to resolve & embed LOCAL vars # Confirm requests to DELETE from the list if {[set ndx [lsearch -exact $tmpopts($key) "$value"]] >= 0} { after idle [subst { if {{ok} == \[tk_messageBox -type okcancel -icon question \ -title {Please Confirm} -parent [file rootname $wdg] \ -message "Remove this entry from the\n'$pref($key)' list ?" \ -default cancel ]} \ { set tmpopts($key) \[lreplace \$tmpopts($key) $ndx $ndx]; \ editLstFeedback $wdg $key { R e m o v e d} } }] } else { # Possibly validate the FORM of the specific entry before ADDING it if {"$key" == "filetypes" && [llength "$value"] != 2} { after idle [subst { tk_messageBox -type ok -title {Syntax error} -icon info \ -parent [file rootname $wdg] -detail {(not added)} \ -message "Format should be '{filetype label} .extension'" }] } else { after idle [subst { lappend tmpopts($key) {$value} ; \ editLstFeedback $wdg $key { A d d e d} }] } } } ############################################################################### # Pure unadulterated GUI fluff (lets user KNOW their edit was accepted) ############################################################################### proc editLstFeedback {wdg key msg} { global w # Pretend to enter a new value (but dont let the command fire) ... then # 1250ms later, clear with an EMPTY value (and LET it fire w/no effect) $wdg configure -commandstate disabled $wdg configure -value "$msg" after 1250 "$wdg configure -commandstate normal -value {}" # Admittedly strange place to put this, but from a SEQUENCE point-of-view # it snags that the edit HAS OCCURRED which warrants FURTHER feedback. # Other oddity is redirecting such feedback into a RELATED widget if {$key=="ignoreRegexLnopt"} { verify alertD $key [lindex \ [dict get $w(prefD) [string range $key 0 end-3]] 2] 4 } } ############################################################################### # Emulate SEMI-radio-button behavior: only 1 can be 'on', BUT BOTH may be 'off' # Simultaneously adjust state of subordinate attribute widgets as well ############################################################################### proc monitor-inline {W name index op} { global tmpopts switch $index { "showinline2" { alignState "$W.l $W.b16 $W.b8 $W.b4 $W.b2 $W.b1" $tmpopts($index) if {$tmpopts($index)} { set tmpopts(showinline1) 0 } } "showinline1" { if {$tmpopts($index)} { set tmpopts(showinline2) 0 } } } } ############################################################################### # Finalize packing the Preferences dialog for the largest "tab" overlay # and designate which to actually display ############################################################################### proc setPrefPage {which} { global w pack forget $w(prefs).fGeneral pack forget $w(prefs).fAppearance pack forget $w(prefs).fDisplay pack forget $w(prefs).fBehavior pack forget $w(prefs).fEngine pack $which -side right -fill both -expand y } ############################################################################### # Quickly spin through all the prefs and look exclusively for any that WERE # editted, yet NEVER applied. Request permission to remove them and base the # decision to erase them AND dismissal of the dialog on that answer ############################################################################### proc prefdismiss {prefwin} { global g pref opts tmpopts # Anything here that was UN-"Apply"-ed ? # (that WASN'T specifically DEFERed) foreach key [array names pref] { if {"$tmpopts($key)" ne "$opts($key)" && (![info exists g(deferD)] || $key ni $g(deferD))} { if {![info exists YN]} { set YN [popmsg "You made UN-APPLIED edits !\n\n Remove them?"\ "Please confirm" question yesno $prefwin] if {$YN == "no"} { return } } set tmpopts($key) "$opts($key)" Dbg "Dismiss: Un-setting $key" } } if {![info exists YN] || $YN == "yes"} { # Make certain any internal Vars are re-aligned w/what WILL exist # and ensure nothing remains hilited, then UNMAP the Dialog verify alertD reset Dialog dismiss $prefwin } } ############################################################################### # Apply customized preferences - $WdG is only provided when invoked from dialog # and is the ID of the 'Apply' button that caused it to become invoked # Expects $opts() holds CURRENT settings; $tmpopts() ALL (possibly CHGD) values ############################################################################### proc prefapply {{WdG {}}} { global g w pref opts tmpopts set feedback green ;# Presumed 'status' of updating prefs (AS A WHOLE) set prevgrid [wm grid .] # Geom-manager 'propagation' is generally OFF within w(client) to force any # sizing changes (particularly subtle ones such as font adjustments caused # by Text tagging) to "trade" among its OWN widgets, instead of "Appealing" # for more space from the toplevel. Its ALSO critical to our EMULATION of a # 'pane window' relation between the L/R Txtwins (SANS a widget): it too # needs a hard-stop confined area to work properly. YET, we come through # this 're-cfg' code not ONLY when the USER asks us to, but ALSO during the # INITIAL startup BEFORE we have ANY IDEA how big anything SHOULD be, and # thus appealling TO the Toplevel is actually a NECESSITY... # # SO we USE the fact that AT startup, propagation is NOT YET "OFF" # (it will BECOME SO after we return from that SPECIFIC startup call) # # HOWEVER - the behavior we WANT is to prevent the INITIAL startup from # producing a window LARGER than the current screen - even if we have to # LIMIT the users "preferred" opts(geometry) value regarding Txtwin sizes # # Afterward, the Toplevel will be modifiable ONLY by the USER, yet it # should ALWAYS operate in a 'gridded' resize-mode. This gets insidious # when considering that some 'prefs' might control the visibility of client # elements which could ALTER the amount of Txtwin real-estate, and thus # WOULD modify the "grid defn" for that Toplevel. But there is a CATCH: # # TYING a Txtwin *into* its Toplevel (via the Txtwdg "-setgrid 1" option) # ONLY WORKS PROPERLY if IT is the ONLY widget to absorb any resizing! # # It turns out we have one Toplevel that DOES (merge) and one NOT (client)! # Yet there is a STOOPID reason we still want to use "-setgrid 1" in BOTH # cases - and that is the Txtwdg calculates its OWN IDEA of what the grid # INCREMENT size (in pixels) is for the loaded font! Something we can only # approximate by "measuring an entire alphabet" and divide by 26 - which # works - but is clearly "English based" unlike all user-provided files to # be displayed. SO WE ARE BANKING on TK to "get it right" by LETTING it # THINK (for a moment) that just ONE of the L/R (client) Txtwdgs will be # TIED to the Toplevel **JUST** so we can get that Font analysis performed. # Then we will sever the connection, but USE the computed pixel value, and # install NEW Toplevel 'gridding' parameters ourselves! What a PITA!! # N.B> Despite being described here, this all MOSTLY happens @ the end. if {! [file isdirectory $tmpopts(tmpdir)]} { popmsg "Invalid temporary directory:\n$tmpopts(tmpdir)\nReverted ..." \ $w(prefs) set tmpopts(tmpdir) $opts(tmpdir) set feedback red } # (Possibly) rebalance the Txtwin(s): # Effectively CANCELs any EXISTING L/R 'pane' adjustments, # and RESULTs in re-centering the DiffMap (if displayed) # N.B> Subtle impact: Should cause L/R Txtwdg WIDTHs to become IDENTICAL! grid columnconfigure $w(client) {0 2} -weight 100 -uniform a # This may look contrived (see discussion above for explanation) ... # ... the point is that IF it fails for ONE, it LIKELY fails for ALL, # so there is little point to "fail and reset" over-and-over foreach wdg {Left merge Right Bottom} toplnk {1 1 0 0} { # Should this Txtwdg LINK to its Toplevel (for gridded resizes)? if {$toplnk} {set toplnk "-setgrid 1"} {set toplnk ""} # N.B> ensure 'toplnk' has every chance of becoming set (when active): # Even *if* USERS input is invalid (to preserve later code semantics) if {[catch "$w(${wdg}Text) configure $toplnk $tmpopts(textopt)"]} { popmsg "Invalid text widget setting:\n\n'$tmpopts(textopt)'" \ $w(prefs) # Error recovery - restore PRIOR settings (+ DONT do any further!) $w(${wdg}Text) configure {*}$opts(textopt) set tmpopts(textopt) $opts(textopt) set feedback red break } } # Make certain the (now established) Text FG/BG colors are PUSHed into # attrs needed to visibly see their focus-highlight border, and the BG # of their adjoining Info windows (just get seed values from CURRENT win) set fg [$w(acTxWdg) cget -foreground] set bg [$w(acTxWdg) cget -background] foreach txtwin {Left Right merge} { $w(${txtwin}Text) configure -highlightb $bg -highlightc $fg $w(${txtwin}Info) configure -background $bg } #NOTE: This loop is basically "testing" each NEW tag setting for syntactic # validity (as well as 'installing' them). H O W E V E R ... # it is IMPERATIVE they PROCESS (and thus remain) in PRECEDENCE order # already ESTABLISHED @creation time foreach tag [lsearch -all -inline [$w(acTxWdg) tag names] "*tag"] { foreach win [list $w(LeftText) $w(RightText)] { if {[catch "$win tag configure $tag $tmpopts($tag)"]} { popmsg "Invalid settings for \"$pref($tag)\":\n\ \n'$tmpopts($tag)' is not a valid option string\nReverted..." \ $w(prefs) # if one fails, restore its prior 'good' setting eval "$win tag configure $tag $opts($tag)" set tmpopts($tag) $opts($tag) set feedback red } } } # Same for the (only) tag for the line-comparison widget ... if {[catch "$w(BottomText) tag configure diff $tmpopts(bytetag)"]} { popmsg "Invalid settings for \"$pref(bytetag)\":\n\ '$tmpopts(bytetag)' is not a valid option string.\nReverted..." \ $w(prefs) # Again, if it fails, restore the prior 'good' setting eval "$w(BottomText) tag configure diff $opts(bytetag)" set tmpopts(bytetag) $opts(bytetag) set feedback red } # ... but if that tag contained a FONT request, we want to elevate that # font to the entire widget (lest it obscure the windows basic purpose) # INCLUDING the possible need to re-cfg the window height to match if {[set bHiFont [$w(BottomText) tag cget diff -font]] ne ""} { if {$bHiFont ne [$w(BottomText) cget -font]} { $w(BottomText) configure -font "$bHiFont" -height 2 } } # tabstops require a little extra work. We need to figure out the width of # an "avg char" in the widget's font, multiplying by the tab stop "count". # We tried using an "m", but "0" appears to work better. set cwidth [font measure [$w(acTxWdg) cget -font] "0"] set tabstops [expr {$cwidth * $tmpopts(tabstops)}] $w(LeftText) configure -tabs $tabstops $w(RightText) configure -tabs $tabstops $w(mergeText) configure -tabs $tabstops # But, for the bottom text widget, the tabstop is adjusted to take into # consideration the two bytes PREFIXED to each line (ie: "< " or "> "). $w(BottomText) configure -tabs \ [list [expr {$tabstops+($cwidth*2)}] [expr {2*$tabstops+($cwidth*2)}]] # Set remaining 'opts' to the values from 'tmpopts' # N.B> any ERRORS to this point have all been REVERTED to prior values # PAY ATTENTION: # Most options represent "data state" values and can simply be 'set', # that INCLUDES those already processed (above) which WILL be recorded; # but some are TRANSITION (or 'edge') triggered and thus must notice # when they are being CHANGED, more so than JUST their final value. # # With such 'edge' options, SEQUENCE *does* make a difference, # such as the 'ignore...' group, which could force a REdiff and thus # influence OTHER settings, such as skipping tasks which ultimately get # redone anyway (such as inline-diff processing, which ITSELF has its # own sequence issue [unwinding 2 NEARLY mutually exclusive values]). # We also want to avoid the time it can take to RE-tag everything # (via a call to 'remark-diffs') if we dont need to - so we have to # watch for CHANGES among the options that *could* have altered tags. # # BUT WE CANT assess *all* of that until we've seen ALL the settings # (or worse, write code to handle each COMBINATION that might occur) # # SO - we 'pre-arrange' those settings having their OWN issues into a # sub-order we can depend on (to write the logic ONE way), and then post # flag values we can assess AFTERWARD to enforce the larger precedence # issues - thus avoiding the "excess" work alluded to above. # # (N.B.: when the startup coding invokes 'prefapply', it just COPIES # 'opts' into 'tmpopts' first - as such, transitions will NEVER exist.) # First we need an 'inversion' primitive to access meta-state values ... set OTHER(showinline1) showinline2 set OTHER(showinline2) showinline1 # ... NEXT, preload any keys needing their OWN precedence order ... # (Does anyone appreciate all this work for 'auto-Diff'ing?) # # (Reason: must see ANY key that MIGHT trip an 'error' BEFORE we look at # whether the Diff cmd changed. EG- ANY of the hotkey bindings!! # (Would need to DEFER a redo-Diff execution if errors detected) lappend keys genEdit genFind genNxfile genPvfile genRecalc genXit navFrst \ navLast navNext navPrev mrgLeft mrgRght mrgRtoL mrgLtoR \ geometry diffcmd # (Reason: chgd content of an '...opt' field that IS [and WILL] remain # in use, OR turning the entire category ON/OFF for a redo-Diff) lappend keys ignoreEmptyLn ignoreRegexLnopt ignoreRegexLn # (Reason: switching among inline algorithms, INCLUDING simple ON or OFF) lappend keys showinline1 showinline2 # (followed by EVERY PREF defined - BUT each mostly PROCESSES once) # N.B> ensures we dont MISS any (as has happened before... ) lappend keys {*}[array names pref] # ... finally, init the flags we need to derive - and then GET TO IT!! set remap [set remark 0] ;# defaulted as: do NOT remap or remark set inlActn {} ;# NOR 'compute-inlines' or force a Diff if {[info exists g(deferD)]} { set redoDiff $g(deferD) ;# UNLESS that rediff was PENDING!!! unset g(deferD) } { set redoDiff {} } foreach key $keys { # What (if anything) is transitioning ? if {$tmpopts($key) ne $opts($key) && $key ni $redoDiff} { switch $key { "geometry" { # More of a syntax-chk validation than a transition issue if {2 > [scan $tmpopts(geometry) "%dx%d" na na]} { popmsg "Invalid geometry:\n$tmpopts(geometry)\n \ Reverted..." $w(prefs) "Improper syntax..." set tmpopts(geometry) $opts(geometry) set feedback red } } "diffcmd" - "ignoreEmptyLn" { # EITHER a NEW Diff command was formatted, OR tertiary output # needs to be RE-analyzed for ignoring empty-line hunks. # N.B> The fact that this IS DIFFERENT is sufficeint if {$key ni $redoDiff} { lappend redoDiff $key } } "ignoreRegexLnopt" { # Here we catch changes made in the "...opt" field while the # toggle REMAINS in a (non-transitional) 'ON' state... set key2 [string range $key 0 end-3] if {$tmpopts($key2) && $opts($key2) && $key2 ni $redoDiff} { lappend redoDiff $key2 } } "ignoreRegexLn" { # Turning this 'ON' requires REFERING to a non-empty opt list # (N.B> depends on "...opt" being processed FIRST) if {$tmpopts($key)} { if {![llength $opts(${key}opt)]} { set tmpopts($key) 0 } elseif {$key ni $redoDiff} { lappend redoDiff $key } #but turning 'OFF': gauranteed (couldn't have been ON w/o data) } elseif {$key ni $redoDiff} { lappend redoDiff $key } } "egnCase" - "egnBlanks" - "egn#Blanks" - "egn@TabX" - "egn@EOL" - "egnTabSiz" { # All these are dependent on the EVENTUAL state of "ignSuprs" # When ON, each of these is a contributor to "diffcmd" and # thus subject to DEFERRAL if an error occurs. # Otherwise, simply accepting the toggle is sufficient # (N.B> MUST be processed AFTER having seen "diffcmd") if {$tmpopts(ignSuprs) && "diffcmd" in $redoDiff} { lappend redoDiff $key } } "showinline1" - "showinline2" { # (meta-logic here only APPEARS convoluted) # Basically has only 3 possibilities: # # ... a DOUBLE transition: MUST select the eventual 'ON' if {"$tmpopts($OTHER($key))" ne "$opts($OTHER($key))"} { if {$tmpopts($key)} { # THIS opt *is* the 'ON', but must then PRESET # the other OFF (to eliminate the 2nd transition) set opts($OTHER($key)) 0 } set inlActn "compute-inlines $key" # ... a single OFF -> ON transition # -OR- the ALLOWED 2nd transition from prior DOUBLE) # (N.B> but passes an explicit NOFLUSH flag for the former) } elseif {$tmpopts($key)} { set inlActn "compute-inlines $key [expr {"$inlActn" != {}}]" # ... a single ON -> OFF transition } else { set inlActn "compute-inlines off" } } "inlSuprs" { # (N.B> processes AFTER 'showinline' above) # This only needs to DO something if: # 1. its value CHANGED (obviously) # 2. the RESULT (from above) of 'showinline2' is true # 3. and 'inlActn' was NOT already set (from above) # Otherwise, just recording the changed value is fine if {$inlActn == {} && $opts(showinline2)} { set inlActn "compute-inlines showinline2" } } "genEdit" - "genFind" - "genNxfile" - "genPvfile" - "genRecalc" - "genXit" - "navFrst" - "navLast" - "navNext" - "navPrev" - "mrgLeft" - "mrgRght" - "mrgRtoL" - "mrgLtoR" { # Pass the EXISTING bindScript TO the NEW keystroke defn # (ALL global shortcuts APPLY to the 'toplevel' widgets) if {[catch "bind . $tmpopts($key) {[bind . $opts($key)]}" E]} { popmsg "Bind failed: Preference '$key':\n$E\nBind Ignored" \ $w(prefs) bind . $tmpopts($key) {} ;# Failed- need to remove try? set tmpopts($key) $opts($key) ;# RETAIN old keystroke!! set feedback red } { # Success! Push to the other toplevel, & erase old hotkey # N.B> problematic if reassigning SAME hotkey TWICE (seq?) Dbg {$key binding swapped: $opts($key) to $tmpopts($key)} bind $w(merge) $tmpopts($key) "[bind $w(merge) $opts($key)]" bind .merge $opts($key) {} bind . $opts($key) {} # Also update any MENUs that are advertising the hotkey! if {[info exists w(Accel,$key)]} { foreach {mnu idx} $w(Accel,$key) { $mnu entryconfigure $idx -accelerator "$opts($key)" } } } } "mapchg" - "mapdel" - "mapins" - "mapolp" {set remap 1} "chgtag" - "currtag" - "deltag" - "difftag" - "inlinetag" - "instag" - "overlaptag" - "tagtext" - "textopt" {set remark 1} } if {$feedback=="green" || $key ni $redoDiff} { set opts($key) $tmpopts($key) Dbg "ACCEPTED $key" 0 "Apply: " } { Dbg "DEFERRED $key" 0 "Apply: "} } } # interpret this binary toggle into its true value set opts(relief) [expr {$opts(fancyButtons) ? "flat" : "raised"}] # Need to TRANSLITERATE the USER input form of "Text tags" that deal with # the display attrs of Text, LineNumbers and/or ChangeBars, and INSTEAD # compute a derivation into data lists [g(scrInf,tags) and g(scrInf,cfg)] # that can emulate (via a canvas) what WAS FORMERLY implemented (TkDiff 4.2 # and earlier) as individual Text widgets. This all comes together in # 'plot-line-info' which renders the EQUIVALENT Info data format as before, # but WITHOUT the potential line-skewing introduced by TK V8.5 enhancements translit-plot-txtags $w(acTxWdg) ;# L/R Text attrs identical: grab one # Walk down our DERIVED precedence-list flags and find out what needs doing # (which is nothing if its all being handled by forcing a whole new Diff) # N.B> if any prior ERRORS occurred then THOSE ITEMS reverted to UNCHANGED, # and are UNABLE to trigger any derivative changes, thus do NOT restrict # performing such actions (may as well do what we KNOW needs doing) if {![llength $redoDiff]} { # (what about any altered tag SETTINGs ?) if {$remark} { eval $inlActn ;# MAYBE recompute inlines (so they CAN be tagged ?) remark-diffs show-status "" # (or how about ONLY an altered inline algorithm or on/off state ?) } elseif {"$inlActn" != ""} { eval $inlActn ;# recompute the inlines } # chgd map colors if {$remap > 0 && $g(startPhase) > 1} { map-draw } } # Align, (show or hide) various data (Lnums, Cbars, etc.), and we are done cfg-toolbar do-show-Info do-show-map do-show-lineview multiFile threshld $opts(fLMmax) ########################################################################### ### OK - thats it for getting preferences in place - - - ###### # BUT we MAY need to look at HOW LARGE the tool window might become # IF we follow ONLY the prefs. We wish to PREVENT the INITIAL tool window # from EXCEEDING the screensize by TREATING the 'geometry' pref more as a # 'upper-bound' than as an explicit requirement. # # IN ADDITION, despite having earlier connected the Left wdg FOR gridding, # ALWAYS *dis-connect* it from its Toplevel AGAIN after the prefs setup # REGARDLESS because its technically WRONG (only works for 1 widget -- # WE have TWO)!! Nevertheless, we need to USE it to PRESEVE any potential # RESIZE the user MAY have performed in the interim. lassign [concat [wm grid .] $prevgrid] \ GW(1) GH(1) GcW(1) GcH(1) GW(0) GH(0) GcW(0) GcH(0) Dbg {PROPOSED wm grid is WxH($GW(1)x$GH(1)) of WxH($GcW(1)x$GcH(1))pxls\n\ \twhile PREVsz was WxH($GW(0)x$GH(0)) ($GcW(0)x$GcH(0))} if {$WdG == {}} { # ON STARTUP--- (one time per session only) # Turn the SCREEN pixel size into an equiv number of Fontbased grids, # divided by 2 (for each TxtWdg), and (ugh) FUDGE its companions sizes. # (Apologies for the 'magic "-18"' in this equation - how it came to # BE is lost to history - my best guess is it represents *A* means # of accounting for what USED to be multiple vertical widgets w/fixed # widths, that '-setgrid' is NOT measuring, but ARE a portion of what # gridded-resizing is expected to manage (expressed in grid-incr(s).) # Ultimately 'maxw' is the LARGEST #of chars (ie. grid cells), that if # configured to BOTH Txtwdgs, results in NO screen-clip of the WINDOW # Similarly 'maxh' is the equivalent height value, again in grid units set maxw [expr {(([winfo vrootwidth .] / $GcW(1)) / 2) - 18}] set maxh [expr {([winfo vrootheight .] - ($opts(showlineview) ? [winfo reqheight $w(BottomText)] : 0) - [winfo reqheight $w(menubar)] - [winfo reqheight $w(toolbar)] - [winfo reqheight $w(status)]) / $GcH(1)}] # N.B> 1st-time execution @create-time: make sure REQSTD geometry # ISNT itself causing the INITIAL window to EXCEED the screen size! # User can always MANUALLY resize LATER if they so choose. scan $opts(geometry) "%dx%d" width height set GW(1) [min $maxw $width] set GH(1) [min $maxh $height] Dbg {Trim BOTH L/R to NEW computed width($GW(1)) - and detach gridding} $w(LeftText) configure -height $GH(1) -width $GW(1) -setgrid 0 $w(RightText) configure -height $GH(1) -width $GW(1) # Double it: one for each L/R TxtWdgs and CHOOSE it for final settings # N.B> *this* is the portion that "-setgrid 1" DOESN'T understand!! incr GW(1) $GW([set i 1]) } else { # Make sure we DISCONNECT the Toplevel from the widget, but PRESERVE # any GRIDDED size the USER may have MANUALLY adjusted the window to # This gets a little hairy if the NEW prefs has CHANGED the CellSz # and MAY yet be ODDER if the window manager has alterred the window, # as it appears (on X11 anyway) to 'reserve' space for the menubar # by TRIMMING the grid width-count of cells to not invade it. # Thus recompute the Width COUNT to express the same POSITION but with # utilizing the ?NEW? Cell size Width if {$GcW(0) != $GcW(1)} { set GW(0) [expr {( $GcW(0) * $GW(0) ) / $GcW(1)}] } $w(LeftText) configure -setgrid [set i 0] set hold [$WdG cget -activebackground] ;# Let user know if it worked $WdG configure -activebackground $feedback ; $WdG flash $WdG configure -activebackground $hold } update idletasks ;# update all this (we BELIEVE *up* the geom mgr chain) wm grid . $GW($i) $GH($i) $GcW(1) $GcH(1) ;# Make grid deal w/L&R wdgs Dbg { NEW wm grid is ($GW($i) X $GH($i)) ($GcW(1) x $GcH(1))} # Force a whole new Diff if user changed ANY of the result semantics # PROVIDED we passed thru re-configuration unscathed; OTHERWISE ... # remember we NEED to, but ONLY GENTLY remind User to fix their mistakes if {[llength $redoDiff]} { if {$feedback == "green"} {verify alertD reset; reCalcD $redoDiff} { popmsg "Due to previous errors, a detected need for re-invoking\ Diff has been deferred.\n\n Respecify any items that were\ 'Reverted' and 'Apply' them again" warning $w(prefs) \ "Diff request deferral..." set g(deferD) $redoDiff ;# Remember this is PENDING!! } } elseif {$inlActn != {} && $opts(showinline2)} { # Must nudge L/R Text widget to re-evaluate visibility of INLINES # N.B> asking to see the Window *2nd* line is a virtual guarantee that # *NOTHING* will scroll - but the REQUEST gains us a Visability scan after idle after 0 $w(acTxWdg) SEE @0,0+1line } } ############################################################################### # Save customization changes. ############################################################################### proc prefsave {wdg} { global g w pref opts # Make a backup (if present) then open the NEW Preference File if {[file exists $g(rcfile)]} {file rename -force $g(rcfile) "$g(rcfile)~"} set fid [open $g(rcfile) w] # Declare WHEN tkdiff wrote this file (and what version was used) puts $fid "# This file was generated by $g(name)" puts $fid "# [clock format [clock seconds]]" # NOT a preference, per se - but is used when MORPHing outdated Prefs puts $fid "define prefsVrsn {$g(version)}\n" # Now, put ALL of the preferences in the file # (with one small wrinkle - CERTAIN prefs have platform dependant values) # When we encounter one of THOSE, make sure we prepend the CURRENT platform # to its key, and grab ANY EXISTING others that MAY have been stored as # 'cargo' data on readin, and WRITE THOSE BACK OUT as well! # # Otherwise its just a plain old preference and out it goes # N.B> A platform prefix WILL perturb the alpha-order key list - Ah well... foreach key [lsort [array names pref]] { regsub "\n" $pref($key) "\n# " comment puts $fid "# $comment" # Watch for any of our TRIGGER key PREFIXes: "nav", "mrg" or "gen" # N.B> DANGER - misnomer: we cheated and match PERMUTATIONS thereof # Ensure it emits using the PRESENT windowing system 'extra' PREFIX; # and additionally CHECK for (and output) any POSSIBLY ASSOCIATED # "cargo" values pertaining TO that SAME basic key if {[string match "\[nmg]\[are]\[vgn][string range $key 3 end]" $key]} { foreach {wSys} "aqua win32 x11" { if {[info exists opts($wSys$key)]} { puts $fid "define $wSys$key {$opts($wSys$key)}" } } # Hint: the "current" system is always AFTER any cargo -- # (sneakily IDENTIFIES what platform WROTE the preference file) puts $fid "define $w(wSys)$key {$opts($key)}\n" } else { puts $fid "define $key {$opts($key)}\n" } } # ... and now any custom code puts $fid "# custom code" puts $fid "# Put any custom code you want to be executed in the" puts $fid "# following block. This code will be automatically executed" puts $fid "# after the GUI has been set up but before the diff is " puts $fid "# performed. Use this code to customize the interface if" puts $fid "# you so desire." puts $fid "# " puts $fid "# Even though you can't (as of version 3.09) edit this " puts $fid "# code via the preferences dialog, it will be automatically" puts $fid "# saved and restored if you do a SAVE from that dialog.\n" puts $fid "# Unless you REALLY know what you are doing, it is probably" puts $fid "# wise to leave this unmodified.\n" puts $fid "define customCode {\n[string trim $opts(customCode) \n]\n}\n" close $fid if {$::tcl_platform(platform) == "windows"} { file attribute $g(rcfile) -hidden 1 } # Let user know SOMETHING happened set hold [$wdg cget -activebackground] $wdg configure -activebackground green $wdg flash $wdg configure -activebackground $hold } ############################################################################### # Text has scrolled horizontally, update scrollbars and synchronize windows ############################################################################### proc hscroll-sync {id args} { global g w opts # If ignore_hevent is true, we've already taken care of scrolling. # We're only interested in the first event. if {$g(ignore_hevent,$id)} { return } # Scrollbar sizes lassign [$w(LeftText) xview] start size1 ; set size1 [expr $size1-$start] lassign [$w(RightText) xview] start size2 ; set size2 [expr $size2-$start] if {$opts(syncscroll) || $id == 1} { set start [lindex $args 0] if {$id != 1} { set start [expr {$start * $size2 / $size1}] } $w(LeftHSB) set $start [expr {$start + $size1}] $w(LeftText) xview moveto $start set g(ignore_hevent,1) 1 } if {$opts(syncscroll) || $id == 2} { set start [lindex $args 0] if {$id != 2} { set start [expr {$start * $size1 / $size2}] } $w(RightHSB) set $start [expr {$start + $size2}] $w(RightText) xview moveto $start set g(ignore_hevent,2) 1 } # Force all the event handlers for the view alterations above to trigger, # having locked out the recursive (redundant) events using ignore_hevent. update idletasks # Restore to normal set g(ignore_hevent,1) 0 set g(ignore_hevent,2) 0 } ############################################################################### # Main Text widget has scrolled vertically, update scrollbar(s) ############################################################################### proc vscroll {id y0 y1} { global w # Update ACTUAL scrollbar $w(${id}VSB) set $y0 $y1 # And MAYBE the MAP one if this HAPPENS to be the active window if {$w(acTxWdg) == $w(${id}Text)} { map-move-thumb $y0 $y1 } } ############################################################################### # Draw a miniature map of the diff regions ############################################################################### proc map-draw {} { global g w opts # There are TWO reasons we might not be able to properly draw (as yet): # 1. The TK geometry manager might not have gotten around to making # its decision about how big our window is supposed to be; or # # 2. The application may not have progressed far enough to HAVE the # data to plot anything useful quite yet # # Unfortunately we can only check the TK reason now (because if we test # for the other condition (a flag) here, we impose a restriction on the # application to RAISE g(startPhase) AHEAD of making its OWN call - # even when it KNOWS the data is perfectly ready. # N.B> startPhase is used globally to NOT WASTE TIME doing TK things that # wont be correct because the application isnt quite ready yet. if {$g(mapheight) && $g(mapwidth)} { # We add some transparent stuff to make the map fill the canvas # in order to receive mouse events at the very bottom. $w(mapImg) blank $w(mapImg) put \#000 -to 0 $g(mapheight) $g(mapwidth) $g(mapheight) } else {return} # A Text widget ALWAYS contains a blank line at the end - thus # (in normal cases) it tends to LOOK like it has TWO; Yet, if # the input data LACKED a this ratio could blowup... # So protect it by providing a floor value of 1.0 set lines [max [expr {double([$w(acTxWdg) index end]) - 2}] 1.0] set factor [expr {$g(mapheight) / $lines}] # Paint color stripes per type of every hunk foreach hID $g(diff) { lassign $g(scrInf,$hID) S E na na C1 na na C2 set y [expr {int(($S - 1) * $factor) + $g(mapborder)}] set size [expr {round(($E - $S + 1) * $factor)}] if {$size < 1} { set size 1 } switch -- "[append C1 $C2]" { "-" { set color $opts(mapdel) } "+" { set color $opts(mapins) } "!!" { set color [expr {[info exists g(overlap$hID)] ? \ $opts(mapolp) : $opts(mapchg)}] } } $w(mapImg) put $color -to 0 $y $g(mapwidth) [expr {$y + $size}] } # replot the 'thumb' on top # implicitly handles a shift in position (if being called by map-resize) map-move-thumb {*}[$w(acTxWdg) yview] } ############################################################################### # Resize map to fit window size ############################################################################### proc map-resize {args} { global g w opts # We need to keep its size up-to-date, starting with its height # First account for spacing items surrounding the map set g(mapborder) [$w(map) cget -borderwidth] incr g(mapborder) [$w(map) cget -highlightthickness] # This can be touchy - we are racing against the TK bkgnd task that can be # cfg'ing the vertical scrolling (which calls us - at least twice - # because of EACH of the Left/Right scrollbars) # HOWEVER -- these FIRST call(s) might have PRECEDEd the geometry # manager stretching w(map) to its proper size causing it to still be # AT its 1x1 initial size which would then FAIL as we try to compute the # INTERIOR size we can plot within! # # THUS - simply watch the current map size until its viably LARGE enough # Reduce the effective height by any frame border elements (top AND bottom) # And, when that height is not stupidly short, record both width & height if {[set height [expr {[winfo height $w(map)]-($g(mapborder) *2)}]] > 10} { set g(mapheight) $height set g(mapwidth) [winfo width $w(map)] } # When we are in startPhase 1, we likely dont HAVE the data NEEDED to DRAW # So limit this proc to just TRACKING the size changes; it will be # explicitly drawn (from 'mark-diffs') when the data is ready if {$g(startPhase) > 1} { map-draw } } ############################################################################### # Toggle showing the line comparison window ############################################################################### proc do-show-lineview {{showLineview {}}} { global w opts if {$showLineview != {}} { set opts(showlineview) $showLineview } if {$opts(showlineview)} { # (re-)Manage BottomText, then tickle to update SOMEWHERE reasonable grid $w(BottomText) $w(acTxWdg) mark set insert insert } else { grid remove $w(BottomText) } } ############################################################################### # Toggle showing inline comparison ############################################################################### proc do-show-inline {which {truefalse {}}} { global opts # translation tbl TO mutually-disjoint option set other(showinline1) showinline2 set other(showinline2) showinline1 if {$truefalse != {}} { set opts($which) $truefalse } set flush 1 # mutually disjoint options # Turn requested option ON ? if {$opts($which)} { # Yes, but was OTHER option already ON ? if {$opts($other($which))} { # Yes - so mark IT as OFF, but the flush remains set opts($other($which)) 0 } { # otherwise it is just turning this ON, thus no flush reqd set flush 0 } } elseif {!$opts($other($which))} { # No, turn requested option OFF ('other' is already OFF) set which off ;# and dont generate more - but FLUSH remains } # POSSIBLY recompute but ALWAYS retags (even if only removal) compute-inlines $which $flush } ############################################################################### # Toggle showing map or not ############################################################################### proc do-show-map {{showMap {}}} { global w opts if {$showMap != {}} { set opts(showmap) $showMap } if {$opts(showmap)} { grid $w(map) -row 1 -column 1 -stick ns } else { grid forget $w(map) } } ############################################################################### # Find and return the "diff INDEX" nearest to SCREENLINE $line. ############################################################################### proc find-diff {line} { global g # Binary search $line as either WITHIN, or PRECEEDING the index returned # N.B> $i is a REAL (0-based) list index - NOT a (1-based) Diff index; # ... UNLESS $line was BEYOND the last known hunk definition (and is thus # *THE* proper Diff index of that last hunk). if {[set i [rngeSrch diff $line "scrInf,"]] != $g(count)} { # So it all comes down to this: # If INSIDE the hunk (or it PRECEDED the FIRST hunk) - simply convert # $i to its equiv(+1) Diff index; -OR- decide which is CLOSER: # the prior ENDpt or the found STARTpt, adjusting $i to whichever WHILE # ensuring its logical conversion to its "Diff index" value set S [lindex $g(scrInf,[lindex $g(diff) $i]) 0] set E [lindex $g(scrInf,[hunk-id [max 1 $i]]) 1] if {($S <= $line) || !$i || ($S - $line < $line - $E)} { incr i } } return $i } ############################################################################### # Calculate number of lines in diff region # hID Diff hunk identifier # version (1, 2, 12, 21) left and/or right window version ############################################################################### proc diff-size {hID version} { global g lassign $g(scrInf,$hID) S E P(1) na na P(2) switch -- $version { 1 - 2 { set lines [expr {$E - $S - $P($version) + 1}] } 12 - 21 { set lines [expr {$E - $S - $P(1) + $E - $S - $P(2) + 2}] } } return $lines } ############################################################################### # Toggle showing merge preview dialog or not ############################################################################### proc do-show-merge {{showMerge ""}} { global g w if {$showMerge != ""} { set g(showmerge) $showMerge } # Re-cfg buttons to hint at state of intended Merge FILENAME (when visible) if {$g(showmerge)} { if {$g(mergefileset)} { $w(mergeWriteAndExit) configure -text "Save & Exit" $w(mergeWrite) configure -text "Save" } else { $w(mergeWriteAndExit) configure -text "Save & Exit..." $w(mergeWrite) configure -text "Save..." } if {![winfo ismapped $w(merge)]} { Dialog show $w(merge) $w(mergeText) merge-center ;# (centers the CDR - not the window) } } elseif {[winfo ismapped $w(merge)]} { Dialog dismiss $w(merge) } } ############################################################################### # Create Merge preview dialog ############################################################################### proc build-merge {} { global g w opts if {![Dialog NONMODAL $w(merge)]} { wm title [set win $w(merge)] "$g(name) Merge Preview" wm group $win . wm transient $win . wm protocol $win WM_DELETE_WINDOW {do-show-merge 0} frame $win.bottom frame $win.top -bd 1 -relief sunken # Certain widgets will need external handles, remainder are local set w(mergeInfo) $win.top.info set w(mergeText) $win.top.text set w(mergeVSB) $win.top.vsb set w(mergeHSB) $win.top.hsb set w(mergeWrite) $win.bottom.mergeWrite set w(mergeWriteAndExit) $win.bottom.mergeWriteAndExit # Window and scrollbars scrollbar $w(mergeHSB) -orient horizont -com [list $w(mergeText) xview] scrollbar $w(mergeVSB) -orient vertical -com [list $w(mergeText) yview] text $w(mergeText) -bd 0 -takefocus 1 \ -yscrollcommand [list $w(mergeVSB) set] \ -xscrollcommand [list $w(mergeHSB) set] canvas $w(mergeInfo) -highlightthickness 0 pack $win.bottom -side bottom -fill x pack $win.top -side top -fill both -expand yes -ipadx 5 -ipady 10 grid $w(mergeInfo) -row 0 -column 0 -sticky nsew grid $w(mergeText) -row 0 -column 1 -sticky nsew grid $w(mergeVSB) -row 0 -column 2 -sticky ns grid $w(mergeHSB) -row 1 -column 0 -sticky ew -columnspan 2 grid rowconfigure $win.top 0 -weight 1 grid rowconfigure $win.top 1 -weight 0 grid columnconfigure $win.top {0 2} -weight 0 grid columnconfigure $win.top 1 -weight 1 # buttons button $win.bottom.mRecenter -width 8 -text "ReCenter" -underline 0 \ -command merge-center button $win.bottom.mDismiss -width 8 -text "Dismiss" -underline 0 \ -command "do-show-merge 0" button $win.bottom.mExit -width 8 -text "Exit $g(name)" -underline 0 \ -command {do-exit} # These last two buttons NAMES are later re-cfg'd with "..." appended # when g(mergefileset)==0 to signify a file browser popup will occur # (provided the merge window itself is actually visible) button $w(mergeWrite) -width 8 -text "Save" -underline 0 \ -command {merge-write-file} button $w(mergeWriteAndExit) -width 8 -text "Save & Exit" -underline 8 \ -command {merge-write-file 1 } pack $win.bottom.mDismiss -side right -pady 5 -padx 10 pack $win.bottom.mRecenter -side right -pady 5 -padx 1 pack $w(mergeWrite) -side right -pady 5 -padx 1 -ipadx 1 pack $w(mergeWriteAndExit) -side right -pady 5 -padx 1 -ipadx 1 pack $win.bottom.mExit -side right -pady 5 -padx 1 # Insert tag defs (in precedence order) # N.B> This matters to 'plot-merge-info': # we NEED 'diffR' or 'diffL' as lowest precedence TAGS # (whichever applies to the diff line in question). # Its an encoding trick noting which SIDE contrib'ed a diff line. $w(mergeText) configure {*}$opts(textopt) $w(mergeText) tag configure {diffL} {*}$opts(difftag) $w(mergeText) tag configure {diffR} {*}$opts(difftag) $w(mergeText) tag configure {currtag} {*}$opts(currtag) $w(mergeText) tag raise sel ;# Keep this on top # adjust the tabstops (see similar code in prefapply WHY we use "0") set cwidth [font measure [$w(mergeText) cget -font] "0"] set tabstops [expr {$cwidth * $opts(tabstops)}] $w(mergeText) configure -tabs $tabstops # Lastly, this text window ALSO needs to be READONLY, so we WRAP it rename $w(mergeText) $w(mergeText)_ proc $w(mergeText) {cmd args} $::textROfcn } # N.B> cfg'ing and 'show'ing the dialog is up to 'do-show-merge' } ############################################################################### # Write merge preview to file (after optionally confirming filename) ############################################################################### proc merge-write-file {{andExit 0}} { global g w opts Dbg {-> ([expr {$g(mergefileset) ? "into" : "confirming" }] $g(mergefile))} if {!$g(mergefileset)} { # Uncertain of wanting 'nativename' .vs. 'normalize' here... # (each supposedly yields an absolute name) set path [file nativename $g(mergefile)] # Regardless, next SPLIT that into dir & file, and pass as PIECES ... # otherwise any/all user "directory browsing" will be IGNORED simply # because the '-initialfile' was passed as an absolute path!! set path [tk_getSaveFile -filetypes $opts(filetypes) \ -initialdir [file dirname $path] \ -initialfile [file tail $path] -defaultextension "" \ -parent [expr {[winfo ismap $w(merge)]? $w(merge) : $w(client)}]] if {[string length $path] > 0} { set g(mergefile) $path } else return ;# file browser cancelled out - DO NOT WRITE or EXIT } # Actually write merge output to the given filename set hndl [open "$g(mergefile)" w] # PREVENT V9.x from throwing 'encoding' errors (does it matter for write?) if {$::tcl_version >= 9.0} { fconfigure $hndl -profile tcl8 } set txt [$w(mergeText) get 1.0 end-1lines] puts -nonewline $hndl $txt close $hndl if {$andExit} do-exit } ############################################################################### # Add a mark where each diff begins and tag each region so they are visible. # Default case ONLY WORKS when pre-loaded text is the original (Left) version. # Optional arg allows adding/removing (ie. editting) hunk identifiers later on ############################################################################### proc merge-add-marks {{hIDS {}}} { global g w # Mark ALL lines first, so inserting choices won't mess up line numbers. # N.B> WHEN hIDS is supplied, it MUST be homogeneous: ALL or NONE can # pre-exist. And, when they dont exist, ascending order is REQUIRED. if {"$hIDS" != {}} { if {"mark[lindex $hIDS 0]" in [$w(mergeText) mark names]} { # Exists - so remove it (and every MERGE thing pertaining to it) foreach hID "$hIDS" { # CRITICAL: Put the merge text content BACK to a "Left" view ! # Then eliminate the mark AND choice (caller zaps the rest) merge-select-version $hID $g(merge$hID) 1 $w(mergeText) mark unset mark$hID unset g(merge$hID) } return } else { # NEW hID - Find WHERE to plant each new MARK # Apologies for the convoluted logic here, but we need a PRIOR # hunk location as an anchor (if there is one.) If NOT, then NO # numbers need adjusting; But if there IS, the rule of "Left only" # view DOES NOT APPLY to that FIRST anchor. Each planted MARK then # BECOMES the new anchor as we loop and is ALWAYS in "Left view" set prvHid {} foreach hID "$hIDS" { # Identify the 1st closest PRIOR hunk INDEX (if unknown) if {$prvHid == {}} { if {[set i [hunk-ndx $hID]] > 1} {incr i -1} } # If not YET known, produce prvHid and verify it really IS a # "PRIOR" hunk, setting 'i' to ITS merge-choice value if yes if {$prvHid != "" || ( "[set prvHid [hunk-id $i]]" != "$hID" \ && [set i $g(merge$prvHid)])} { # Now determine WHERE that anchor starts in 'mergeText', # ADDing its CURRENT SIZE (minus 1), plus the STARTING # position of the NEW hunk set S [expr {int([$w(mergeText) index mark$prvHid]) \ + [diff-size $prvHid $i] - 1 \ + [lindex $g(scrInf,$hID) 0]} ] # Using SCREEN numbering is OK because when we arrange # to subtract the screen END Lnum of the PRIOR hunk ... set O [lindex $g(scrInf,$prvHid) 1] # ... it will all convert to the NEW hunk location } else { lassign $g(scrInf,$hID) S na na O } # Set the NEW mark (and eventually fall thru to tagging) $w(mergeText) mark set mark$hID [incr S -$O].0 $w(mergeText) mark gravity mark$hID left set prvHid $hID ;# This becomes the NEXT anchor (as we loop) set i 1 ;# and (by defn) is ALWAYS in a "Left" view } } } else { ;# Do the entire Text (MUST BE in PURE LEFT context!!) foreach hID [set hIDS $g(diff)] { lassign $g(scrInf,$hID) S na na O $w(mergeText) mark set mark$hID [incr S -$O].0 $w(mergeText) mark gravity mark$hID left } } # ... finally, select per merge CHOICES and TAG the regions for each set currdiff [hunk-id $g(pos)] foreach hID $hIDS { # Tag and/or Insert designated Left or Right window text versions # N.B.: works PROVIDED the merge hID range is IN a "Left copy" state if {$g(merge$hID) == 1} { # (But dont do a Left 'a'-type hunk - it's not visible) if {![string match "*a*" "$hID"]} { add-tag $w(mergeText) diffL {} mark$hID "+[diff-size $hID 1]" } } else { merge-select-version $hID 1 $g(merge$hID) } # Also attach "currtag" if/when correct hunk encountered if {"$hID" == "$currdiff"} { add-tag $w(mergeText) currtag {} \ mark$hID "+[diff-size $hID $g(merge$hID)]" } } } ############################################################################### # Remove/Re-Add hunk content to the merge window # hID diff hunk identifier # oldversion (1, 2, 12, 21) previous merge choice # newversion (1, 2, 12, 21) new merge choice ############################################################################### proc merge-select-version {hID oldversion newversion} { global g w if {[set tot [diff-size $hID $oldversion]]} { $w(mergeText) DELETE mark$hID "mark${hID}+${tot}lines" } # Start of hunk in screen coordinates set S [lindex $g(scrInf,$hID) 0] # Get the text to insert directly from window switch -- $newversion { 1 { if {[set tot [set i [diff-size $hID 1]]]} { lappend txt [$w(LeftText) get $S.0 $S.0+${i}lines] diffL } else {return} } 2 { if {[set tot [set i [diff-size $hID 2]]]} { lappend txt [$w(RightText) get $S.0 $S.0+${i}lines] diffR } else {return} } 12 { if {[set tot [set i [diff-size $hID 1]]]} { lappend txt [$w(LeftText) get $S.0 $S.0+${i}lines] diffL } if {[set tot [diff-size $hID 2]]} { lappend txt [$w(RightText) get $S.0 $S.0+${i}lines] diffR incr tot $i } } 21 { if {[set tot [set i [diff-size $hID 2]]]} { lappend txt [$w(RightText) get $S.0 $S.0+${i}lines] diffR } if {[set i [diff-size $hID 1]]} { lappend txt [$w(LeftText) get $S.0 $S.0+${i}lines] diffL incr tot $i } } } # Normally (prior to Combine/Split) mark$hID would ALWAYS have been the # sole Left-'gravitized' Text mark (attached to the newline ending the # NON-hunk line PRECEEDING the hunk start edge) at any ONE Text position. # But since then, MULTIPLE marks (referring to optionally merge-able # abutted hunks) CAN COINCIDE, possibly only for a moment (between the # deletion and add done in this proc), thus causing them to cluster to the # front of ALL the possibilities - despite the need for SOME of those # choices to logically FOLLOW the insertion being made (to maintain linear # order). # Thus we must analyze EVERY insertion for such clustering and POSSIBLY # adjust the gravities of SOME to ensure the hunk ordering linearity # imposed by g(diff) remains intact... set pos [hunk-ndx $hID] set regravitize {} foreach {na markID na} [$w(mergeText) dump -mark mark$hID] { if {[hunk-ndx [string range $markID 4 end]] > $pos} { $w(mergeText) mark gravity $markID right lappend regravitize $markID } } # NOW insert AND tag it (txt holds PAIRS of textlines AND assoc tag) $w(mergeText) INSERT mark$hID {*}$txt if {"$hID" == "[hunk-id $g(pos)]"} { add-tag $w(mergeText) currtag {} mark$hID "+$tot" } # ... Nevertheless, we always LEAVE all gravities as 'Left' AFTER the # insertion, just so we need not guess (or ask) the next time around. foreach {markID} $regravitize { $w(mergeText) mark gravity $markID left } } ############################################################################### # Center the merge region in the merge window ############################################################################### proc merge-center {} { global g w # bail if there are no diffs if {$g(count) == 0} { return } # Size of diff in lines of text set hID [hunk-id $g(pos)] set difflines [diff-size $hID $g(merge$hID)] # Window height in percent set yview [$w(mergeText) yview] set ywindow [expr {[lindex $yview 1] - [lindex $yview 0]}] # First line of diff and total number of lines in window set firstline [$w(mergeText) index mark$hID] set totallines [$w(mergeText) index end] if {($difflines / $totallines) < $ywindow} { # Diff fits in window, center it $w(mergeText) yview moveto [expr {($firstline + $difflines / 2) / \ $totallines - ($ywindow / 2.0)}] } else { # Diff too big, show top part $w(mergeText) yview moveto [expr {($firstline - 1) / $totallines}] } } ############################################################################### # Update the merge preview window with the designated (1,2,12,21) merge choice ############################################################################### proc do-merge-choice {newversion} { global g w opts set hID [hunk-id $g(pos)] switch $g(merge$hID) { 1 {incr g(statusMrgL) -1} 2 {incr g(statusMrgR) -1}} merge-select-version $hID $g(merge$hID) $newversion switch [set g(merge$hID) $newversion] { 1 {incr g(statusMrgL)} 2 {incr g(statusMrgR)} } # Must ask user (when this is a collision) if their choice CLEARed it if {[info exists g(overlap$hID)]} { after idle [subst -nocommands { if {{yes} == [tk_messageBox -type yesno -icon question \ -title {Please Confirm} -parent $w(client) -default no \ -message "Did this choice RESOLVE the collision ?" ]} \ { unset g(overlap$hID) set-dtags $hID currtag overlaptag if {$g(startPhase) > 1} { map-draw } } }] } if {$g(showmerge) && $opts(autocenter)} { merge-center } set g(toggle) $newversion } ############################################################################### # Extract the start and end lines for file1 and file2 from the diff header # passed in "line". ############################################################################### proc extract {line} { # the line darn well better be of the form , where op is # one of "a","c" or "d" (possibly in EITHER case). range will either be a # single number or two numbers separated by a comma. # is this a cool regular expression, or what? :-) regexp -nocase {([0-9]*)(,([0-9]*))?([acd])([0-9]*)(,([0-9]*))?} $line \ matchvar s1 x e1 op s2 x e2 if {[info exists s1] && [info exists s2]} { if {"$e1" == ""} { set e1 $s1 } if {"$e2" == ""} { set e2 $s2 } return [list $s1 $e1 $s2 $e2 $op] } else { fatal-error "Could not parse following output line from diff:\n$line" } } ############################################################################### # Add a tag to a region (of chars on a given line -OR- of lines themselves). ############################################################################### proc add-tag {wgt tag line start end} { global g if {"$line" eq {}} { # interpret OUR shorthand notation allowed for line tagging # (args passed are INTEGERS - convert to INDICE syntax) if {[string match \[0-9\]* "$start"]} {append start ".0"} if {[string match \[0-9\]* "$end"]} {append end ".0"} # 'end' may begin with JUST a plus/minus value # (+/-)xxx becomes "start (+/-)xxx lines" # xxx becomes "xxx +1 lines" set end [expr {[string match \[-+\]* "$end"] \ ? "$start${end}lines" : "$end+1lines"}] $wgt tag add $tag $start $end ;# the lines themselves } else { $wgt tag add $tag $line.$start $line.$end ;# chars ON $line } } ############################################################################### # Change the tags for the GIVEN diff region to appear as the CDR. # 'hID' is the region hunk identifier (from the g(diff) list) # If 'oldtag' is present, first remove it from the region # If 'setpos' is non-zero, make sure the region becomes visible. # Returns the diff hunk identifier UNLESS the Given range was INVALID, then "" ############################################################################### proc set-dtags {hID newtag {oldtag ""} {setpos 0}} { global g w opts # Figure out which lines we need to address... if {![info exists g(scrInf,$hID)]} { # This may seem an ODD place for this to be but it IS correct # If the REASON we can't find the designated hID is because there is # NONE TO BE FOUND (zero diffs) its POSSIBLE we just did a newDiff, # having reloaded all of the Text widgets and their CONTENTS. # We needed to DELAY till here so g(startPhase) could be reset to # allow INFO plot actions to occur. They then fire AS we scroll to 1.0 if {!$g(count)} { $w(LeftText) SEE 1.0 $w(RightText) SEE 1.0 if {$g(showmerge)} {$w(mergeText) SEE 1.0} } return "" } lassign $g(scrInf,$hID) S E na na cL na na cR # Remove old tag if {"$oldtag" != ""} { $w(LeftText) tag remove $oldtag $S.0 $E.0+1lines $w(RightText) tag remove $oldtag $S.0 $E.0+1lines # Of tags to remove, only "currtag" makes sense for the Merge window if {"$oldtag" == "currtag"} { catch { set lines [diff-size $hID $g(merge$hID)] $w(mergeText) tag remove $oldtag mark$hID "mark$hID+${lines}lines"} } } # Map chgbar marker(s) into applicable tag definition (danger: cL modified) switch -- [append cL $cR] { "-" { set coltag deltag } "+" { set coltag instag } "!!" { set coltag [expr {[info exists g(overlap$hID)] ? \ "overlaptag" : "chgtag" }] } } # Add new tag if {$opts(tagtext)} { add-tag $w(LeftText) $newtag {} $S $E add-tag $w(RightText) $newtag {} $S $E add-tag $w(RightText) $coltag {} $S $E } if {[set full [diff-size $hID $g(merge$hID)]]} { # Merge must map 'difftag' into SIDE-SPECIFIC equivalent tags if {"$newtag" == "difftag"} { # We'll use meta-programming to unwind and map the encoding # so create the transforms we need to access the pieces set sideTag([set side2(21) [set side1(12) 1]]) "diffL" set sideTag([set side2(12) [set side1(21) 2]]) "diffR" if {$g(merge$hID) < 10} { # Its a single side and occupies the 'full' length ... lappend tags $sideTag($g(merge$hID)) mark$hID $full } else { # ... or its 2 sides that SUMS to the full length (beware of 0) if {[set first [diff-size $hID $side1($g(merge$hID))]]} { lappend tags $sideTag($side1($g(merge$hID))) mark$hID $first } else { lappend tags $sideTag($side2($g(merge$hID))) mark$hID $first } # Append the 2nd piece (if needed) if {$first && $first != $full} { lappend tags $sideTag($side2($g(merge$hID))) \ mark$hID+${first}lines [expr {$full - $first}] } } } else {lappend tags $newtag mark$hID $full} foreach {tag where lines} "$tags" { add-tag $w(mergeText) $tag {} $where "+$lines" } } # Move the view on both text widgets so that the new region is visible. if {$setpos} { if {$opts(autocenter)} { centerCDR } else { $w(LeftText) SEE $S.0 $w(RightText) SEE $S.0 $w(LeftText) mark set insert $S.0 $w(RightText) mark set insert $S.0 if {$g(showmerge)} { $w(mergeText) SEE mark$hID } } } return $hID } ############################################################################### # moves to the diff nearest the insertion cursor or the mouse click, # depending on $mode (which can be either "menu", "xy" or "mark") AND window ############################################################################### proc moveNearest {window mode args} { global g w set isDiffMap [string match {*.map.canvas} $window] switch -- $mode { "menu" - "xy" { lassign $args x y if {"$mode"=="menu"} { # Convert Menu ROOT coords to window incr x -[winfo rootx $window] incr y -[winfo rooty $window] } if {$isDiffMap} { # Diffmap represents the ENTIRE file - SCALE the coord # to fabricate the equiv Text index location set index [expr ($y.0 / $g(mapheight).0) \ * [$w(acTxWdg) index "end -1lines linestart"]] } { set index [$window index @$x,$y] } } "mark" { set index [$window index [lindex $args 0]] } } move [find-diff [file rootname $index]] 0 1 } ############################################################################### # this is called to decode a combobox entry into which hunk to jump to ############################################################################### proc moveTo {window value} { global g w # we know that the value is prefixed by the number/index of # the diff the user wants. So, just grab that out of the string regexp {([0-9]+) *:} $value matchVar index move $index 0 1 } ############################################################################### # Move the "current" diff indicator (i.e. go to a different diff region: # If "relative" is 0 go to the GIVEN diff number; else treat as increment (+/-) # Also accepts keywords "first" and "last" ############################################################################### proc move {value {relative 1} {setpos 1}} { global g w if {$value == "first"} { set value 1 set relative 0 } if {$value == "last"} { set value $g(count) set relative 0 } # Remove old 'curr' tag set-dtags [hunk-id $g(pos)] difftag currtag # Bump 'pos' (one way or the other). if {$relative} { set g(pos) [expr {$g(pos) + $value}] } else { set g(pos) $value } # Range limit REQUESTED 'pos' into "1 - MAX" set g(pos) [min [max $g(pos) 1] $g(count)] # Set new 'curr' tag # N.B> if 'hunk-id' produces an UNKNOWABLE id (ie. "") due to ZERO hunks # set-dtags does NOTHING except to jump L/R/merge windows to line 1.0 # irrespective of the value for $setpos set g(currdiff) [set-dtags [hunk-id $g(pos)] currtag "" $setpos] # update the buttons, etc. update-display } ############################################################################### # Align the availability of UI elements to the tools CURRENT context conditions ############################################################################### proc update-display {} { global g w opts finfo #Dbg " startPhase $g(startPhase)" if {!$g(startPhase)} return # The coding approach here is somewhat unusual: # It's organized as sequential LAYERS of decisions instead of a single # TREE of chained tests to arrive at each items proper '-state' setting. # # To limit "flickering" of widgets, that choice of LAYER is critical. # # Its best to try avoiding toggling the same widget from multiple layers, # particularly as "else" clauses, only to nearly ALWAYS redo it at a # LOWER layer. Think about the frequency that each layer-test is most # likely to branch during general operation of the tool. # # This works (and results in fewer code lines) - but its confusing to # assess WHERE (which layer) any given widget BELONGS at and if it # NEEDS to be repeated at MULTIPLE levels ##### First layer - Does the tool have enough input to attempt a diff ? if {$g(startPhase) < 2} { # disable darn near everything foreach b [list rediff ignCDR splitCDR cmbinCDR find \ prevCDR firstCDR nextCDR lastCDR ctrCDR \ mrgC1 mrgC2 mrgC12 mrgC21] { $w(${b}_im) configure -state disabled $w(${b}_tx) configure -state disabled } foreach menu [list $w(popupMenu) $w(viewMenu)] { $menu entryconfigure "Previous*" -state disabled $menu entryconfigure "First*" -state disabled $menu entryconfigure "Next*" -state disabled $menu entryconfigure "Last*" -state disabled $menu entryconfigure "Center*" -state disabled } $w(popupMenu) entryconfigure "Find..." -state disabled $w(popupMenu) entryconfigure "Find Nearest*" -state disabled $w(popupMenu) entryconfigure "Edit*" -state disabled $w(editMenu) entryconfigure "Find*" -state disabled $w(editMenu) entryconfigure "Edit File 1" -state disabled $w(editMenu) entryconfigure "Edit File 2" -state disabled $w(fileMenu) entryconfigure "File List" -state disabled $w(fileMenu) entryconfigure "Write*" -state disabled $w(fileMenu) entryconfigure "Recompute*" -state disabled $w(mergeMenu) entryconfigure "Show*" -state disabled $w(mergeMenu) entryconfigure "Write*" -state disabled -label \ [expr {$g(mergefileset) ? "Write Merge File" : "Write Merge File..."}] $w(markMenu) entryconfigure "Bookm*" -state disabled $w(markMenu) entryconfigure "Clear*" -state disabled } else { # these are generally enabled, assuming we have (or about to re-) # run a proper DIFF of a couple of files foreach b [list rediff find prevCDR firstCDR nextCDR lastCDR \ ctrCDR mrgC1 mrgC2 mrgC12 mrgC21] { $w(${b}_im) configure -state normal $w(${b}_tx) configure -state normal } $w(popupMenu) entryconfigure "Find..." -state normal $w(popupMenu) entryconfigure "Find Nearest*" -state normal $w(popupMenu) entryconfigure "Edit*" -state normal $w(editMenu) entryconfigure "Find*" -state normal $w(editMenu) entryconfigure "Edit File 1" -state normal $w(editMenu) entryconfigure "Edit File 2" -state normal if {$finfo(fPairs) > 1} { $w(fileMenu) entryconfigure "File List" -state normal } else { $w(fileMenu) entryconfigure "File List" -state disabled } $w(fileMenu) entryconfigure "Write*" -state normal $w(fileMenu) entryconfigure "Recompute*" -state normal $w(mergeMenu) entryconfigure "Show*" -state normal $w(mergeMenu) entryconfigure "Write*" -state normal -label \ [expr {$g(mergefileset) ? "Write Merge File" : "Write Merge File..."}] # Hmmm.... on my Mac the combobox flashes if we don't add this # check. Is this a bug in AquaTk, or in my combobox... :-| if {[$w(combo) cget -state] != "normal"} { $w(combo) configure -state normal } } # update the status line AND if any RE-match data exists set g(statusCurrent) "$g(pos) of $g(count)" set g(statusInfo) "" $w(viewMenu) entryconfigure "Ignore RE*" -state \ [expr {[llength $opts(ignoreRegexLnopt)] ? "normal":"disabled"}] ##### Second layer - Do any diffs exist ? # # Update the combobox, merge choices, and hunk centering. if {$g(count)} { # update the combobox. We don't want its command to fire, so # we'll disable it temporarily $w(combo) configure -commandstate "disabled" set i [expr {$g(pos) - 1}] $w(combo) configure -value [lindex [$w(combo) list get 0 end] $i] $w(combo) selection clear $w(combo) configure -commandstate "normal" # Merge choices and hunk centering foreach buttonpref {im tx} { $w(ignCDR_$buttonpref) configure -state normal $w(ctrCDR_$buttonpref) configure -state normal $w(mrgC1_$buttonpref) configure -state normal $w(mrgC2_$buttonpref) configure -state normal $w(mrgC12_$buttonpref) configure -state normal $w(mrgC21_$buttonpref) configure -state normal } $w(mrgLbl) configure -state normal $w(popupMenu) entryconfigure "Center*" -state normal $w(viewMenu) entryconfigure "Center*" -state normal $w(editMenu) entryconfigure "Ignore*" -state normal } else { # Note: this is essentially for the "No-Diffs-found" case # and effectively suggests that Layer 4 will do NOTHING! foreach b [list ignCDR splitCDR cmbinCDR ctrCDR bkmRls \ bkmSet mrgC1 mrgC2 mrgC12 mrgC21] { $w(${b}_im) configure -state disabled $w(${b}_tx) configure -state disabled } $w(mrgLbl) configure -state disabled $w(popupMenu) entryconfigure "Center*" -state disabled $w(viewMenu) entryconfigure "Center*" -state disabled $w(editMenu) entryconfigure "Ignore*" -state disabled $w(editMenu) entryconfigure "Split*" -state disabled $w(editMenu) entryconfigure "Combine*" -state disabled $w(markMenu) entryconfigure "Bookm*" -state disabled $w(markMenu) entryconfigure "Clear*" -state disabled } ##### Third layer - is CDR at (or beyond) edges of its valid range ? # (N.B> also applies to the legitimate "No Diffs Found" situation) # # Update navigation items if {$g(pos) <= 1} { foreach buttonpref {im tx} { $w(prevCDR_$buttonpref) configure -state disabled $w(firstCDR_$buttonpref) configure -state disabled } $w(popupMenu) entryconfigure "Previous*" -state disabled $w(popupMenu) entryconfigure "First*" -state disabled $w(viewMenu) entryconfigure "Previous*" -state disabled $w(viewMenu) entryconfigure "First*" -state disabled } else { ;# can transition lower foreach buttonpref {im tx} { $w(prevCDR_$buttonpref) configure -state normal $w(firstCDR_$buttonpref) configure -state normal } $w(popupMenu) entryconfigure "Previous*" -state normal $w(popupMenu) entryconfigure "First*" -state normal $w(viewMenu) entryconfigure "Previous*" -state normal $w(viewMenu) entryconfigure "First*" -state normal } if {$g(pos) >= $g(count)} { foreach buttonpref {im tx} { $w(nextCDR_$buttonpref) configure -state disabled $w(lastCDR_$buttonpref) configure -state disabled } $w(popupMenu) entryconfigure "Next*" -state disabled $w(popupMenu) entryconfigure "Last*" -state disabled $w(viewMenu) entryconfigure "Next*" -state disabled $w(viewMenu) entryconfigure "Last*" -state disabled } else { ;# can transition higher foreach buttonpref {im tx} { $w(nextCDR_$buttonpref) configure -state normal $w(lastCDR_$buttonpref) configure -state normal } $w(popupMenu) entryconfigure "Next*" -state normal $w(popupMenu) entryconfigure "Last*" -state normal $w(viewMenu) entryconfigure "Next*" -state normal $w(viewMenu) entryconfigure "Last*" -state normal } ##### Fourth layer - is the specific CDR encumbered in some way # (thus g(pos) MUST have a legitimate value) # # Update availability of bookmarking and Split/Combine actions # AND the specific merge-choice selected if {$g(count) > 0} { # Show which merge option is current for this CDR set g(toggle) $g(merge[set hID [hunk-id $g(pos)]]) # Bookmark (S)et and (C)lear items depend on the CDR marker # existance and are ALWAYS in opposite states to each other if {[winfo exists $w(bkmSF).mark$hID]} \ { set tmp {C S} } { set tmp {S C} } lassign {normal disabled} {*}$tmp foreach buttonpref {im tx} { $w(bkmRls_$buttonpref) configure -state $C $w(bkmSet_$buttonpref) configure -state $S } $w(markMenu) entryconfigure "Clear*" -state $C $w(markMenu) entryconfigure "Bookm*" -state $S # (S)plit/(C)ombine each have specific condition checks set S [expr {[splcmb-chk split $g(pos)] ? "normal" : "disabled"}] set C [expr {[splcmb-chk cmbin $g(pos)] ? "normal" : "disabled"}] foreach buttonpref {im tx} { $w(splitCDR_$buttonpref) configure -state $S $w(cmbinCDR_$buttonpref) configure -state $C } $w(editMenu) entryconfigure "Split*" -state $S $w(editMenu) entryconfigure "Combine*" -state $C } } ############################################################################### # Center entire CDR (or top line if cant fit) in each window (NO CDR? line 1.0) ############################################################################### proc centerCDR {} { global g w if {[info exists g(scrInf,[hunk-id $g(pos)])]} { lassign $g(scrInf,[hunk-id $g(pos)]) S E # Window requested height in pixels set opix [winfo reqheight $w(acTxWdg)] # Window requested lines set olin [$w(acTxWdg) cget -height] # Current window height in pixels set npix [winfo height $w(acTxWdg)] # Visible lines set winlines [expr {$npix * $olin / $opix}] # Lines in diff set diffsize [expr {$E - $S + 1}] # Move insert markers to CDR first line $w(LeftText) mark set insert $S.0 $w(RightText) mark set insert $S.0 # Center (if possible) if {$diffsize < $winlines} { set h [expr {($winlines - $diffsize) / 2}] } { set h 2 } } else { set h 0 ; set S 1; # There IS no CDR } # Use YVIEW (to ignore syncscroll) but ALWAYS DO both windows anyway $w(LeftText) YVIEW "[max 0 $S-$h].0" $w(RightText) YVIEW "[max 0 $S-$h].0" if {$g(showmerge)} { merge-center } } ############################################################################### # Wipe the slate clean... ############################################################################### proc wipe {} { global g # Short circuit useless traces and key indexing lists if {$g(startPhase)} {set g(startPhase) 1} set g(COUNT) [set g(count) 0] set g(DIFF) [set g(diff) ""] set g(d3Left) [set g(d3Right) {}] set g(pos) 0 set g(currdiff) "" # N.B: It is critical that hID-related datums, particularly those that use # their EXISTANCE as the basis for internal decision making, be REMOVED # when attempting a "start over" to avoid seemingly random errors. # NOTE: finfo is managed specifically by 'assemble-args' DO NOT TOUCH array unset g {scrInf,[0-9]*} array unset g {overlap[0-9]*} array unset g {merge[0-9]*} array unset g {inline,*} } ############################################################################### # Wipe all data and all windows ############################################################################### proc wipe-window {} { global g w wipe # Deleting text 'removes' any/all tag INSTANCES (w/o 'deleting' the defns) # yet LEAVES any marks: Wipe those out as well (but grab the list first...) # N.B> mergeText must be processed first: (it HAS the needed mark names)! foreach wdg {mergeText LeftText RightText} { $w($wdg) DELETE 1.0 end if {"$wdg" == "mergeText"} { $w($wdg) mark unset {*}[set taglst [$w($wdg) mark names]] # ... now REWRITE taglst to refer ONLY to (derived) 'vL*' names for {set i 0} {$i<[llength $taglst]} {incr i} { if {[string match "mark*c*" [set nm [lindex $taglst $i]]]} { set taglst [lreplace $taglst $i $i [string map {mark vL} $nm]] # (but PURGE elements that dont derive, readjusting the index) } else { set taglst [lreplace $taglst $i $i]; incr i -1; } } # but ALSO purge (now useless) 'vL*' tag defns from L/R Text widgets } else { $w($wdg) tag delete $taglst } } # No one uses this - what was it for? should we just Whack it? \ if {[string length $g(destroy)] > 0} { \ eval $g(destroy) \ set g(destroy) "" \ } $w(combo) list delete 0 end bkmark eraseall } ############################################################################### # Search an ascending sorted list of lower/upper bound pairs for a given value. # [**> LIST MUST EXIST AS A NAMED ARRAY ELEMENT OF THE GLOBAL ('g') SPACE <**] # # Returns the index that either CONTAINS it, or FOLLOWS it; -OR- # the original list LENGTH (i.e. an invalid index), indicating 'Exceeds range' # # N.B> as long as the bounds info is in the 1st two elements of the item # being searched, additional fields may be stored in the same 'record'. ############################################################################### proc rngeSrch {rnge val {indirect {}}} { global g # Until TcL V8.(6?).? arrives, there is NO "lsearch -bisect -command" # (so this code is our own customized 'tuple binary-search' instead) # If 'rnge' contains (what amounts to) array INDICES to yet ANOTHER # table of values, then 'indirect' can be used to specify the PREFIX # name of where to indirectly access those ACTUAL range values if {$indirect != {}} { set ithItem {$g($indirect[lindex $g($rnge) $i])} } {set ithItem {[lindex $g($rnge) $i]} } # Dont bother if 'rnge' is empty or 'val' exceeds its largest value set max [llength $g($rnge)] if {([set HI [set i [incr max -1]]] >= [set LO 0]) \ && ($val <= [lindex [subst $ithItem] 1])} { # Pick the FIRST midpoint and extract its values set i [expr {($LO + $HI)/2}] lassign [lindex [subst $ithItem]] low hgh # Repetitively narrow the boundaries until we find it # N.B> (extra expression ENSURES boundary ALWAYS moves) while {$HI > $LO} { if {$val > $hgh} {set LO [expr {$LO==$i ? $i+1 : $i}]} { if {$val < $low} {set HI [expr {$HI==$i ? $i-1 : $i}]} { break}} ;# Wow - a lucky HIT - stop NOW!! # Pick NEW midpoint and try again set i [expr {($LO + $HI)/2}] lassign [lindex [subst $ithItem]] low hgh } } else {return [incr max]} return $i } ############################################################################### # Specialized range-check machinery to find ancestor collisions (by mark-diffs) # Return an encoded 'category' of Ancestor mark(s) found in the requested range # Categories are: 0 -> None # 1 -> Additive # 2 -> Deletive # 3 -> Both # # N.B> optional arg is an initially unknown VarName (in callers stackframe) # to permit CHAINED accesses. It avoids searching for the correct 'anc' range # as is done on the FIRST such access by storing its LAST USED 'anc' index # to simply resume from that point (not unlike a co-routine or iterator) ############################################################################### proc chk-ancRnge {anclst S E {prev {}}} { global g if {![set result [llength $g($anclst)]]} {return 0} if {$prev != {}} {upvar $prev ndx} ;# (Remember where NEXT call starts) # Do we skip 'binary searching' for the first ancestor range? if {![info exists ndx]} { # No...but if searching yields 'Exceeds known ranges' THATs an answer, # yet needs DECREMENTing (to a valid value) to be CACHEd (if it will) if {$result == [set ndx [rngeSrch $anclst $S]]} {incr ndx -1} } # Get values of first ancestor range to check # (args S & E are expected to BE in min/max order) lassign "$S $E 0 [lindex $g($anclst) $ndx]" s(0) e(0) result s(1) e(1) mrk # Check ancestral ranges until found (or is known it CANT be found) while {$s(1) <= $e(0)} { # choose i'th segment as leftmost (and j as other - i.e. 0/1) set j [expr {[set i [expr {$s(0) > $s(1)}]] == 0}] # Look for range intersections and record category if {$s(0) == $s(1) || $e($i) >= $s($j)} { set result [expr { $result | ([string is lower $mrk] ? 1 : 2)}] } # Step to next ancestor range (if one actually exists) if {$ndx < [llength $g($anclst)] - 1} { lassign [lindex $g($anclst) [incr ndx]] s(1) e(1) mrk } else {break} } # If result is true, then $s($j) and [min $e($i) $e($j)] # IS the OVERLAP BOUNDS (I think) # (could maybe be returned as an optional upvar'ed "list" ?) return $result } ############################################################################### # Interactively cause the CDR to be treated as suppressed from now on ############################################################################### proc ignore-hunk {} { global g w # Ensure g(pos) will remain within the eventual g(diff) if {[set i $g(pos)] == [llength $g(diff)]} {incr i -1} set hID $g(currdiff) # Then re-categorize the current hunk if {![mark-diffs [list $hID [string map {a A c C d D} $hID]]]} { set g(pos) $i $w(combo) configure -commandstate disabled $w(combo) configure -value {} $w(combo) configure -commandstate normal after idle {show-status "Files now APPEAR as identical"} } { move $i 0 1 } update-display } ############################################################################### # Mark difference regions and build up the combobox # N.B> Be very AWARE of when/why g(diff) .vs. g(DIFF) is used!!! ############################################################################### proc mark-diffs {{rmvrpl {}}} { global g w opts set wdg(1) $w(LeftText) set wdg(2) $w(RightText) set O([set O(2) 1]) 2 ;# (just a simple meta-pgm 'O'ther identity value) lassign {0 0 0 0 0 0 0 0} \ g(COUNT) g(count) g(statusMrgL) g(statusMrgR) delta(1) delta(2) boxW boxC # Distinguishing between EDITTING .vs. LOADING of the global diff hunk # list is defined by the OPTIONAL "(r)e(m)o(v)e and (r)e(pl)ace" argument if {$rmvrpl != {}} { set Lpad [set Rpad {}] ;# (tmps for scheduling Pad-line removal) set hack {} ;# Dont need the responsiveness hack ... set g(startPhase) 1 ;# ... but RE-suspend "plot-line-info" $w(combo) list delete 0 end ;# ComboBox will simply be RE-loaded # Next do the REMOVEs of hunks from the diff list FIRST (including all # that depends on them) ... REPLACing with the NEW hunks before return. # This mostly works because the entries being removed occupy the # SAME SINGLE contiguous run as the entries taking their place. # Happily, Tcl ALLOWS modifying a list ACTIVELY being processed (due # to its incessant CLONING of things DURING their modification)!! # # N.B> We DO NOT re-evaluate "suppression" rules when editting diffs! # It would interfere with the ability to RE-edit later...sorry! set i 0 foreach d $g(diff) { if {[set ndx [lsearch -exact $rmvrpl $d]] >= 0} { if {![info exists inject]} { set i [set inject [lsearch -exact $g(diff) $d]];#1st delete } # Only ONE side ever has Pad lines - remove them lassign $g(scrInf,$d) na E Pl na na Pr set S [incr E] ;# (shift range downward for Widget addressing) if {$Pl} {lappend Lpad [incr S -$Pl].0 $E.0} ;# Left Padding if {$Pr} {lappend Rpad [incr S -$Pr].0 $E.0} ;# Right Padding $w(LeftText) tag delete vL$d ;# Left Vertical-Linearity $w(RightText) tag delete vL$d ;#Right Vertical-Linearity bkmark erase [incr i] ;# Eliminate bookmark (if any) merge-add-marks [list $d] ;# ... and its Merge data unset -nocomplain g(inline,$d) ;# inline diffs unset -nocomplain g(overlap$d) ;# 3way diff collision unset g(scrInf,$d) ;# line numbering information Dbg " KILLED inline $d" # Now that everything is gone, remove the hID from $rmvrpl set rmvrpl [lreplace $rmvrpl $ndx $ndx] } elseif {$i>0} { break } ;# early out once contiguous block found } # We MUST have deleted SOMETHING by now... ? if {$i} { # Must eliminate Padding all at once to avoid shifting the indices if {[llength $Lpad]} {$w(LeftText) DELETE {*}$Lpad} if {[llength $Rpad]} {$w(RightText) DELETE {*}$Rpad} # ... finally overlay the NEW hIDs ... REPLACING what was deleted # N.B> 'i' begins as an "index+1" position against g(diff) ... # afterward, 'inject' refers to 1st NEW index in g(DIFF) set j [lsearch -exact $g(DIFF) [lindex $g(diff) $inject]];#map 1st, # N.B.: $rmvrpl COULD right now be a 1 element list of an IGNORED # hunk that MUST be added to g(DIFF), but **NOT** to g(diff)!! # (as fabricated by the 'ignore CDR' user action) if {[llength $rmvrpl] !=1 || [string match {*[acd]*} {*}$rmvrpl]} { set g(diff) [lreplace $g(diff) $inject [incr i -1] {*}$rmvrpl] } { set g(diff) [lreplace $g(diff) $inject [incr i -1]]} set i [expr {$i - $inject + $j}] ;# readjust i to last mapped index set g(DIFF) [lreplace $g(DIFF) [set inject $j] $i {*}$rmvrpl] } } else { # Ain't this clever? We want to update the display as soon as we've # marked enough diffs to fill the display so the user will have the # impression we're fast. But, to prevent it from slowing us down too # much, put this code in a variable and delete it AFTER it fires once set hack { # for now, just pick a number out of thin air. Ideally # we'd compute the number of lines that are visible and # use that, but I'm too lazy today... if {$g(count) > 25} { update idletasks set hack {} ;# once fired, dont bother doing it again } } } # Compute minimal spacing to format the combobox entry numbering set fmtW [string length "[llength "$g(diff)"]"] # Walk through each diff hunk DERIVING global data for eventual use foreach d $g(DIFF) { # If its Info ALREADY exists, we are obviously in EDIT mode, needing # primarily to keep the 'delta(*)'s updated AND (re)add into comboBox if {[info exists g(scrInf,$d)]} { # Get most of what we know of this hunk ... # ... derive its type and determine if we count it as a REAL hunk lassign $g(scrInf,$d) S E Pl na Cl Pr Or Cr if {[string is lower [set type [expr {"$Cl$Cr"=="" ? "I":"i"}]]]} { incr g(count) } incr g(COUNT) ;# It ALWAYS counts in the superset list # However, ALL existing hunks BEYOND the injected entries require # certain minor realignments: # a) "scrInf,*" Ofst fields MUST be rewritten to the NEW deltas # likewise the S & E fields must adjust to the new delta SUM # b) if REAL (and bookmarked?), it will need a renumbered label if {$inject < $g(COUNT)} { set S [expr {$delta(2) - $Or + $S}] set E [expr {$delta(2) - $Or + $E}] set g(scrInf,$d) \ [list $S $E $Pl $delta(1) $Cl $Pr $delta(2) $Cr] if {"$type" == "i"} {bkmark $d $g(count)} } incr delta(1) $Pl ;# Keep the deltas CURRENT for EVERY hunk incr delta(2) $Pr } elseif { [set result [extract $d]] != ""} { # Otherwise, its a NEW hunk needing to be processed lassign $result s(1) e(1) s(2) e(2) type # Count it ... but only NON-suppressed hunks count as REAL incr g(COUNT) if {[string is lower $type]} { incr g(count) # In addition, before ALTERING any of those start/end numbers, # check for an active 3way diff and whether this hunk collides # any ancestral changes together. Moreover, also establish its # 'default' L/R merge choice (Ancestral over User preferred) if {$g(is3way)} { set g(merge$d) [set i [set j 0]]; # begin as unknown switch -- $type { "a" { set i [chk-ancRnge d3Right $s(2) $e(2) RaNDX] } "c" { set j [chk-ancRnge d3Left $s(1) $e(1) LaNDX] set i [chk-ancRnge d3Right $s(2) $e(2) RaNDX] } "d" { set j [chk-ancRnge d3Left $s(1) $e(1) LaNDX] } } # ACTUAL choice is based on a 4x4 table of possibilities # 1st row handles 'Del's ; 1st col handles 'Add's ; # and the rest applies to 'Chg's; Negative is a COLLISION # N.B> LOGICAL chances of SOME lower-right values occurring # is LOWER than the apparent overwhelming -2's suggests! if {[set g(merge$d) [lindex {{ 0 1 2 -2} { 2 -2 2 -2} { 1 1 -2 -2} {-2 -2 -2 -2}} $i $j]] < 0} { set g(overlap$d) 1; # Collision set g(merge$d) 2; # Dflt Choice is 'Right' because # its implied by the original (L/R) file arrangement } if {!$g(merge$d)} {set g(merge$d) $opts(predomMrg)} } else { set g(merge$d) $opts(predomMrg) } ;# when NO 3way at all } # Now REmap s(1),e(1) s(2),e(2) to refer to SCREEN linenumbers # First, compute the RAW Left and Right linecounts set siz(1) [expr {$e(1) - $s(1)}] set siz(2) [expr {$e(2) - $s(2)}] # Then adjust BOTH starts, accounting for ALL PRIOR hunk padding # (these then become this hunks starting SCREEN linenumbers) incr s(1) $delta(1) incr s(2) $delta(2) # Next, based on what TYPE of diff it is, decide WHICH widget: # - gets any (and how much) blankline padding (via setting "i") # - gets what type-associated ChangegBar character # N.B. Note that the RAW s($i) on "a,d"-types is 1-less initially # because it refers to a line number BEFORE the line that (by # virtue of the add/delete) does not actually exist on that side. # Uppercase types are hunks to be IGNORED (they get Padded only) set pad(1) [set pad(2) 0] set cbar(1) [set cbar(2) ""] switch -- $type { "A" - "a" { ;# an 'add' pads to the LEFT widget set pad([set i 1]) [incr siz(2)] incr s(1) ;# (RAW lnum was the one BEFORE the add) set cbar(2) [expr {$type == "a" ? "+" : ""}] } "D" - "d" { ;# a 'delete' pads to the RIGHT widget set pad([set i 2]) [incr siz(1)] incr s(2) ;# (RAW lnum was the one BEFORE the delete) set cbar(1) [expr {$type == "d" ? "-" : ""}] } "C" - "c" { ;# a 'change' pads to the SHORTER widget set i [expr {$siz(1) < $siz(2) ? 1 : 2}] set pad($i) [expr {abs([incr siz(1)] - [incr siz(2)])}] set cbar(2) [set cbar(1) [expr {$type == "c" ? "!" : ""}]] } } # Now, compute the END line numbers to THEIR screen values... incr siz($i) $pad($i) set e(2) [expr {$s(2) + $siz(2) - 1}] # IMPORTANT: if you've done the math (and logic), "e(1)" MUST EQUAL # "e(2)" when all is complete. But we still need the UNpadded value # as well -- so UNTIL THE NEXT ITERATION: # e(2) will hold the PADDED end value and # e(1) the UNpadded one. # Watch CAREFULLY where each gets used!!! # Moreover, s(1) will LIKELY be utilized as an INITIALIZED temp set e(1) [expr {$e(2) - $pad($i)}] # SAVE all this SCREEN ADJUSTED data for mapping various operations # later on throughout the tool # N.B!! s(1),e(1) == s(2),e(2) so only one set is recorded set g(scrInf,$d) [list $s(2) $e(2) \ $pad(1) $delta(1) $cbar(1) $pad(2) $delta(2) $cbar(2) ] # Accumulate any newly computed padding for the NEXT iteration incr delta($i) $pad($i) # FINALLY, we can ACTUALLY pad the widget into compliance (if reqd), # THEN plant the vL* TAG on BOTH 'final' LINE.0 of EACH side of hunk # for re-config WHEN any "inline diff" prefs (and/or data) changes. # N.B> APPEND (by INSERT 'end+1indice') incase final LINE.0 *IS* NL if {$pad($i) > 0} { $wdg($i) INSERT $e(1).end+1indice [string repeat "\n" $pad($i)] } # (of course, only REAL "chg" hunks EVER need skew compensation) if {"$type" == "c"} { # The vL* TAG ensures each L/R hunk pairing remains the same # PHYSICAL height in BOTH Text widgets, PROVIDING a L/R # alignment of MOST lines, by diminishing the scrolling skew # introduced by TK Vrsn(>= 8.5) "display .vs. logical" lines. # Begin by CREATING the TAG in BOTH widgets (w/NO instances) $w(LeftText) tag configure vL$d -spacing3 0 $w(RightText) tag configure vL$d -spacing3 0 # If/When active, generate inline diff data for this hunk # Note: this is ONLY the data - NOT a display change (yet) # N.B> DONT DO THIS for the Ratcliff Algorithm case: # its WAY too expensive computationally!! if {$opts(showinline1)} { while {$s(1) <= $e(1)} { inline-byte $d [expr {$s(1) - $s(2)}] \ [$w(LeftText) get $s(1).0 $s(1).end] \ [$w(RightText) get $s(1).0 $s(1).end] incr s(1) ;# (warned you this value could be trashed) } } # N.B> TK implementation issue: # Ordinarily we would WAIT (until "remark-diffs") to PLACE # these tags; but PLACING -or- CONFIGURing it triggers some # ugly asnychronous updating that can take measuarble time # to complete - giving rise to POSSIBLY reading "old" data. # To combat this, we PLACE the tag (in its 'do nothing' state) # NOW (so its 'updating' makes NO DIFFERENCE) and we'll deal # with RE-CONFIGURING it later (if and when needed) # # FURTHER, place them on FIRST char of each SIDES 'last-line' # to keep it from colliding with Pad line insertion!! # These are on DIFFERENT LINES when PADding actually occurred! add-tag $wdg($i) vL$d $e(1) 0 1 add-tag $wdg($O($i)) vL$d $e(2) 0 1 } } # Append entry into combobox (and hilight when its a 3way collision) if {[string is lower "$type"]} { # Also update the status window merge counters switch $g(merge$d) { 1 { incr g(statusMrgL) } 2 { incr g(statusMrgR) } } $w(combo) list insert end \ "[set item [format "%*d: %s" $fmtW $g(count) $d]]" if {[info exists g(overlap$d)]} { $w(combo) list itemconf end -background $opts(mapolp) } # measure its width, remembering the LONGEST entry seen ... # This is a bit of a pain: the width is SPECIFIED by charCOUNT # of an AVERAGE (aka '0') character, but WE have a space+colon and # UP TO 2 commas, ALL of which are THINNER in a proportional font! # So we track ('boxC') those pesky commas along with the charCOUNT set boxW [max $boxW [string length $item]] if {$boxC < 2} { if {[string match {*,*,*} $item]} {set boxC 2} \ elseif {$boxC < 1 && [string match {*,*} $item]} {set boxC 1} } eval $hack ;# ... and TRY to update display ASAP } } # Beyond here, MOST other tool functions are based on g(diff) and g(count) # [big exception is "line numbering" code that uses g(DIFF) and g(COUNT)] # Shrinkwrap combobox TO its data (avoiding both clipping AND excess space) # (ie. REDUCED by a pixel-calc'ed value of EQUIVALENT 'avg' chars) if {$g(count)} { set i [font measure [set f [$w(combo) cget -font]] "0"] set j [font measure $f ": [string repeat "," $boxC]"] $w(combo) configure -width [expr $boxW -((([incr boxC 2]*$i) -$j) /$i)] } # Ensure that any NEWLY CREATED diff regions are 'mark'ed in the MERGE # window (so they can be tagged in the next step -- note that 'rmvrpl' here # either HAS the list of ONLY the additions, or is EMPTY which flags the # procedure to mark EVERY diff (unless it was an SINGLE suppress request) if {$g(count) && ([llength $rmvrpl]!=1 || [string match {*[acd]*} [lindex $rmvrpl 0]])} { merge-add-marks $rmvrpl } # Lastly, ensure the MAP reflects the CURRENT diffs and go (re-)TAG it all map-draw remark-diffs return $g(count) } ############################################################################### # Remark difference regions... ############################################################################### proc remark-diffs {} { global g w pref opts if {$g(statusInfo) == ""} {show-status "Re-Marking differences..."} # First, reconfigure ALL tags (based on the current options) ... # # IMPORTANT - this loop DEFINES the ENTIRE tag PRECEDENCE throughout TkDiff # (and MUST AGREE with/for the 'translit-plot-txtags' emulation coding!!) # (N.B> we abbreviate tag names here simply to fit in 80 columns) foreach tag {diff curr del ins chg overlap inline sel} { # By cycling each AMONG the widgets, we give them TIME to update things # (N.B> PARTICULARLY Y-pixel-height related things!!) foreach win [list $w(LeftText) $w(RightText) $w(mergeText)] { if { "$tag" == "sel"} { # When we SEE the "sel" tag specified (which MUST be LAST), then # its TIME to RAISE any "vL" tags ABOVE everything BUT "sel" foreach tag [$win tag names] { if {[string match "vL*" $tag]} { $win tag raise $tag } } $win tag raise [set tag sel] } else { $win tag remove ${tag}tag 1.0 end # Catch provides an error check against bad userpref settings # that MAY have been editted BY HAND directly in the users file if {($win != $w(mergeText) || $tag == "curr") && [catch "$win tag configure ${tag}tag $opts(${tag}tag)" bad]} { popmsg "Invalid settings for \"$pref(${tag}tag)\":\ \n\n'$opts(${tag}tag)' is not a valid option string:\n$bad\ \n\nPlease repair this preference as soon as possible" # Yet 'difftag' cfgs into mergeText as TWO names: diffR & diffL, # but as ITSELF in the main Text windows (despite the same attrs) # - a coding trick so merge knows which SIDE provided the line! } elseif {$win == $w(mergeText) && "$tag" == "diff"} { # ('difftag' SETTINGS were already validity checked by now) $win tag configure ${tag}R {*}$opts(${tag}tag) $win tag configure ${tag}L {*}$opts(${tag}tag) } } } } # Now, reapply the tags applicable to all the diff regions foreach hID $g(diff) { # First do the difftag (plus derivatives: ins/del/chg/overlap) ... set-dtags $hID difftag # ... and reinstate any needed inline Tagging (inclds. de-skew) if {($opts(showinline1) || $opts(showinline2)) && [string match "*c*" "$hID"]} { remark-inline $hID } } # Turn "plot-line-info" processing back ON if it was OFF if {$g(startPhase) == 1} {incr g(startPhase)} # finally, re-establish the current diff set g(currdiff) [set-dtags [hunk-id $g(pos)] currtag] } ############################################################################### # Update Skew correction (Re possibly LARGER 'inline' FONT usage) on given hunk ############################################################################### proc de-skew-hunk {hID} { global g w # Get current skew value (either Left or Right) for DESIGNATED hunk # (so it can be SUBTRACTED from our measurement) lassign $g(scrInf,$hID) s1 e1 set lsz -[set Lsz [[set wL $w(LeftText)] tag cget vL$hID -spacing3]] set rsz -[set Rsz [[set wR $w(RightText)] tag cget vL$hID -spacing3]] # Want measurements to be RE-ANALYZED but without any PRIOR SKEW included # (best AFTER any deferred processing has completed ... sortof ... ) update idletasks # In truth, TK (@8.6.3) updates its Y-position CACHE in asynchronous # chunks of about 250 lines per each go, *NOT* tied into "idletasks", # ANYTIME something SUGGESTS it might change (and spacing3 *is* one)! # Our best chance to AVOID reading "old-data" is to LIMIT the # NUMBER of such asynch-"ripples" we propagate, AND at least TRY to # space them out w/other processing (to give each the TIME req'd). # So START by asking each widget what it THINKS the SKEW *should* be ... # (causing 1 ?foreshortened? ripple in each widget) incr lsz [$wL count -update -ypixels $s1.0 $e1.0+1lines] incr rsz [$wR count -update -ypixels $s1.0 $e1.0+1lines] # Now config shorter side IF NEEDED to make left/right screen heights agree # (deal with MINOR possibility that skew MIGHT JUMP to other side) # AT MOST - causes one ADDITIONAL ripple in each side (per hID) ... # ...but OFTEN only ONE side - if so forget the UNAFFECTED wdg name if {$rsz > $lsz} { if {$Rsz} {$wR tag configure vl$hID -spacing3 0} {set wR {}} if {$Lsz+$lsz} { $wL tag config vL$hID -spacing3 [expr $rsz-$lsz]} # Dbg { Skew $hID -> LEFT [expr $rsz-$lsz] L($lsz) R($rsz)} } elseif {$lsz > $rsz} { if {$Lsz} {$wL tag configure vl$hID -spacing3 0} {set wL {}} if {$Rsz+$rsz} { $wR tag config vL$hID -spacing3 [expr $lsz-$rsz]} # Dbg { Skew $hID -> RGHT [expr $lsz-$rsz] L($lsz) R($rsz)} } elseif {$Rsz || $Lsz} { # Because we measured IGNORING skew, ONE of these MAY have a value # when INLINing is being turned OFF (and thus NEEDS to be ZEROed) if {$Rsz} {$wR tag configure vl$hID -spacing3 0} {set wR {}} if {$Lsz} {$wL tag configure vl$hID -spacing3 0} {set wL {}} # Dbg { Skew $hID -> [expr $lsz-$rsz] L($lsz) R($rsz) was zeroed} # TAKING this return basically implies NOTHING needed changing # Thus we can AVOID any further ripple processing by the TK internals } else {return} # N.B. Ripples: the TK implementation of pixel-height management involves # an async 'catch-up', obstensibly to maintain UI responsiveness. Sadly, # their method can seemingly be short-circuited (unknown WHY) leaving the # computation of the overall physical height (across ALL lines) improperly # PROPAGATED (i.e. USING older cached-values) when calc'ing the FRACTIONS # needed to talk to the scrollbars AND establish the TxtWdg YView. # This in turn causes any sync'd scrolling to misrepresent (it DEPENDS on # both L/R windows USING the SAME fractions) what each window should show # even though the actual SETTINGS were already PROVIDED w/correct values! # What we OBSERVED was that if EACH hunk was subsequently made to # DISPLAY, something in TK NOTICED the "still incorrect cached values" and # CORRECTED them, but for ONLY those ACTUALLY DISPLAYED. In short, if one # SCROLLED thru every hunk, everything slowly came back into alignment. # # As of Tk8.6.5 a new subcmd (sync) is POSSIBLE, but our approach MIGHT # still be faster given we target smaller SPECIFIC indice ranges. # (The "sync" implem. has a bit more of a GLOBAL WIDGET effect) # BONUS: using "count -update -ypixels" also lets us STAY with TK V8.5 # # SO - (assuming we actually changed SOMETHING...) we FORCE TK to rescan # our changes by RE-STARTING its background task which SHOULD yeild both # SIDES of the hunk FINALLY being cached CORRECTLY (and w/ALL skew GONE) if {$wL != {}} {$wL count -update -ypixels $s1.0 $e1.0+1lines} if {$wR != {}} {$wR count -update -ypixels $s1.0 $e1.0+1lines} # Tk8.6.3 *BUG*: the "legacy" Txtwdg implementation would OCCASIONALLY # invalidate internal BTree ptrs when the data size was very small. SEEMED # to involve the deferred processing somehow, and will hopefully be gone # if (or when) the Txtwdg impl is redone (see http://core.tcl.tk/ TIP #466) # # Calling "idletasks" TWICE (here and earlier) STOPPED the observed SEGV. update idletasks } ############################################################################### # Add inline tags for a given SINGLE hunk to BOTH Text widgets # Does entire hunk UNLESS a specific Begin OR End Lnum (inclusive) is provided ############################################################################### proc remark-inline {hID {BgnL 0} {EndL 0}} { global g w # N.B> Oddly enough, it is legitimately POSSIBLE that ABSOLUTELY IDENTICAL # linepairs can be 'inline-diff'ed resulting in NO output list of ranges! # Distinction is ENTIRELY about how Diff chose to describe the hunk... # eg.: 1c1,2 # | abc | | abc | <--- compared identical # | | | d e | <--- skips (left is empty) # | xyz | | xyz | (thus ZERO results) # versus: 1a2 # | abc | | abc | # | | | d e | (only 'c' types DO inlines) # | xyz | | xyz | # # (Diff output can be quite capricious at times!!) # Accordingly, variable MAY legitimately NOT EXIST - or be EMPTY! if {[info exists g(inline,$hID)] && [llength $g(inline,$hID)]} { set wdg(l) "LeftText" set wdg(r) "RightText" # Presumes 'inlinetag' was ALREADY removed from BOTH Text widgets # N.B> 'Bgn/End' DEFAULTS to 'S/E' resp. if not overriden when called lassign $g(scrInf,$hID) S E if {!$BgnL} { set BgnL $S} if {!$EndL} { set EndL $E} # N.B> note subtle oscillation between NDX and Lnum as loop proceeds foreach {side lndx Scol Ecol} $g(inline,$hID) { if {[incr lndx $S] <= $EndL} { if {$lndx >= $BgnL} { add-tag $w($wdg($side)) inlinetag $lndx $Scol $Ecol } } } } # Line heights MAY have changed (eg. TAG fonts) - compensate # (Other tags are applied in L/R pairs, implicitly maintaining entropy) de-skew-hunk $hID } ############################################################################### # Post some SHORT informational text. # Behavior DEPENDS slightly on overall state (initial startup .vs. running) # where target LABEL widget should be GROWN to accomodate the info msg passed. ############################################################################### proc show-status {message} { global g w # Grow (pre-built ONLY) status widget to accept posting message if {!$g(startPhase) && [winfo exist .status] && [$w(statusLabel) cget -width] < [set grow [string length $message]]} { $w(statusLabel) config -width [min 70 $grow] } set g(statusInfo) $message update idletasks } ############################################################################### # A limited Cohen-Sutherland line CLIP Alg classifier (only does 1 dimension) # thus its name: "half clip" ; Zero return means total INCLUSION ############################################################################### proc hCLIP {s e mn mx} { return [expr ($e<$mn)*8 + ($e>$mx)*4 + ($s<$mn)*2 + ($s>$mx)] # Essentially a binary-packed PAIR of 2bit-wide values, thus has values # from 0 to 15. When in use, only roughly HALF (9) are LOGICALLY possible } ############################################################################### # Compute differences (start from the beginning, basically). ############################################################################### proc rediff {} { global g w opts finfo # Read the files into their respective widgets # and derive the overall line number magnitude. set g(lnumDigits) 0 set i [set j [expr {[set pairnum $finfo(fCurpair)] * 2}]] incr i -1 set Statmsg [set msg {}];# Assume this is all gonna work ... foreach {LR ndx} [list Left $i Right $j] { # When finfo(pth,X) is NOT set yet, its a SCM file that # has not yet been obtained -- go get it show-status "reading $finfo(lbl,$ndx) ..." if {![info exists finfo(pth,$ndx)]} { # if it fails: finfo(pth,$ndx) will LIKELY be an empty tmpfile if {"" != [set msg [scm-chkget $ndx]]} {popmsg "$msg"} } if {[catch {set hndl [open "$finfo(pth,$ndx)" r]}]} { fatal-error "Failed to open file: $finfo(pth,$ndx)" } else {fconfigure $hndl -translation \ [expr {"$::tcl_platform(platform)" == "windows" ? "crlf" : "lf"}]} # PREVENT V9.x from throwing 'encoding' errors if {$::tcl_version >= 9.0} { fconfigure $hndl -profile tcl8 } $w(${LR}Text) REPLACE 1.0 end [read $hndl] # Must also replace the merge window contents (w/Left contents) if {$LR == "Left"} { seek $hndl 0 start ;# Rewind the Left file catch { $w(mergeText) mark unset [$w(mergeText) mark names] } $w(mergeText) REPLACE 1.0 end [read $hndl] if {![regexp {\.0$} [$w(mergeText) index "end-1lines lineend"]]} { $w(mergeText) INSERT end "\n" } } close $hndl set lines [file rootname [$w(${LR}Text) index end-1lines]] set g(lnumDigits) [max [string length "$lines"] $g(lnumDigits)] } # Provide feedback on this filepair being successfully accessed (or not)... # Decorate all the visuals per this set of files...and then finally push # g(lnumDigits) AND is3way to reconfig width of Info widgets (do-show-Info) if {$msg=={}} { multiFile mrkACK $pairnum } { multiFile mrkNAK $pairnum } alignDecor $pairnum do-show-Info # Diff the two files and store the summary lines into 'g(diff)' set cmd $opts(diffcmd) lappend cmd $finfo(pth,$i) $finfo(pth,$j) show-status "Executing {$cmd}" lassign [run-command "$cmd"] diffOUT diffERR diffRC set g(returnValue) $diffRC ;# Record REAL RC # Now, when that exit code *IS* 0 there are NO differences; when # its a 1 there *ARE* differences (but *PERHAPS* not what you expect) # Any OTHER exit code simply means trouble if {$diffRC < 0 || $diffRC > 1 || $diffERR != ""} { popmsg "diff failed:$diffRC:\n$diffERR\n\ [string range $diffOUT 0 75] ... (partial)" # Simulate 'identical' going forward: (avoids any further issues) set Statmsg ">> NO ACTION TAKEN << due to errors" set diffOUT {} set diffRC 0 set lines {}; # Simulate 'identical' to avoid issues } elseif {"[set lines [split $diffOUT "\n"]]" != "" && $diffRC} { # Historical note: OLDER 'diff' vrsns USED to produce: # "Binary files ..(names).. are different" ON stdout WITH RC=1 # Newer ones do similar, BUT w/RC=2 (when non-text files are used) # At least VERIFY 1st line LOOKS (mostly) like a 'Normal' diff header if {![string match {[0-9]*[acd][0-9]*} [lindex $lines 0]]} { # Hmmm. Try converting (in place) FROM "Unified" format ... deUnify lines if {![string match {[0-9]*[acd][0-9]*} [lindex $lines 0]]} { # ... Still NO? popmsg "diff failed:$diffRC: Unrecognized diff format: [string range $diffOUT 0 75] ... (partial)" set Statmsg ">> NO COMPARISON POSSIBLE << due to errors" set lines {}; # Again, simulate 'identical' to avoid issues set diffRC 0 # Close enough - (at least protects us from unexpected formats) # Cheap trick: extra trailing sentinel will flush NEXT loop } { lappend lines "0" } } { lappend lines "0" } } # Collect all lines containing diff hunk headers # N.B> Critical Concept- There are TWO lists of headers: # 'g(DIFF)' is the superset and includes EVERY reported hunk # 'g(diff)' is POTENTIALLY a subset, but is USED by MOST OF THE TOOL # # The distinction comes from options the user MAY have used to suppress # certain kinds of hunks (blanklines, REmatched) which WE MUST PROCESS and # NOT pass to Diff (it would HIDE places where widget padding is needed). # Our technique is to UPPERCASE the headers for hunks being suppressed, # but then ALSO restrict such headers to the 'g(DIFF)' list. # # When the options are NOT used, both lists are identical - (but beware # of LATENT bugs being CAUSED by keying some downstream feature to the # WRONG list!!). Otherwise, THIS code simply APPLYS the suppression options # and forms BOTH lists, in a "state machine" style of parsing. Both headers # AND diff content lines must be read, as the rules for "suppression" need # EVERY line of the hunk to be QUALIFIED before ignoring is possible. # Generally, it is Text widget "Padding" and "Line numbering" tasks that # require the use of 'g(DIFF)'; everything(?) else should use 'g(diff)'. set hID [set g(DIFF) [set g(diff) {}]] foreach line $lines { switch -glob [string index $line 0] { "-" {continue} "[0-9]" {if {$opts(ignoreEmptyLn) \ || ($opts(ignoreRegexLn) && $opts(ignoreRegexLnopt) != "")} { if {[string length $hID]} { if {[string match {*[acd]*} $hID]} { lappend g(diff) $hID } lappend g(DIFF) $hID } # Presume it WILL suppress (re-activating at each hunk) set hID [string toupper [lindex $line 0]] if {[set Esuppress $opts(ignoreEmptyLn)]} { # Ignoring EMPTY lines CAN depend on BLANK suppression # (when active) as MOST can make ONLY WhtSpc evaporate if {$opts(ignSuprs) && ($opts(egnBlanks) + $opts(egn#Blanks) + $opts(egn@EOL))} { set Eexpn {^..[[:space:]]*$};# any of "-wbZ" used } { set Eexpn {^..$}} ;# otherwise } set Rsuppress [llength $opts(ignoreRegexLnopt)] } elseif {[string length $line]-1} { lappend g(diff) [lindex $line 0] lappend g(DIFF) [lindex $line 0] set hID {} } } "[<>]" {if {![string match {*[ACD]*} $hID]} {continue} # Verify this lines data against the reasons for suppression if {$Esuppress} { if {![regexp $Eexpn $line]} {set Esuppress 0} } if {$Rsuppress} { set Rsuppress [llength $opts(ignoreRegexLnopt)] # (if ANY expn matches, then the suppression remains valid) foreach Iexpn $opts(ignoreRegexLnopt) { if {![regexp $Iexpn [string range $line 2 end]]} { incr Rsuppress -1} {break} } } # Cancel the presumption of suppression if the reason is gone if {!$Esuppress && !$Rsuppress} {set hID [string tolower $hID]} } } } Dbg {DIFF([llength $g(DIFF)]) .vs. diff([llength $g(diff)])} if {$diffRC && $g(is3way)} { # Make sure we HAVE the ancestorfile (go get it if not) if {![info exists finfo(apth,$pairnum)]} { # if it fails: finfo(apth,$pairnum) may LIKELY be an empty tmpfile, # making the Ancestrals APPEAR as 1 BIG Add (on each side) if {"" != [set msg [scm-chkget "a$pairnum"]]} {popmsg "$msg"} } set g(d3Left) [set g(d3Right) ""]; # ERASE the 2 global output lists # SO - the WHOLE IDEA here is that based on a common ancestor, lines can # ONLY be ADDed or DELeted (a CHG is some of both). ADDed lines always # SURVIVE into the target, but a DEL line 'survives' only when the OTHER # side FAILS to ALSO delete it. # # >> We want the LOCATION of EVERY survivor (per its side) << # # Thus NON intersects simply get recorded, although to WHICH SIDE # depends on its ADD/DEL status. Adds go to the side of occurence, Dels # obviously can only be marked on the OPPOSING side for those portions # that were NOT deleted from BOTH ... but COLLISIONS are tricky! ######################################### # We've kinda "folded" this processing INTO itself because the # mapping technique TRUELY requires reading BOTH Diff streams # simultaneously in a "data directed" fashion. But to conserve both # time & code, we've reorganized it to do everything as a 3 pass # hybrid state-machine, reading first one, THEN the other stream # (during which MOST of the processing will occur), with a final # 'flush' pass to finish mapping any PENDING items from the 1st pass. # # N.B: 'i','j' ARE available for tmp usage once loop starts (a Tcl-ism) # (the trailing ZERO sentinel forces the FINAL "3rd iteration" flush) foreach {NDX LR} [list $i Left $j Right 0] { if ($NDX) { # In 3-way merge - we diff EACH file "from" the ancestor set cmd $opts(diffcmd) lappend cmd $finfo(apth,$pairnum) $finfo(pth,$NDX) show-status "Executing {$cmd}" lassign [run-command "$cmd"] diffOUT diffERR RC;#NOT diffRC if {$RC < 0 || $RC > 1 || $diffERR != ""} { popmsg "Ancestor/$LR diff failed:$RC:\n$diffERR\n\ [string range $diffOUT 0 75] ... (partial)" set diffRC 0; # Indicate we CANT do the 3way break } elseif {"[set lines [split $diffOUT "\n"]]" != "" && $RC} { if {![string match {[0-9]*[acd][0-9]*} [lindex $lines 0]]} { # Once again, MAYBE its actually "Unified" format... deUnify lines ; # TRY to convert it (in place) } if {![string match {[0-9]*[acd][0-9]*} [lindex $lines 0]]} { popmsg "Ancestor/$LR diff: Improper diff format:\n\n\ [string range $diffOUT 0 75] ...\n (partial output)" set diffRC 0; # Again, we CANT do the 3way break } } elseif {!$RC} { popmsg "Ancestor/$LR diff: Inconsistent data:\n\n\ Ancestor must NOT be identical to $LR side file" set diffRC 0; # Yet again, we CANT do the 3way break } # (3rd pass? ... FAKE our way INSIDE next loop (to flush Left side) } else {set lines [list { }]} foreach line $lines { # Spin until we detect a hunk header line if {$NDX && ![string match {[0-9]*} $line]} { continue } # 1st pass (Left): accumulate ALL the headers as a list ... if {$LR == "Left"} { lappend d3Left(hnks) "[extract $line]" # ... but also detect that first entry (& init onetime vars) # while ALSO tracking the max size of the list we build if {[set maxLh [llength $d3Left(hnks)]] == 1} { upvar 0 d3Right CH; # Presume Right is initial CUR Hunk set CH(nxt) "break" set CH(swap) "d3Left" set CH(self) "d3Right" lassign {0 0 ? 0} CH(s) CH(e) CH(m) CH(cv);# init stage upvar 0 d3$LR MH ; # Presume Left is initial MAP Hunk set MH(nxt) { set d3Left(hnk) "[lindex $d3Left(hnks) [incr ndx]]"} set MH(swap) "d3Right" set MH(self) "d3Left" lassign {0 0 ? 0} MH(s) MH(e) MH(m) MH(cv);# init stage # Last, "prime" the upcoming while loop w/1st Map Hunk set ndx -1 ; eval $MH(nxt) lassign "$MH(hnk)" MH(s1) MH(e1) MH(s2) MH(e2) MH(typ) } # Dbg puts -nonewline "\n<$LR>$maxLh line($line)" continue # 2nd pass (Right): simply parse this one line (a 1-entry list) } elseif {$NDX} { set CH(hnk) "[extract $line]" # Dbg puts -nonewline "\n<$LR> line($line)" # 3rd pass (Left): Flip one FINAL time & map remaining(?) Lefts # # N.B.: CH & MH are aliases to the LOCAL d3Left/d3Right arrays # (our data structure). Each ALWAYS refers to only ONE of the # arrays, but are OFTEN exchanged so the coding can adhere to # the notion that the CURRENT hunk (CH) is the one BEING # mapped and (MH), the MAPPING hunk (from the other array), # supplys the critical data needed to do so. } else { # Dbg puts -nonewline " *** FINAL CH MH swap ***" upvar 0 $MH(swap) MH $CH(swap) CH} # Process BOTH diff headers IN TANDEM to create the Markings # # Odd control test is yet ANOTHER "sneak path" to permit # this (at first a) conventional "while" to LATER operate (if # needed) as a NON-loop (triggering code is just BEYOND loop) # The technique is a variation on "Dynamic Programming" while {$ndx < $maxLh || $ndx > $maxLh} { lassign $CH(hnk) CH(s1) CH(e1) CH(s2) CH(e2) CH(typ) # EARLIER hunk (in Ancestor nums) is expected to BE the one # mapped (CH); SHOULD we exchange (L<->R) to achieve that ? # (*ONLY* if we are in NEITHER "flush" mode [per if-tst]) if {$NDX && $ndx < $maxLh && $CH(s1) > $MH(s1)} { # Dbg puts -nonewline " *** Semantic CH MH swap ***" upvar 0 $MH(swap) MH $CH(swap) CH } # Chk the DEL portion for collisions with EITHER another # DEL (from the opposite side) -OR- an ADD in the SAME side # (we designate these as Del->Del or Del->Add respectively) if {$CH(typ) != "a"} { # Dbg puts -nonewline "\n\tDel\t\tNDX($NDX) \ CHhunk($CH(hnk)) ndx:maxLh($ndx<>$maxLh) CH($CH(self))" set E [expr {$CH(e1) - $CH(s1)}] ;# get span of Cur del # Next, compute its MAPPED startpt PRESUMING the # maphunk(MH) is BEYOND us in ancestral ordering ... set S [expr {$CH(s1) + ($MH(s2) -($MH(typ) != "d")) - ($MH(s1) -($MH(typ) != "a"))}] # ...BUT, if that presumption was wrong, further adjust # the mapping by the distance spanned of that maphunk if {$CH(s1) > $MH(s1)} { incr S [expr {$MH(s1) - $MH(e1) -($MH(typ) != "a") \ + $MH(e2) - $MH(s2) +($MH(typ) != "d")}] } # Finally, we can finish the mapping by both setting # its endpt, and the needed "conversion factor" (CV) # that permits us recovering its ancestral numbering. incr E $S set CV [expr $CH(s1) - $S] ######################################### # NOW the FUN ... manufacturing SEQUENTIAL marker data # # Deletions pose an issue as you cant really mark a line that # isnt there. BUT, the line MIGHT exist on the other side (L/R) # IFF it so happens that it was never deleted by any of the # "other side" hunks! # So what we need now is to COMPARE the deletions from BOTH # sides, eliminating those they have in common, and manufacture # markers for the rest. The trick is we have to compare using # ANCESTRAL values, but POST the marks in (L/R) numbers (hence # the CV value!). # Marks are simply an ascending LIST of inclusive line num # pairings (and a displayable UPPERCASED marker char) that # describes lines within that range as "NOT deleted" as they # WERE by the opposing side. Mark numbers are side-specific! # # Ready? # We find collisions by comparing the MOST RECENT range posted, # against that which we are ABOUT to post. This clearly means # we MAY have to BOTH edit the PRIOR posting in addition to the # one in progress (be it an Add or a Del). ALL possibilities # exist: do nothing, eliminate both or either or NEITHER, even # splitting 1 into 2, and inserting the 3rd inbetween. # To evaluate which, we perform a modified version (a single # dimension) of a Cohen Sutherland CLIP Alg. (hCLIP) to quickly # identify 1 of 9 possible situations, and then simply switch # among those possibilities. Using the following mnemonics: # arg1 S: Segment startpt ALWAYS the curr Segmnt # arg2 E: Segment endpt # arg3 RS: Range startpt ALWAYS the prior Mark # arg4 RE: Range endpt # # The 9 hCLIP-encoded proc result specifys these relationships: # 0 : S >RS and E RS and E>=RE # 5 : S =RE and E>=RE # 6 : S<=RS and E>=RE # 10 : S<=RS and E =RS # 7 : (special case RS=RE): S =RS and E >RE # 14 : (special case RS=RE): S $E}\ {set j 0} if {$i != 7} {;# @4 & @5 edit into: s/S-1 set CH(e) [expr $S+$CV-1-$CH(cv)] # @4 & @5: } elseif {$j} {set CH(s) 0} set S $j # (UNFLUSH return code is implicitly coded) } "6" { if {[set j [expr $CH(s)+$CH(cv)-1-$CV]]<$S}\ {set j 0} if {[set i [expr $CH(e)+$CH(cv)+1-$CV]]>$E}\ {set i 0} # After measuring Seg overhangs, # handle having both, either or neither if {$i && $j} { lassign "$S $j \ [string toupper "$CH(typ)"] $CV" \ CH(s) CH(e) CH(m) CH(cv) set S $i } else { set S [incr i $j] } # (UNFLUSH return code is implicitly coded) } }]} then {;# UNFLUSH: # REMOVE end of list and reinstall as staged lassign [lindex $g($CH(self)) end] \ CH(s) CH(e)] CH(m) CH(cv) if {"$CH(s)" == ""} {set CH(s) 0};# <- paranoia set g($CH(self)) [lreplace g($CH(self)) end end] } # YET, if that "prior other side" post was REALLY an Add # then the COMPARISON must be directed TO that other # side to check for a Del->Add collision (but THIS time # using ONLY (L/R) values as Adds simply DO NOT HAVE a # legitimate Ancestral value). } elseif {$MH(s) && [string is lower $MH(m)] && (![set i [hCLIP $S $E $MH(s) $MH(e)]] || \ ($i%4) != ($i/4))} { # Not nearly as difficult as the above Del->Del # Just apply offset needed to get beyond the Add set i [expr $MH(e) - $S + 1] incr S $i incr E $i incr CV -$i;# maintain reference to Ancestral lines } # Post current Del Mark (if it hasn't been editted away) # by 1st FLUSHING the prior STAGED mark ... (if any) # This "staging area" allows us to more easily edit # any individual element without ALWAYS having to "POP" # and "re-stage" an entire entry as we try to modify it. if {$S} { # Flush any presently staged item to its list... if {$MH(s)} {lappend g($MH(self)) \ "$MH(s) $MH(e) $MH(m) $MH(cv)" } # ... then stage (ie. POST) the CUR Del for editting lassign "$S $E [string toupper $CH(typ)] $CV" \ MH(s) MH(e) MH(m) MH(cv) } } # SIMILARLY, check (SAME CURhunk) for an Add component that # maybe collides with an EXISTING Del (posted from the # OTHER side, now on this side, designated as a "Add->Del") if {"[set TYP "$CH(typ)"]" != "d"} { # Dbg puts -nonewline "\n\tAdd\t\tNDX($NDX) \ CHhunk($CH(hnk)) ndx:maxLh($ndx<>$maxLh) CH($CH(self))" # By defn, Add values are NEVER Ancestral, thus have # no need to ever view their comparisons as anything # more than the (L/R) values they ALL posess. set S $CH(s2) set E $CH(e2) set CV 0; # Thus its best if CV remains ZERO # Look for a Del collision on same side as the CUR Add if {$CH(s) && [string is upper $CH(m)] && (![set i [hCLIP $S $E $CH(s) $CH(e)]] || \ ($i%4) != ($i/4))} { ######################################### # There are TWO forms of Add->Del collisions: "push" and "split" # push: is when the Add PRECEDES the Del (but still collides). # Add takes precedence, so Del is "pushed" to be after it. # # split: The converse causes the Del to be "split" AT the Add # start, with the remainder of the Del "pushed" after it. # # EITHER WAY, we end up with a MINIMUM of 2 postings (max 3), # but the FINAL 2 are always in 'Add', 'Del' sequence - # which is **NOT THE PRESENT ORDER** ... ######################################## # ... THUS - we FULLY PRE-swap them NOW!! # (which may make reading the entirety of the # switch block feel a bit backward - BE AWARE) lassign \ "$S $E $TYP $CV $CH(s) $CH(e) $CH(m) $CH(cv)" \ CH(s) CH(e) CH(m) CH(cv) S E TYP CV # NOW: CH(*) is the Add....others are the Del # Once again, re-CLIP Add Seg TO an INLINED range # (reasons explained under Del->Del processing) switch [hCLIP $CH(s) $CH(e) $S+1 $E-1] { "0" - "4" - "5" {; # Above cases ALL SPLIT the Del to 2 segs # Flush the LEAD Del portion into the list, lappend g($CH(self)) \ "$S [incr CH(s) -1] $TYP $CV" # Next, calc span of Add Seg, begin to update # start of 2nd Del fragment, and repair CH(s) set i [expr [set S $CH(e)] - [incr CH(s)] +1] # lastly, finish edit to trailing Del startpt incr S } default {; # Remaining cases ALL perform a "push" # Calc span of Add to push Del past it set i [expr $CH(e) - $CH(s) + 1] incr S $i }} # EVERY case then exits thru this common code # (which is completing a half-done 'push') incr E $i ;# update endpt incr CV -$i;# and maintain Ancestral link } # Adds are NEVER "editted", so NO "if S==0" is needed. # Just flush the presently staged Add to the list... if {$CH(s)} {lappend g($CH(self)) \ "$CH(s) $CH(e) $CH(m) $CH(cv)"} # ... then stage REMAINING Del Segment for the future lassign "$S $E $TYP $CV" CH(s) CH(e) CH(m) CH(cv) } # Curr hunk is now mapped ... "increment" to get NEXT one # PROVIDED the Left side is NOT in "flush" mode -OR- # the Right side is STILL flushing... if {$ndx < $maxLh} { eval $CH(nxt) } else break } # Dbl-check WHY we are getting a new RIGHT hunk; if its because # there are NO MORE "Lefts", we are in a "flush Right" state: # Activate the "sneak path" to allow EACH NEXT Right INSIDE # the above "while" loop for a single pass if {$ndx == $maxLh} {incr ndx} } } # Everything has been mapped, simply FLUSH the final staged values if {$diffRC} { lappend g($CH(self)) "$CH(s) $CH(e) $CH(m) $CH(cv)" lappend g($MH(self)) "$MH(s) $MH(e) $MH(m) $MH(cv)" # Dbg puts "" N.B> Uncommenting ALL 'Dbg puts' lines will produce # a TRACE of the Ancestral processing flow (must remove 'Dbg' as # well as Dbg doesn't ACCEPT the "-nonewline" flag: for now anyway) } } if {!$diffRC && $g(is3way)} { # Apparently we EXPECTED to do a 3way, but errors have prevented it! # DROP the 3way state, but ALLOW the 2way to continue (if it can) array unset finfo "a\[ptl]*,$pairnum"; # FORGET about Ancestor request alignDecor $pairnum ; # then RESET state/Decor from 3->2 do-show-Info ; # including room for Ancestral Markers popmsg "Attempted 3way Diff was cancelled\n (due to prior errors)" \ warning "Unable to Comply" } Dbg {Left ancestral datums: [llength $g(d3Left)]} Dbg {Right ancestral datums: [llength $g(d3Right)]} # Mark up the two text widgets and go to the first diff (if there is one). # Otherwise BLANK the combobox (in case it has old data from a PRIOR diff) if {$diffRC} {show-status "Marking differences..."} if {![mark-diffs]} { $w(combo) configure -commandstate disabled $w(combo) configure -value {} $w(combo) configure -commandstate normal if {"$Statmsg" == ""} { # Unless something FORCED us to not perform/complete the # diff, this HAS to be the reason there just ARE zero hunks! # BUT - dont lie - if there are SUPPRESSED hunks # then it really only APPEARS this way if {$g(COUNT) > $g(count)} { set Statmsg "Files now APPEAR as identical" } { set Statmsg "Files are identical" } } eval after idle {show-status "{$Statmsg}"} } else { move first 0 1 } # NEEDED update-display should be handled by caller } ############################################################################### # Convert "Unified" hunk format into "Normal" format (if that is what exists) # (Caveat: MAY alternately BE in "Normal" format: just w/leading COMMENT lines) ############################################################################### proc deUnify { Var } { upvar $Var var # REWRITE the data as Diff "Normal" IFF currently "Unified" set Uhdr -1 ; # Ignore EVERY line until 1st 'Unified' hunk header found set Nhdr -1 ; # Ignore EVERY line until 1st 'Normal' hunk header found set typ {} ; # Ignore context lines until a (+/-) marked line found foreach ln $var { # Diff "Normal" fmt is ordinarily IDENTIFY'd by its header on LINE#1 # But we needed to allow 'prelude' lines (for debugging reasons) # -- NOT UNLIKE Unified 'file-header' lines -- # SO if THATs what this IS, just swallow THOSE and REWRITE # everything else VERBATIM (incl. this FIRST 'Normal' header) # (N.B> logic test simply locks IN-or-OUT which REWRITE is being done!) if {$Uhdr < 0 && ($Nhdr > 0 || [string match {[0-9]*[acd][0-9]*} [lindex $ln 0]])} { # Rewrite line list: ONCE! ('foreach' keeps READING the original) # Also stops flushing ALL 'Normal' file-prelude lines if {$Nhdr < 0} { set Nhdr [llength [set var [list]]] } lappend var $ln continue } # Find a Unified hunk header (if found 1st, will LOCKOUT above code) if {[string match {@@ * * @@*} $ln]} { # Extract line numbers/counts per this 'Unified' hunk header regexp {@@ -([0-9]*)(,([0-9]*))?(?: \+)([0-9]*)(,([0-9]*))?.*} $ln\ matchvar L na Lc R na Rc if {$Lc=={}} { set Lc 1 } ; if {$Rc=={}} { set Rc 1 } # Rewrite line list: ONCE! ('foreach' keeps READING the original) # Also stops flushing ALL 'Unified' file-header lines if {$Uhdr < 0} { set Uhdr [llength [set var [list]]] } } { # Skip 'context'/'identical' lines (but decrement from counts) # (or just categorically skip ALL the fileheader nonsense) if {[set mrk [string index $ln 0]]==" " && $Uhdr >= 0} { # But if any REAL lines INTERVENED, make THOSE a 'Normal' hunk if {$typ != {}} { set Rsiz [expr [llength $var] - $Uhdr - $ofst] set hdr [expr {$typ=="a" ? $L-1:$L}] if {$ofst>1} {append hdr "," [expr $L+$ofst-1]} append hdr $typ [expr {$typ=="d" ? $R-1:$R}] if {$Rsiz>1} {append hdr "," [expr $R+$Rsiz-1]} set var [linsert $var $Uhdr $hdr] incr L $ofst ; incr R $Rsiz ; set typ {} } incr L ; incr Lc -1 ; incr R ; incr Rc -1 ; continue } elseif {$Uhdr < 0} { continue } # Found a marked line to post; Perhaps begin a NEW 'Normal' hunk ? if {$typ=={}} { set Uhdr [llength $var] ; set ofst 0 } # Assign WHERE the (+/-) line goes (and detect overall hunk type) switch -- "$mrk" { "+" { if {$typ=="c" || $typ=="d"} { set typ "c" } { set typ "a" } lappend var [string repl $ln 0 0 ">"] incr Rc -1 } "-" { if {$typ=="c" || $typ=="a"} { set typ "c" } { set typ "d" } set var [linsert $var $Uhdr+$ofst [string repl $ln 0 0 "<"]] incr Lc -1 incr ofst }} # If both 'Unified' counts hit zero HERE, install final 'Normal' # header (only NEEDED when current (+/-) line has NO trailing # context BECAUSE it was the LAST PHYSICAL LINE of ENTIRE FILE) if {!($Lc+$Rc) && $typ!={}} { # Assemble VERY LAST "Normal" hdr set Rsiz [expr [llength $var] - $Uhdr - $ofst] set hdr [expr {$typ=="a" ? $L-1:$L}] if {$ofst>1} {append hdr "," [expr $L+$ofst-1]} append hdr $typ [expr {$typ=="d" ? $R-1:$R}] if {$Rsiz>1} {append hdr "," [expr $R+$Rsiz-1]} # (can ignore any POST-hdr numbering fixups - unneeded) set var [linsert $var $Uhdr $hdr"] incr L $ofst ; incr R $Rsiz ; set typ {} } } } } ############################################################################### # Set the X cursor to "watch" for a window and all of its descendants. # # An optional msg 'WHY' will post to the status area (when BOTH exist); if the # '.status' window DOESN'T exist yet, one **MAY** be temporarily built, and the # reason posted there, PROVIDED it takes longer than a specifiable delay(in ms) # to REACH the code that can cancel the need (ie- the message is only IMPORTANT # if the GUI isn't inplace yet AND the action we elected to be BUSY about takes # randomly longer than someone can withstand waiting for feedback: # Prime example: hung networks or simply unpredictable latency. ############################################################################### proc watch-cursor {{WHY {}} {delay 1250}} { global g w ASYNc # Cant 'busy' out windows that arent't there yet ... if {[winfo exists w(client)]} { . configure -cursor watch $w(client) configure -cursor watch $w(toolbar) configure -cursor watch $w(menubar) configure -cursor watch if {$WHY != {}} {show-status "$WHY"} update idletasks # ... but if we gave a REASON WHY - someone should see THAT reasonably soon } elseif {$WHY != {}} { # Thus we want to REQUEST a status window be built after a short delay; # HOWEVER if we can complete the "busy" task and get back in time to # CANCEL the request, the user need NEVER see it -BUT- that means # changing to ASYNC processing for any external tasks we might spawn or # we will NEVER see the timer fire (it needs a running event loop). # This temp Status window IS removed @pgm exit (on failures), OR as # soon as we replace it with the main GUI (eg. success). Once built, # future Busy/Unbusy pairs simply USE whatever status window exists. if {![winfo exists .status]} { # So post the timer, SAVING its ID in a global whose EXISTENCE # will be used as a flag, so 'run-command' operates in ASYNC mode. # (N.B> but only the first one to get here can actually post) if {![info exists ASYNc(trigger)]} { set ASYNc(trigger) [after $delay need-status "{$WHY}"] Dbg "Posted ASYNc(trigger)($ASYNc(trigger))" } } else { show-status "$WHY" } update idletasks } } ############################################################################### # Give the user SOMETHING to look at while they wait # # N.B> if processing hangs, clicking the window 'exit' decoration will kill pgm ############################################################################### proc need-status {WHY} { global g w set w(status) .status build-status pack $w(status) -side bottom -fill x -expand n wm deiconify . # N.B> Protocol only works IFF event loop is RUNNING (to see 'after' event) show-status $WHY update idletasks } ############################################################################### # Restore the X cursor for a window and all of its descendants. ############################################################################### proc restore-cursor {} { global w ASYNc if {[winfo exists w(client)]} { . configure -cursor {} $w(client) configure -cursor {} $w(toolbar) configure -cursor {} $w(menubar) configure -cursor {} show-status "" update idletasks } elseif {[info exists ASYNc(trigger)]} { # If got here in time ... cancel setting up the status window # Regardless, reset to synchronous IO -- future attempts will either # REMAIN synchronous (w/existing Status window), or retrigger ASYNc if {![winfo exists .status]} { after cancel $ASYNc(trigger) Dbg "Cancelled ASYNc(trigger)($ASYNc(trigger))" } unset ASYNc(trigger) } } ############################################################################### # Check if error was thrown by us or unexpected ############################################################################### proc check-error {result output} { global errorInfo if {$result && $output != "Fatal"} { error $result $errorInfo } } ############################################################################### # Recalc current diff (and optionally ALIGN) the semantic [preference] reason # Attempt to return to the same diff region, numerically speaking. # (used to force a redo when a changed semantic could AFFECT the Diff result) ############################################################################### proc reCalcD {reason {RevAlgn {}}} { global g tmpopts opts finfo # Optionally permits REVERSE-aligning the preference setting # N.B> used in odd situation where invoked by MENU instead of Pref Dialog # Prevents DIALOG from REACTING to anything CHANGED.... # # ...doing tmpopts/opts assignments in the REVERSE ORDER nullifies # many NORMAL "validation" operations by effectively triggering on # the TRAILING EDGE (when making them IDENTICAL) instead of the # LEADING EDGE (when they first DIVERGE). Its all about which Var is # PHYSICALLY being watched (ie. tmpopts within the Dialog). if {$RevAlgn eq "RevAlgn"} { set tmpopts($reason) $opts($reason) if {$reason=="ignSuprs"} { set tmpopts(diffcmd) [set opts(diffcmd) [formOpts egnCmd]] } } # Just go DO the Diff set ndx(1) [set ndx(2) [expr {$finfo(fCurpair) * 2}]] incr ndx(1) -1 #N.B> Silently ignored IFF subject data is missing (SCM untried or failed) if {$finfo(pth,$ndx(1)) != {} && $finfo(pth,$ndx(2)) != {}} { Dbg "Forcing recompute via $reason pref change" set current $g(pos) do-diff move $current 0 1 centerCDR } } ############################################################################### # Wipe most everything (data plus widget content), then kick off a rediff ############################################################################### proc do-diff {} { global g tmpopts opts wipe-window watch-cursor update idletasks # If we are HERE and there is a DEFERRED Diff pending, its clearly time # to STOP deferring - in fact, that deferral REASON should now become # "Apply"d (as the user was SUPPOSED to have done before now). This ensures # the RESULTS of the Diff AGREE with the settings CURRENTLY provided. if {[info exists g(deferD)]} { foreach key $g(deferD) { set opts($key) $tmpopts($key) } unset g(deferD) ;# Then Cancel any PENDING redo (see prefapply) } set result [catch { rediff } output] check-error $result $output if {$g(mergefileset)} { do-show-merge 1 } restore-cursor } ############################################################################### # start a new diff from the popup dialog ############################################################################### proc do-new-diff {} { global g finfo # Unlock the PRESENT mergefile settings (but leave name for now), then ... # Pop up the dialog to collect the args and form them together # into a command - bailing out if dialog cancels or args is malformed set g(mergefileset) 0 if {![newDiff] || ![assemble-args]} return # make new file args available then do the diff multiFile reload do-diff move first 1 1 update-display } ############################################################### # Convert from hunk-index # a 1-based monotonic difference position (called a hunk) # to hunk-id # a diff-encoded (nnn[acd]mmm) descriptive format ############################################################### proc hunk-id { ndx {lst diff}} { global g # lst: 'DIFF' (superset diffs) has ALL hunks (inclds IGNORED) # 'diff' (subset diffs) has only REAL hunks # Both lists expect to NOT have a *dummy* index-0 element lindex $g($lst) [incr ndx -1] } ############################################################### # Convert from hunk-id # a diff-encoded (nnn[acd]mmm) descriptive format # to hunk-ndx # a 1-based monotonic difference position (called a hunk) ############################################################### proc hunk-ndx { id {lst diff}} { global g # lst: 'DIFF' (superset diffs) has ALL hunks (inclds IGNORED) # 'diff' (subset diffs) has only REAL hunks # Both lists expect to NOT have a *dummy* index-0 element expr { 1 + [lsearch -exact $g($lst) $id] } } ############################################################################### # Get things going... ############################################################################### proc main {} { global g w opts finfo ASYNc startupError errorInfo tk_version wm protocol . WM_DELETE_WINDOW do-exit wm title . "$g(name) $g(version)" wm iconphoto . -default deltaGif if {$w(wSys) == "x11"} { # All this nonsense is necessary to use an icon bitmap that's # not in a separate file. toplevel .icw if {[string first "color" [winfo visual .]] >= 0} { label .icw.l -image deltaGif } else { label .icw.l -image delta48 } pack .icw.l bind .icw "wm deiconify ." wm iconwindow . .icw if {![get_gtk_params]} { Dbg "Default x11 (fallback) options established" set hlbg "#4a6984" set hlfg "#ffffff" option add *Menu.selectColor $w(fgnd) option add *Checkbutton.selectColor "" option add *Radiobutton.selectColor "" } } if {($w(wSys) == "aqua") && ($tk_version < 8.6)} { get_aqua_params } # Ordinarily the CWD points at/under the TOPMOST Vpath node (IFF they exist) # But *IFF* located deeper, use that position to TOP-prune the lead elements # (allows user to review "versions" earlier than the most recent two # WITHOUT having to explicitly modify the VPATH EnvVar itself) if {[info exists finfo(Vpath)]} { if {[set finfo(Vpofst) [is-vpath "."]]} { set finfo(Vpath) [lrange $finfo(Vpath) [incr finfo(Vpofst) -1] end] # Further, adjust EACH Vpath NODE to designate itself as within any # SUBDIRs implied by CWD being farther than the stated VPATH edge set len [string length [lindex $finfo(Vpath) [set i 0]]] if {[set subdir [string range [pwd] $len end]] != {}} { foreach node $finfo(Vpath) { lset finfo(Vpath) $i "${node}$subdir" ; incr i } } } Dbg {Current (pruned($finfo(Vpofst))) EFFECTIVE\ Vpath\n\t[join $finfo(Vpath) "\n\t"]} } # Begin by interpolating command args # # 'CmdLn' may EXIT if args are INCORRECT/INVALID, or pass # control to 'newDiff' if simply missing; EITHER of which will, # in turn, invoke 'assemble-args' to OBTAIN the first (or only) # pairing of actual files to DIFF. If MULTIPLE pairs resulted from # that proc, SUBSEQUENT pairings will be chooseable via the GUI. # Insufficient pairings results in a "Retry" or an "Abort" based on # having USED 'newDiff' or 'CmdLn' respectively, AND further # conditioned on having encountered a HARD error (.vs. a warning). # # N.B> newDiff must KNOW if CLIENT windows exist: provide NAME for checking set w(client) .client ;# (to be built shortly by 'create-display' below) if {[CmdLn] > 0 || [newDiff]} { while {[set rcod [assemble-args]] < 2} { # REMOVING this clause provides NewDiff as a FAILED-CmdLn retry) if {$rcod > 0 && ![winfo exists .newDiff]} { fatal-error "Insufficient usable input"} if {![newDiff]} {do-exit} } } else {do-exit} # The ONLY WAY this exists is if 'assemble-args' was forced # to warn about delayed SCM access time - get rid of it # (and any lingering ASYNC processing condition) if {[info exists w(status)]} { wm forget $w(status) unset -nocomplain ASYNc(trigger) Dbg "ASYNC mode has been dropped" } set g(startPhase) 1 create-display # Evaluate any custom code the user MAY have provided if { [string trim $opts(customCode)] != {}} { Dbg "Custom code IS in use...beware" if {[catch [list uplevel \#0 $opts(customCode)] error]} { set startupError "Error in custom code: \n\n$error" } } # Populate the multiFile list with any OTHER file pairs-in-waiting multiFile reload # Finally DRAIN anything still pending in the eventloop update do-diff update-display # kick the HORIZONTAL scroll in the main windows # (VERTICAL already happenned by now, which only MAY have induced this) hscroll-sync 1 0 hscroll-sync 2 0 wm deiconify . update idletasks if {[info exists startupError]} { popmsg $startupError warning "Error in Startup File" } } ############################################################################### # Erase tmp files (if necessary) and destroy the application. ############################################################################### proc del-tmp {} { global g foreach f $g(tempfiles) { file delete $f } } ############################################################################### # Put up a window with formatted text ############################################################################### proc do-text-info {win title text} { global g w opts if {![Dialog NONMODAL $win]} { wm title $win "$g(name) Help - $title" wm transient $win . wm group $win . # we could leave this off (its what TK would do anyway) but... wm protocol $win WM_DELETE_WINDOW "destroy $win" set width 64 set height 32 # grid the button BEFORE its sibling frame # (thus making it LOWER/LATER in the stacking/clipping order) # N.B> Note that the Dismiss button is NOT using a 'ctrlvar' setting # (see explanantion at Bottom of this proc) grid [button $win.done -text Dismiss -command "destroy $win"] \ -row 1 -column 0 -sticky se -pady 5 -padx 5 grid [frame $win.f -bd 2 -relief sunken] -row 0 -column 0 -sticky news grid rowconfigure $win 0 -weight 1 grid columnconfigure $win 0 -weight 1 text $win.f.title -height 2 -width 50 -wrap word -bg white -fg black \ -highlightthickness 0 -bd 0 # Convenience Help info # HOWEVER - this Dialog instance MAY be being built BEFORE the MAIN # client windows FROM WHICH we want to steal its Fg/Bg colors... # Perhaps there's a more elegant way to DO this, but create a DUMMY # window we can suck the client PREFs into, to then steal from IT!! if {![winfo exists $w(client)]} { set w(acTxWdg) [text $win.dummy {*}$opts(textopt)] } text $win.f.text -setgrid 1 -width $width -height $height -wrap word \ -yscroll [list $win.f.vsb set] -padx 20 -highlightthickness 0 \ -bd 0 -bg [$w(acTxWdg) cget -bg] -fg [$w(acTxWdg) cget -fg] # (just remember to cleanup the dummy window afterward) # N.B> w(acTxWdg) *WILL BE* the subject of a trace ... just not YET!!! if {![winfo exists $w(client)]} { destroy $w(acTxWdg) } scrollbar $win.f.vsb -orient vertical -command "$win.f.text yview" -bd 1 pack $win.f.vsb -side right -fill y -expand n pack $win.f.title -side top -fill x -expand n pack $win.f.text -side left -fill both -expand y if {$g(debug)} { # Silly idea - writing the raw help text out for printing ... # (make the button hide in plain sight); ??convert to manpage?? button $win.write -text {} -relief flat -takefocus 0 -command \ "set pth \[tk_getSaveFile -parent $win.f.text -initialdir {.}] if {\$pth != {}} { puts \[set pth \[open \$pth w]] {$title\n$text} close \$pth}" grid $win.write -row 1 -column 0 -sticky sw -pady 5 -padx 5 } put-text $win.f.title "$title" put-text $win.f.text $text $win.f.title configure -state disabled $win.f.text configure -state disabled update idletasks # Only how big - NOT where to put it! wm geometry $win ${width}x${height} } Dialog show $win } ############################################################################### # centers window 'win' over parent ############################################################################### proc centerWindow {win {size {}} {persist 0}} { update set parent . # Last two optional args are permitted to be in EITHER order # AND can be distinguished by their CONTENT - not just their sequence # (Rearrange them if they were specifed in backward order) if {[llength $size] == 1} { set x $persist ; set persist $size ; set size $x } # What follows here has to do with WHEN the centering was being requested # AND what data might NOT be particularly reliable (such as the dimensions # of the window BEING centered -OR- the parent being centered ON: # 'size' = empty (normal) says: use the data of the windows themselves # = 2 values: use these AS the size of the window TO center # = 4 values: as for =2, but use 3&4 as the PARENT dimensions # Note that if WxH of 'win' has been GIVEN as (0 0) (from either syntax) # that is the same as requesting that the window itself provide its size if {[llength $size] > 1} { lassign [concat $size 0 0] wWidth wHeight pWidth pHeight } if {[llength $size] < 4} { set pWidth [winfo reqwidth $parent] set pHeight [winfo reqheight $parent] } if {[llength $size] < 2 || ($wWidth==0 && $wHeight==0)} { set wWidth [winfo reqwidth $win] set wHeight [winfo reqheight $win] } Dbg {centering(${wWidth}x$wHeight) onto parent(${pWidth}x$pHeight)} # get on with the centering set pX [winfo rootx $parent] set pY [winfo rooty $parent] set centerX [expr {$pX +($pWidth / 2)}] set centerY [expr {$pY +($pHeight / 2)}] set x [expr {$centerX -($wWidth / 2)}] set y [expr {$centerY -($wHeight / 2)}] # Can NEVER set WxH in PIXELS if window is GRIDDED !! Only the location if {[llength $size] > 0 && [wm grid $win]=={}} { wm geometry $win [set ctr "=${wWidth}x${wHeight}+${x}+${y}"] } { wm geometry $win [set ctr "=+${x}+${y}"] } Dbg {Centering has targeted at $ctr above parent @($pX,$pY)} # OK - if I understand this correctly, the geometry request will not ONLY # make the window respond as asked, but will be RETAINED by the window # even THROUGH a 'withdraw'/'deiconify' cycle, thereby REINSTATING that # position - even if the user happenned to drag the window elsewhere AFTER # it had been first displayed as 'centered' (often as a convenience). # But OUR moving the window involves a event, which is WHY: update # has been provided (to LET that event happen). Thus after that completes # and presuming we were not told (via 'persist') to LEAVE it that way, # schedule a near future request to REMOVE that geometry setting, allowing # the window to revert to TRACKing any interactive USER-MADE adjustments. if {!$persist} { after idle wm geometry $win {} } } ############################################################################### # Tcl V8->V9 has different semantics concerning TILDE as 1st letter of filename # V8 treats ~ as $HOME (throwing [undocumented] error if $env(HOME) unset) # ~xxx as USER xxx's $HOME (throwing error if user is unknown) # all perfomed IMPLICITLY by 'glob' and *MOST* 'file' commands # (notably NOT for 'file exists' despite ~xxx expansion being attempted) # Apparent Logic is dependent on IFF file must exist to perform operation # Thus 'isdirectory' and 'isfile' also APPEAR as error-free # # V9 treats ~ as a conventional character everywhere BY DEFAULT, BUT - # provides an explicit 'file tildeexpand' cmd to essentialy MAP $name # returning it (unchanged when no lead tilde is present) but throw # errors just as V8 did (although V9 DOCUMENTS *both* reasons) # # This Proc isolates the V8/V9 transition, and supports BOTH semantics # but with a PREFERENCE of tilde-notation over that of tilde-as-a-lead-char # # N.B> Despite GLOB use internally (implicit for V8, explicit for V9), ACTUAL # NAMES are never returned (via canon); only a tilde-notation FREE form # of the original input name (glob-syntax and all). HOWEVER 'result' WILL # contain the COUNT of names that WILL BE produced (0->N) when the caller # passes 'canon' INTO a V8/V9 glob which WILL NOT fault! # # For TkDiff, TOO MANY names (>1) is pointless and is LOGICALLY the same as (0). ############################################################################### proc tildChk {fnam result canon} { global tcl_version upvar $result resptr $canon canptr ;# point OUR locals AT callers Vars # INITIALIZATIONS: set D -1 ;# Local master-Dbg authorizer (in case parse issues arise later) # Presume V8 will NOT find a literal-tilde usage (until proven otherwise) set V8plainT 0 # Isolate first fragment from ANY subsequent GLOB syntax set f1 [lindex [set frags [file split $fnam]] 0] Dbg {SPLIT frags($frags) INITIALIZATION} $D "tildChk: " # CALLER is responsible for which returned values (RetCode/result/canon) # are of logical importance within ITS specific CALLING situation # Original V8 check produced 3 possible 'result' value sets (w/o errs): # 0 - fnam doesnt exist w/RetCod=0 # 1 - fnam does exist w/RetCod=0 # FailMsg - tilde conversion failed (no such user) w/Retcod=1 # V9 adds an ADDITIONAL output datum (canon) to those sets: # 0 - defaulted as fnam CLONE w/Retcod=1 # 1 - canonical form of converted fnam w/Retcod=0 # FailMsg - tilde conversion failed (no user/home) w/Retcod=1 # # User EXPECTED to prefix initial fnam with './' to PREVENT tildeexpand, # although code ATTEMPTS such evaluation if tildeexpand was IMPOSSIBLE if {($tcl_version >= 9.0) && ("~" == [string index $fnam 0])} { # Perform tilde expansion on JUST 1st frag, OR (if that fails) # a DIRECT filename search, again on only that 1st fragment if {![set Err [catch {file tildeexpand $f1} newf1]] || [llength [set nms [glob -n $f1]]]} { # If Err non-zero HERE, there IS a CWD-relative LITERAL tilde name # (of which there MUST be only a SINGLE name via the V9 GLOB) # TWO possible ways to success: if {$Err && [llength $nms] == 1} { # reassemble fnam w/FOUND literal tilde as 1st frag, THEN ... set fnam [file join $nms {*}[lrange $frags 1 end]] } elseif {!$Err} { # reassemble fnam using tilde EXPANDED 1st fragment, THEN ... set fnam [file join $newf1 {*}[lrange $frags 1 end]] } else { # failed: expansion was IMPOSSIBLE (AND found no LITERAL tilde) set resptr $newf1; # shove msg where it belongs set canptr $fnam; # has NO canonical form BEYOND itself: clone return $Err; # tell caller theres a DEFINITE problem } # ...EXIT via GLOB code below as it'll GLOB from PROPER (HOME/CWD) # (N.B> catch is superfluous as V9 GLOB has no reason to fault) } else { # failed: expansion was IMPOSSIBLE (AND found no LITERAL tilde) set resptr $newf1; # shove msg where it belongs set canptr $fnam; # has NO canonical form BEYOND itself: clone return $Err; # tell caller theres a DEFINITE problem } # replicate default V9 semantic tildeexpand behavior as PREPARATION for V8 # (eg. PRESUME it has NO canonical form BEYOND itself: clone it) # N.B> BUT return 'EXISTS' & '!Err' when *NO* INPUT name was provided!! } elseif {[set resptr [expr {[string index [set canptr $fnam] 0] == {}}]]} { return 0 ;# an EMPTY filename MUSTN'T infer the CWD: as next GLOB would! } elseif {$tcl_version >= 9.0} { set newf1 [glob -n $f1] Dbg {Default V9 1st Frag newf1($newf1) to later update canon} \ $D " + + + : " } # (N.B> V8/V9 BOTH rely on GLOB to provide filesystem EXISTENCE of result) # yet REQUIREs catch as V8 glob w/tilde can FAIL (on '~' or '~userid') # However, V8 THEN gets a 2nd try by SUBVERTING any lead-tilde (if present) # (N.B> V9 CANT RAISE an error as its GLOB wont treat tildes special) if {![set Err [catch {llength [glob -n $fnam ]} resptr]] || ($tcl_version < 9.0 && [set V8plainT [llength [glob -n "./$fnam"]]])} { # (above checks for POSSIBILITY of a V8 plain-tilde filesystem NAME if {$tcl_version < 9.0} { if {$Err} {set newf1 [glob -n "./$f1"]} {set newf1 [glob -n $f1]} Dbg {Default V8 1st Frag newf1($newf1) to later update canon} \ $D " + + + : " } # INFER the WORKING tilde-notation is PREFERd over a literal-tilde NAME # 'V8plainT' is ONLY true when (V8 Err==1 + resptr w/msg) - allowing # overriding BOTH in FAVOR of a FOUND literal-tilde NAME! if {$V8plainT} { set Err 0 ; set resptr $V8plainT } } # Update 'canon': # NORMALLY when 'resptr' is false, 'canon' could just REMAIN the default # CLONE of 'fnam' -- but that could MISS the CONVERTED (!Err) tilde, # simply because of GLOB notation ultimately failing to match anything! if {!$Err} { # Provide at least the GOOD TILDE so caller doesn't TRIP over it ... set canptr [file join $newf1 {*}[lrange $frags 1 end]] Dbg {REWROTE result($resptr) CANON($canptr) w/NEW 1st frag($newf1)} \ $D "tildChk: " } return $Err } ############################################################################### # The "New Diff" dialog # In order to be able to enter only one filename if it's a revision-controlled # file, the dialog now simply collects the arguments and sends them through the # SAME argument analyzer used by the command line parser. ############################################################################### proc newDiff {} { global g w finfo opts pref # Snapshot the current state of the primary INPUT variables into a global # location (so that the 'Cancel' button callback can find/restore them) # N.B> only preserves FINFO data (sadly, OTHER chgs will remain active) set g(NDpriorVals) [array get finfo {[fr]*[0-2]}] # Special case: on a SUBSEQUENT invocation, verify that the dialog IS # designated AS 'transient' (which it would NOT have been # if it was the FIRST window to be created. This MUST be # done while the window is "withdrawn" BEFORE redisplaying. if {[winfo exists [set w(newDiff) .newDiff]] && [wm transient $w(newDiff)] == ""} { wm transient $w(newDiff) . } if {![Dialog MODAL $w(newDiff)]} { wm title $w(newDiff) "New Diff $g(name) $g(version)" wm group $w(newDiff) . wm protocol $w(newDiff) WM_DELETE_WINDOW { set w(NewDok) 0 } # CAN't start as the FIRST window on Windows if it's made 'transient' # N.B> This is the CAUSE of the above "Special case" adjustment if {[winfo exists .client]} { wm transient $w(newDiff) . } set fSpec [frame $w(newDiff).fSpec -borderwidth 2 -relief groove] # N.B> Widget name derivation is constrained by various callbacks... # - 'newDiffBrowse' uses the LAST letter of their pathname to # implement a 'shared directory path' protocol among the TWO # main entry widgets 'e1' and 'e2'; a NON-digit last-char # AVOIDS the protocol, but WILL work for the Ancestor usage # - TWO main label widgets 'l1' and 'l2' reflect when associated # ENTRY widget refers to a Non URL/existant-filesystem entity # - Revision labels reflect when their ENTRY is non-null # - SCM lists dynamically derive from the Entry values, and then # further determines and SETs searchability. # Thus 'scm-updat' callback knows WAY TO MUCH about almost everything # Be Carefull!! label $fSpec.l1 -text "FSpec 1:" entry $fSpec.e1 -vcmd {scm-updat scm1 %W %P [string length %s]} \ -textvariable finfo(f,1) entry $fSpec.er1 -textvariable finfo(rev,1) \ -vcmd "verify occupancy [label $fSpec.lr1 -text "-r"] %P" label $fSpec.l2 -text "FSpec 2:" entry $fSpec.e2 -vcmd {scm-updat scm2 %W %P [string length %s]} \ -textvariable finfo(f,2) entry $fSpec.er2 -textvariable finfo(rev,2) -validate key \ -vcmd "verify occupancy [label $fSpec.lr2 -text "-r"] %P" $fSpec.er1 configure -validate key;# allow validation AFTER .er2 exists $fSpec.er1 validate $fSpec.er2 validate label $fSpec.lA -text "Ancestor:" entry $fSpec.eA -vcmd {scm-updat ancstr %W %P [string length %s]} \ -textvariable finfo(f,0) entry $fSpec.erA -textvariable finfo(rev,0) -validate key \ -vcmd "verify occupancy [label $fSpec.lrA -text "-r"] %P" $fSpec.erA validate set mrgopt [frame $fSpec.f4] ;# pre-pack all this label $mrgopt.l4 -text "$pref(predomMrg):" -anchor w radiobutton $mrgopt.r1 -variable opts(predomMrg) -text Left -value 1 radiobutton $mrgopt.r2 -variable opts(predomMrg) -text Right -value 2 pack $mrgopt.l4 $mrgopt.r1 $mrgopt.r2 -side left -pady 6 # Now create the SCM comboboxes + 'labels' (tying them to the entry box) ::combobox::combobox $fSpec.scm1 -editable 0 -listvar finfo(scm1) \ -width 10 -command "scm-updat srch" ::combobox::combobox $fSpec.scm2 -editable 0 -listvar finfo(scm2) \ -width 10 -command "scm-updat srch" checkbutton $fSpec.scm1lbl -offrelief flat -onvalue 1 \ -command "scm-updat set $fSpec.scm1lbl 1" checkbutton $fSpec.scm2lbl -offrelief flat -onvalue 2 \ -command "scm-updat set $fSpec.scm2lbl 2" $fSpec.e1 configure -validate key $fSpec.e2 configure -validate key $fSpec.eA configure -validate key # We need the Browser buttons to fit the COMBINED height of BOTH the # filename entry and revision fields, so pre-pack it into a subframe set Brws1 [labelframe $fSpec.fB1 -text "Browse..."] button $Brws1.bf -borderwidth 1 -highlightthickness 1 -image \ txtfImg -command [list newDiffBrowse "File" $fSpec.e1] button $Brws1.bd -borderwidth 1 -highlightthickness 1 -image \ fldrImg -command [list newDiffBrowse "Directory" $fSpec.e1] pack $Brws1.bf -padx {7 0} -pady {0 2} -side left pack $Brws1.bd -padx {0 7} -pady {0 2} -side right set_tooltips $Brws1.bf {"to a file"} set_tooltips $Brws1.bd {"to a directory"} set Brws2 [labelframe $fSpec.fB2 -text "Browse..."] button $Brws2.bf -borderwidth 1 -highlightthickness 1 -image \ txtfImg -command [list newDiffBrowse "File" $fSpec.e2] button $Brws2.bd -borderwidth 1 -highlightthickness 1 -image \ fldrImg -command [list newDiffBrowse "Directory" $fSpec.e2] pack $Brws2.bf -padx {7 0} -pady {0 2} -side left pack $Brws2.bd -padx {0 7} -pady {0 2} -side right set_tooltips $Brws2.bf {"to a file"} set_tooltips $Brws2.bd {"to a directory"} set Brws3 [labelframe $fSpec.fB3 -text "Browse..."] button $Brws3.bf -borderwidth 1 -highlightthickness 1 \ -image txtfImg \ -command [list newDiffBrowse "File" $fSpec.eA "Ancestor"] pack $Brws3.bf -side top set_tooltips $Brws3.bf {"to a file"} checkbutton $fSpec.b -variable finfo(fRecurs) -text Directory\nRecurse\ -selectcolor $opts(inform) -indicator 0 # we'll use the grid geometry manager to get things lined up right... grid $fSpec.l1 -sticky e -row 0 -column 0 grid $fSpec.e1 -columnspan 4 -pady 4 -sticky nsew -row 0 -column 1 grid $fSpec.scm1lbl -sticky e -row 1 -column 0 grid $fSpec.scm1 -sticky e -row 1 -column 1 grid $fSpec.lr1 -padx {5 0} -row 1 -column 2 grid $fSpec.er1 -row 1 -column 3 grid $Brws1 -rowspan 2 -padx 4 -pady 4 -sticky nsew -row 0 -column 5 grid $fSpec.l2 -sticky e -row 2 -column 0 grid $fSpec.e2 -columnspan 4 -pady {8 4} -sticky nsew -row 2 -column 1 grid $fSpec.scm2lbl -sticky e -row 3 -column 0 grid $fSpec.scm2 -sticky e -row 3 -column 1 grid $fSpec.lr2 -padx {5 0} -row 3 -column 2 grid $fSpec.er2 -row 3 -column 3 grid $Brws2 -rowspan 2 -padx 4 -pady 4 -sticky nsew -row 2 -column 5 # N.B> Padding Ancestor label reserves spacing for scm(N)lbl checkboxes grid $fSpec.lA -padx {12 0} -sticky e -row 4 -column 0 grid $fSpec.eA -columnspan 4 -pady {8 4} -sticky nsew -row 4 -column 1 grid $fSpec.lrA -row 5 -column 2 grid $fSpec.erA -row 5 -column 3 grid $Brws3 -rowspan 2 -padx 4 -pady 4 -sticky nsew -row 4 -column 5 grid $fSpec.f4 -columnspan 4 -pady 4 -sticky w -row 6 -column 0 grid $fSpec.b -padx 4 -pady 4 -sticky nsew -row 6 -column 5 grid remove $fSpec.b ;# Start with Recurse button NOT displayed grid columnconfigure $fSpec 1 -weight 1 grid columnconfigure $fSpec 4 -weight 4 # Container for additional datums we rarely need set options [frame $w(newDiff).options -bd 2 -relief groove] button $options.more -text "More" -command "newDiffHdn $options opn" checkbutton $options.cflct -text "input is Conflict format" \ -var g(conflictset) label $options.ml -text "Merge Output" entry $options.me -textvariable g(mergefile) label $options.l1l -text "Label for File 1" entry $options.l1e -textvariable finfo(ulbl,1) label $options.l2l -text "Label for File 2" entry $options.l2e -textvariable finfo(ulbl,2) grid $options.more -column 0 -row 0 -sticky nw grid columnconfigure $options -0 -weight 0 # Container for local Help (also hidden until requested) # (activation will be from a PRIMARY Dialog button) set hlp [frame $w(newDiff).hlp -bd 2 -relief groove] # HOWEVER - this help subwindow MAY be being built BEFORE the MAIN # client windows FROM WHICH we plan to steal its Fg/Bg colors... # Perhaps there's a more elegant way to DO this, but create a DUMMY # window we can sieve the client PREFs thru, so we can steal from IT!! if {![winfo exists $w(client)]} { set w(acTxWdg) [text $hlp.dummy {*}$opts(textopt)] } text $hlp.txt -setgrid 1 -wrap word -highlightthickness 0 -height 10 \ -bg [$w(acTxWdg) cget -bg] -fg [$w(acTxWdg) cget -fg] \ -yscroll [list [set hlp.vsb [scrollbar $hlp.vsb -orient vertical \ -command "$hlp.txt yview" -bd 1]] set] -bd 0 # (just remember to cleanup the dummy window afterward) # N.B> w(acTxWdg) *WILL BE* the subject of a trace... just not YET !! if {![winfo exists $w(client)]} { destroy $w(acTxWdg) } # Form-up the help sub-frame with its textWin + scrollbar # then FILL the window with the pertinent Help info (& disable it) pack $hlp.vsb -side right -fill y -expand 0 -padx {0 2} -pady {0 2} pack $hlp.txt -side left -fill both -expand 1 -padx {2 0} -pady {0 2} grid columnconfigure $hlp -0 -weight 0 put-text $hlp.txt [help-GUI newDiff] $hlp.txt tag configure margn -lmargin1 5 -lmargin2 5 -rmargin 5 $hlp.txt tag add margn 1.0 end $hlp.txt configure -state disabled # Now the primary buttons for this dialog... set btns [frame $w(newDiff).buttons] button $btns.help -width 5 -text "Help" -command "newDiffHdn $hlp opH" button $btns.cancel -text "Cancel" -width 5 -default normal -command { if {! [winfo exists .client]} {do-exit} array set finfo $g(NDpriorVals) ;# restore start values newDiffHdn $w(newDiff).hlp clH set w(NewDok) 0 } button $btns.ok -text "Ok" -width 5 -default active -command { # SYNTAX BARRIER (blocks tilde+Glob for Tcl8->9 Chgd semantics) lassign "$finfo(FSpec1) $finfo(FSpec2) $finfo(FSpecA)" \ finfo(f,1) finfo(f,2) finfo(f,0) Dbg "OK FSpec1($finfo(f,1)) FSpec2($finfo(f,2)) FSpecA($finfo(f,0))" # CANT claim its a conflictfile if ISNT a file at all if {![file isfile $finfo(f,1)]} {set g(conflictset) 0} # Because of the call-semantics for 'assemble-args', ALL internal # Fspecs (f,0 f,1 & f,2) MUST NOT leave here w/VERSIONED URLs ... # (vrsn DATA was ALREADY diverted properly(?) elsewhere) # # BUG(?) SVN '@syntax+MEANING': is NOT what TkDiff BELIEVES it is # See 15Jun25 Dev-notes or read SVN DOCs about "PEG Revision" # (yet MAY NOT be truly PERTINENT as TkDiff only wants 2 files!!) foreach x "f,0 f,1 f,2" { # (A URL, w/@-syntax (date-OR-other), w/NO trailing slashs) if {[string match {*://*} $finfo($x)] \ && ( [set at [string last "@\{" $finfo($x)]] > 0 \ || ([set at [string last "@" $finfo($x)]] > 0 \ && [string first "/" $finfo($x) $at] < 0))} { # REMOVE the @-syntax from this Fspec set finfo($x) [string range $finfo($x) 0 $at-1] } } newDiffHdn $w(newDiff).hlp clH set w(NewDok) 1 } pack $btns.ok $btns.help $btns.cancel \ -side left -fill none -expand y -pady 4 # pack this crud in...(btns FIRST so resize wont clip them) pack $btns -side bottom -fill x -expand n pack $fSpec -side top -fill both -ipady 2 -ipadx 20 -padx 5 -pady 5 pack $options -side top -fill both -ipady 5 -ipadx 5 -padx 5 -pady 5 bind $w(newDiff) [list $btns.ok invoke] bind $w(newDiff) [list $btns.cancel invoke] } # initialize dialog set g(scmDOsrch) 0 ;# Begin from a non-search SCM state set g(scmPrefer) "$opts(scmPrefer)" ;# and w/default SCM preferences lassign {} FSpec1 FSpec2 FSpecA ;# ReStart as EMPTY (SAFE- ?Unneeded?) $w(newDiff).fSpec.e1 validate $w(newDiff).fSpec.e2 validate $w(newDiff).fSpec.eA validate set detectMrgFilChg $g(mergefile) ###### Dialog show $w(newDiff) w(NewDok) 0 $w(newDiff).fSpec.e1;# MODAL: wait here ###### Dialog dismiss $w(newDiff) # Only lock-in Mergefile if user CHANGED and ACCEPTED it if {$w(NewDok) && $g(mergefile) != "" } { set g(mergefileset) [expr {$g(mergefile) != $detectMrgFilChg}] } return $w(NewDok) } ############################################################################### # Specialized handler for dynamic SCM state/choice transitions within NewDiff # N.B> (knows ALOT about the NAMING/RELATIONS of the widgets it manipulates) # Args: subcmd - requested check/adjustment to be processed # wdg - widget making the request # val - proposed new value for widget (or value being monitored) # limit - optional value needed (eg. prev length, special flag, etc.) ############################################################################### proc scm-updat {subcmd wdg val {limit 0}} { global g w opts finfo # Init and/or invent some useful meta-pgming naming conversions set D -1 ;# Local master-Dbg authorizer (in case parse issues arise later) set Other([set Other(2) 1]) 2 ;# (a simple meta-pgm identity value) if {[string is digit [set ndx [string index $wdg end]]]} { # grab the instance number of widget (if any); then use it # to create meta-addressable names for PAIRED widgets set W($ndx) $wdg set W($Other($ndx)) [string replace $wdg end end $Other($ndx)] } # Overall this implements a 'ripple effect' starting from an 'entry' # validation to load a 'combobox' list of detected SCMs (whose value MAY # then be "searchable") to a checkbutton that ASKs for such searching. # Also each widget along the way can initiate its OWN ripple independently # N.B> ANCESTOR uses MUCH of this (skipping combobox-related parts) switch -glob $subcmd { "ancstr" - "scm\[12]" { # N.B> 'ndx' has values of 1,2 or A -- just be careful if {"$ndx" != "A"} { set scmbox [file rootname $wdg].$subcmd ;# matching SCM widget } ; set lWdg [file rootname $wdg].l$ndx ;# matching LBL widget # Always need to alert user about USING the 2nd entry widget # when the 1st is still empty -> highlight 2nd widget bkgnd. # (N.B> a complete NO-OP when $ndx is NOT 1 or 2) if {("$ndx"=="2" && "$val" != "" && ![$W(1) index end]) \ || ("$ndx"=="1" && "$val" == "" && [$W(2) index end])} { $W(2) configure -bg Tomato } elseif {$ndx in {1 2}} { $W(2) configure -bg [$W(1) cget -bg] } # (An exotic bit of actual state-machine name PARSING happens here) # 1. Leading tilde IMPLYS a file (over possibility of a URL) # 2. URLs become recognized once we can see ':/' in WIDGET-val # 3. Glob notation will be useful in filenames ONLY (not URLs) # # Thus, following only operates WHEN its BELIEVED to be a FILENAME # (N.B> when presence of ':/' has not yet been seen) # # BASICALLY, a FAIL'd Tilde notation IMPLYs a NONexistant fname BUT # when FOLLOWED by SLASH, NON-existance is then PERPETUAL! A FAIL'd # tilde warrants a msg and a Red hilite, w/EACH a reason to REJECT # the (perpetuating) SLASH; other chars should provisionally accept # w/yellow hilite, but NO hilite at ALL when $val PHYSICALLY exists! # (Clumsy V9 compat?) coding to GET a NL-prefix Dbg (commented-out) # (V9 claims mismanaged quotes where V8 was just fine) if {[string index $val 0] != ""} { Dbg "" $D "" } Dbg {VAL($val) LIMIT($limit)} $D "" ;# NO-prefix instead of below!! # [expr {[string index $val 0] != {} ? "\n" : ""}] if {[string index $val 0] == "~" || ![string match {*:/*} $val]} { set accept true ;# PRESUMEs added char in 'val' is acceptable set BkSpc [expr {[string length $val] < $limit}];# BkSpc'd ? # (N.B> tilde FAULTS if $env(HOME) UNSET or userID INVALID ... # FURTHER: 'val' MAY no longer reflect EXACT widget content!) # THUS - save a copy (orig) BEFORE it can be overwritten! if {[set Err [tildChk [set orig $val] fexist val]]} { # MUST report a LAST slash - it 'perp'etuates the failure # BUT - if NO SLASH exists, perp OBVIOUSLY tilde itself! if {[set i [string first "/" $val 1]] > 0 || ![set i 0]} { Dbg {updat($subcmd) BkSpc($BkSpc) Err($Err)\ TypPop$ndx@($w(TypPop$ndx@)) val($val)->BAD\ FSpec${ndx}($val)} $D "Pop:\t" if {$w(TypPop$ndx@) < $i} { popmsg \ "$fexist" ok [file rootname $wdg] "Erase/Re-enter ?" } set w(TypPop$ndx@) $i } set fexist 0; # failed conversion IMPLYS non-existance } { set w(TypPop$ndx@) -1 } # MAY have thrown err, but SOME PATH-fragment does not exist! # (could be the FIRST one if tildChk FAILED to convert) # HOWEVER - we NEED a position in ORIGINALLY specified context # thus we must walk THOSE fragments: NOT what tildChk returned! if {$fexist != 1} { # warn user (lbl-hilite), $val is NOT (yet?) a real entity, # Acceptance based on if/where a perpetuating SLASH IS... if {!$Err && !$fexist} { set LSlash [set i -1] ;# index of NEXT SLASH in PATH while {[set i [string first "/" $orig [incr i]]] >= 0} { set OV [string range $orig 0 $i] Dbg {i($i) LSlash($LSlash):([string range $orig \ 0 $LSlash]) orig($orig) OV($OV)} $D # (N.B> glob WILL NOT crash) if {[llength [glob -n $OV]]} { set LSlash $i } { break } } # Color Establishes SEVERITY of non-existence # Am simply in limbo - (yellow?) - hint we want more $lWdg configure -bg $opts(inform) } elseif {!$fexist} { set LSlash $limit ; # A tiny LIE: # (no SLASH exist?): Is IMPLIED by E-O-Line $lWdg configure -bg Tomato # EMPHASIZE (red) tilde-Err -or- (yellow) too many exist } { $lWdg configure -bg $opts(inform) } # BUT will REJECT(0) only when a Slash was TYPED # (not backspaced TO) BEYOND where non-exist became known # N.B> value 'i' DEPENDS on $Err: references NOT equivalent! if {!$fexist && !$BkSpc \ && "/" == [string index $orig [set i [$wdg index insert]]] \ && (($Err && $i >= $w(TypPop$ndx@)) || $i > $LSlash)} { set accept false } if {!$fexist} { Dbg {updat($subcmd) BkSpc($BkSpc)\ Err($Err) fexist($fexist) LSlash($LSlash)\ TypPop$ndx@($w(TypPop$ndx@)) val($val)->BAD\ Accept($accept)} $D "Res:\t" } # Yet STILL must tell SCM to UNSET (Re: fname is UNKNOWN) if {$subcmd != "ancstr" && [llength $finfo($subcmd)]} { after idle $scmbox configure -value \ "{[set finfo($subcmd) { }]}" } # N.B> User CAN ALWAYS backspace/re-enter to correct return $accept ; # Rejects when Slash perpetuates non-exist } } # Have a URL or REAL file entit(ies?) (ie. ?sequence-of? fragments) # (ensure typing-monitor hilit turns OFF) $lWdg configure -bg $w(bgnd) Dbg {updat($subcmd) BkSpc($BkSpc) Err($Err) fexist($fexist)\ TypPop$ndx@($w(TypPop$ndx@)) val($val)->LEGIT} $D "\t" # HOWEVER: # 'val' is either a URL or FILE entities (w/POSSIBLE Glob syntax) # OR empty. Provided such syntax WILL result in a SINGLE entity, # REPLACE any GLOB syntax by REWRITING 'val' with its expansion if {$val != "" && ![string match {*://*} $val] \ && $fexist == 1} { set val [glob -n $val] } # EntryBox contents EXISTS (or is empty) - recheck SCM choice status? # (N.B> Simply NOT when/where/how Ancestor finds its SCM) if {$subcmd != "ancstr"} { set finfo($subcmd) [scm-detect $val None] # SCMBOX command fires (by setting its value), further rippling # to set 'srch' state, only AFTER this validation callback ends set vote [lindex $opts(scmPrefer) $ndx-1] ; after idle \ $scmbox configure -value "{[scm-elect $finfo($subcmd) $vote]}" } # Finally, if that CONTENT happens to be a Rev-carrying URL we # need to lockout the USER from ITS Revision-widget. Sadly, TCL # wont *do* a "switch fallthru" case, so we will RECURSE to it! return [scm-updat lckR $wdg $val] ;# (Always returns TRUE) } "lckR" { set rWdg [file rootname $wdg].er$ndx ;# (gonna need Rev wdg) # Update PROPOSED FSpec value (to take effect when we LEAVE dialog) # (N.B> 'val' SHOULD no longer contain ANY Glob syntax !!) set finfo(FSpec$ndx) $val Dbg {updat($subcmd) BkSpc(_) Err(_) TypPop$ndx@($w(TypPop$ndx@))\ val($val)->LEGIT FSpec${ndx}($val)} $D "Lock:\t" # If the present Fspec value appears to be a URL of the # (admittedly, for NOW) Subversion syntactic variety... if {[string match {*://*} $val]} { # ...and CHOSE to specify a REVISION suffix ... if {[set at [string last "@\{" $path]] > 0 \ || ([set at [string last "@" $path]] > 0 && \ [string first "/" $path $at] < 0} { # ... PUSH that revision value into ITS widget and # PREVENT any user manipulation via that widget (LOCK it) # (N.B> cant DO in SAME config call - disable wins!) set [$rWdg cget -textvar] [string range $path $at+1 end] $rWdg configure -state disabled } { $rWdg configure -state normal } # else UNLOCK (and empty) it if WAS locked by above previously } elseif {[$rWdg cget -state]=="disabled"} { set [$rWdg cget -textvariable] "" ;# zap old URL-provided Rev $rWdg configure -state normal } return true ;# validation ALWAYS true: is (mostly) monitoring } "srch" { # (generally REACHED by cmd associated w/modifying SCMBOX widget) lset g(scmPrefer) $ndx-1 "$val" ;# Keep working global up-to-date # Cant search when ANY Fspec exists or a non-detected SCM if {[string trim $finfo(f,1)] != "" \ || [string trim $finfo(f,2)] != ""} { set wdg [string range $wdg 0 end-1] foreach lbl "1lbl 2lbl" { $wdg$lbl configure -text " SCM :" -indicatoron 0 $wdg$lbl deselect } # Only allow following ONCE, regardless of ACTUAL side touched # (N.B> this is NOT the 'limit' value seen in OTHER subcmds) if {$limit} { return } # If both Fspecs happen to be Directories (OR when the FIRST is # a Dir and the other is EMPTY), allow user to choose between a # recursive or single-level candidate srch evaluation - UNLESS # the Engine opts to support Dir/Dir dont actually exist set recursW [file rootname $wdg].b if {[file isdir $finfo(f,1)] && ([file isdir $finfo(f,2)] || ( "" == $finfo(f,2) && [lindex $g(scmPrefer) 0] in $g(scmS)))} { if {![winfo ismapped $recursW]} { grid $recursW } } { if { [winfo ismapped $recursW]} { grid remove $recursW } } alignState $recursW [expr {[string trim $opts(egnSrchCmd)]!={}}] # Otherwise srch is determined PER CHOSEN SCM for each Fspec } else { if {$val in $g(scmSrch)} { ${wdg}lbl configure -text "Search?" -indicatoron 1 } else { # Chosen SCM cant handle searching - remove option ${wdg}lbl configure -text " SCM :" -indicatoron 0 ${wdg}lbl deselect } # MAY need to reactivate OTHER side (if Fspec JUST went empty) # (N.B> appending 'limit' flag (1) stops firestorm recursion) if {!$limit} { scm-updat srch $W($Other($ndx)) \ [$W($Other($ndx)) cget -value] 1 } } } "set" { # If allowed, USER chooses whether to SEARCH the SCM for candidates if {[$wdg cget -indicatoron]} { # 'val' here is which SIDE was toggled - merge its NEW VALUE # adjusting the other side to establish the radioBtn-like value if {($val & $g(scmDOsrch))} { incr g(scmDOsrch) -$val ;# Turn choice OFF } else { set g(scmDOsrch) $val ;# Turn choice ON ... but [file rootname $wdg].scm$Other($val)lbl deselect; # N.B> Only ONE choice can be ON (but BOTH can be OFF) } # Un-toggle (ie. ignore THIS invocation) if indicator was NOT shown # (means they clicked on it when it wasn't "armed" to accept) } else {$wdg deselect} } } } ############################################################################### # Expand/contract window to access lesser-used features of the NewDiff dialog ############################################################################### proc newDiffHdn { W opncls } { global g w finfo switch $opncls { "opn" { grid $W.cflct -row 0 -column 2 -sticky w grid $W.ml -row 1 -column 1 -sticky e grid $W.me -row 1 -column 2 -sticky nsew -pady 4 -padx {0 4} grid $W.l1l -row 2 -column 1 -sticky e grid $W.l1e -row 2 -column 2 -sticky nsew -pady 4 -padx {0 4} grid $W.l2l -row 3 -column 1 -sticky e grid $W.l2e -row 3 -column 2 -sticky nsew -pady 4 -padx {0 4} grid columnconfigure $W 2 -weight 1 $W.more configure -text "Less" -command "newDiffHdn $W cls" update } "cls" { grid remove $W.cflct $W.ml $W.me $W.l1l $W.l1e $W.l2l $W.l2e # Zap everything as we close (yes, the last 3 get "") lassign {0 0} g(conflictset) g(mergefileset) g(mergefile) \ finfo(ulbl,1) finfo(ulbl,2) $W.more configure -text "More" -command "newDiffHdn $W opn" } "opH" { pack $W -side bottom -fill both -padx 5 -expand 1 set btn [string map {hlp buttons} $W] $btn.help configure -text "Less\nHelp" -command "newDiffHdn $W clH" } "clH" { pack forget $W set btn [string map {hlp buttons} $W] $btn.help configure -text "Help" -command "newDiffHdn $W opH" }} } ############################################################################### # File/Directory browser for the "New Diff" dialog ############################################################################### proc newDiffBrowse {type widget {title {}}} { global w opts # Uses TARGET widget name to locate OTHER widget field (expects a 1 or 2) if {[string is digit [set n [string index $widget end]]]} { set widgroot [string range $widget 0 end-1] set other([set other(2) 1]) 2 } else { set n {} } # Start from what is IN the target already # Basically we want each item to START browsing from where # the most recent request left off; that means (in order): # - the directory of where it is already # - the directory of where the OTHER entry is (widgets 1 & 2 only) # - the current working directory # Note that the PRIOR use of EITHER item CAN itself BE a directory if {[set entrystuff [$widget get]] != ""} { if {![file isdirectory [set initdir $entrystuff]]} { set initfil [file tail $initdir] set initdir [file dirname $initdir] } else {set initfil {}} } elseif {$n!={} && [set entrystuff [${widgroot}$other($n) get]] != ""} { if {![file isdirectory [set initdir $entrystuff]]} { set initfil [file tail $initdir] set initdir [file dirname $initdir] } else {set initfil {}} } else { set initdir [pwd]; set initfil {} } Dbg {NewDbrowse: initdir($initdir) initfil($initfil)} # What KIND of entry are we browsing to find ? switch -glob $type { "D*" { set chosen [tk_chooseDirectory -title "$type ${n}${title}" \ -parent $w(newDiff) -initialdir $initdir] # ?BUG? Undocumented Behavior (at the very least) - # When NO EFFECTIVE manipulation occurs: the dialog 'OK' # button returns "initdir" ... but 'Cancel' returns "" # In keeping with TRYING to 'shorten Fnames', we will use # the CWD when 'initdir' (or the user) happens to steer there if {$chosen==[pwd]} { set chosen "." } } "F*" { set chosen [tk_getOpenFile -title "$type ${n}$title" \ -parent $w(newDiff) -initialdir $initdir \ -initialfile $initfil -filetypes $opts(filetypes)] } } # Send back what we got (inserted only when it was successful) if {[string length $chosen] > 0} { $widget delete 0 end $widget insert 0 [shortNm $chosen] $widget selection range 0 end $widget xview end focus $widget } else { after idle {raise $w(newDiff)} } return $chosen } ############################################################################### # Split or Combine dialog (modal): adjust CDR bounds & forms EQUIVALENT diff(s) ############################################################################### proc splcmbDlg {Combine} { global g w opts splcmb # (If first time invoked) ... Construct the Dialog window itself) if {![Dialog MODAL $w(scDialog)]} { wm title $w(scDialog) "Adjust Diff Bounds" wm transient $w(scDialog) . wm group $w(scDialog) . wm resizable $w(scDialog) 0 0 wm protocol $w(scDialog) WM_DELETE_WINDOW {$w(scDialog).cncl invoke} # Encode the addressable slots/labels for loading into a 5x3 grid: set row(u) [set col(l) 0] ;# Upper row (or) Left col-pair(0&1) set row(l) 2 ;# Lower row set col(r) 3 ;# Right col-pair(3&4) set lbl(l) "Left Side" ;# (both SIDE labels go in row 1) set lbl(r) "Right Side" ;# set lbl(lu) "Upper Edge" ;# (both EDGE labels go in col 2) set lbl(ll) "Lower Edge" ;# # (Button columns are designed as VERTICALLY-OPPOSED pairings) lassign { 0 0 1 1 3 3 4 4} col(luu) col(lld) col(lud) col(llu) \ col(rud) col(rlu) col(ruu) col(rld) # Now start building the dialog label $w(scDialog).msg ;# Message content will be 'cfg'ed later pack $w(scDialog).msg -side top -padx 4 -pady 4 # Populate the 5x3 grid (logically 3x3, but outer cols span 2 each) frame [set BtnFr $w(scDialog).btn] -relief groove -padx 4 -pady 4 foreach LR {l r} { ;# Left Right SIDE > collectively forms foreach UL {u l} { ;# Upper Lower EDGE > widget names & args foreach DU {d u} { ;# Down Up BUTN > to "splcmb-adj" set nm "." button ${BtnFr}[append nm $LR $UL $DU] -image arroW$DU \ -repeatdelay 750 -repeatinterval 400 \ -command [list splcmb-adj $LR $UL $DU] grid ${BtnFr}$nm -row $row($UL) -column $col(${LR}${UL}$DU) } if {[info exists lbl(${LR}$UL)]} { ;# Edge label label ${BtnFr}[set nm .lB${LR}$UL] -text "$lbl(${LR}$UL)" grid ${BtnFr}$nm -row $row($UL) -column 2 } } label ${BtnFr}[set nm .lB$LR] -text "$lbl($LR)" ;# Side label grid ${BtnFr}$nm -row 1 -column $col($LR) -columnspan 2 } pack $BtnFr -side top -padx 4 -pady 4 # Set up to signal 'tkwait ::scDialogRet' when user has completed task button $w(scDialog).done -command {set w(scDialogRet) 1} ;# -text later button $w(scDialog).cncl -command {set w(scDialogRet) 0} -text "Cancel" pack $w(scDialog).done $w(scDialog).cncl -pady 4 -side left -expand yes # Ensure dialog can be RAISED during its modal-grab if becomes hidden # (Should put this definition elsewhere; someplace more general) bind modalDialog {wm deiconify %W ; raise %W} bindtags $w(scDialog) [linsert [bindtags $w(scDialog)] 0 modalDialog] } { set BtnFr $w(scDialog).btn } # # # # # # # # # # # # # # # # # # # # # # Re-configure Dialog contents for PRESENT usage # Some settings WILL depend on whether mode is "Split" .vs. "Combine" if {$Combine} { $w(scDialog).done configure -text "Combine" $w(scDialog).msg configure -text \ "Use buttons to EXPAND the current diff region" lassign {disable normal} inward outward ;# cmbin btns init state } else { $w(scDialog).done configure -text "Split" $w(scDialog).msg configure -text \ "Use buttons to REDUCE the current diff region" lassign {normal disable} inward outward ;# split btns init state } foreach {b} {luu ruu lld rld} {$BtnFr.$b configure -state $outward} foreach {b} {lud rud llu rlu} {$BtnFr.$b configure -state $inward} # Identify the target CDR, its Line info (and extract its type) lassign $g(scrInf,[set hID [hunk-id $g(pos)]]) S E Pl Ol na Pr Or regexp {[0-9,]*([acd])[0-9,]*} $hID na CDRtyp # # # # # # # # # # # # # # # # # # # # # # Next, establish the 'working set' of data (global splcmb array entries) # Start fresh by flushing any old data and recording the CDR info and ID unset -nocomplain splcmb set splcmb(rnge) [list [list $S $E $Pl $Ol $Pr $Or $hID]] # Also initialize the 'Pad'-lines "jump" table for EACH side # A jump table records pairs of line numbers that correspond to the top # and bottom of a contiguous run of "Pad" lines IN a splcmb(rnge) entry. # Used later in "splcmb-adj" to *jump* past those lines when editting. set splcmb(jl) [set splcmb(jr) {}] if {$Pl} {set splcmb(jl) [list [expr {$E-$Pl+1}] $E]} if {$Pr} {set splcmb(jr) [list [expr {$E-$Pr+1}] $E]} # Hmm, 'Combine' requires a lttle more work - if {$Combine} { # Must RE-derive the ORIGINAL bounds of which this CDR is a SUBSET # (create some temps to work with) set minpos [set maxpos $g(pos)] set nS $S set nE $E # Now try to EXTEND those values OUTWARD as far as they can go while {$minpos > 1} { set nhID [hunk-id [incr minpos -1]] if {$nS == [lindex $g(scrInf,$nhID) 1] + 1} { # Subsume this hunk (it abuts the CDR leading edge) lassign $g(scrInf,$nhID) nS tE tPl tOl na tPr tOr set splcmb(rnge) [linsert $splcmb(rnge) 0 \ [list $nS $tE $tPl $tOl $tPr $tOr $nhID]] if {$tPl} {set splcmb(jl) [linsert $splcmb(jl) 0 \ [expr {$tE-$tPl+1}] $tE]} if {$tPr} {set splcmb(jr) [linsert $splcmb(jr) 0 \ [expr {$tE-$tPr+1}] $tE]} } else { break } } while {$maxpos < $g(count)} { set nhID [hunk-id [incr maxpos]] if {$nE == [lindex $g(scrInf,$nhID) 0] - 1} { # Subsume this hunk (it abuts the CDR trailing edge) lassign $g(scrInf,$nhID) tS nE tPl tOl na tPr tOr lappend splcmb(rnge) [list $tS $nE $tPl $tOl $tPr $tOr $nhID] if {$tPl} {lappend splcmb(jl) [expr {$nE-$tPl+1}] $nE} if {$tPr} {lappend splcmb(jr) [expr {$nE-$tPr+1}] $nE} } else { break } } # splcmb(rnge) now has an ORDERED list of possibly involved hunks; # and ORDERED splcmb(jr/jl) lists - ie. ALL its "jump table" info. # ALSO 'nS' and 'nE' now have the OUTERMOST encompassing EDGE values } else { set nS $S ; set nE $E } # Further adjust the "Combine"-mode buttons if CDR is AT either edge of # the rnge (ie. already sitting at an exterior limit) ... # -OR- further adjust the "Split"-mode buttons if its an "a/d"-type CDR to # disallow adjustment to the ALL "Pad" lines side (its pointless). set btns {} ;# Note: default is that NEITHER adjustment will be required if {$Combine} { if {$S == $nS} {set btns {luu ruu} } if {$E == $nE} {set btns {lld rld} } } elseif {"$CDRtyp" == "a" || "$CDRtyp" == "d"} { if {$Pl} {set btns {lud llu} } if {$Pr} {set btns {rud rlu} } } if {[llength $btns]} {foreach b $btns {$BtnFr.$b configure -state disable}} # Construct the (user modifiable) 'working set' of the PRESENT CDR edges # (semantic indices refer to SIDE and EDGE pairings) # Note that the RELATIONSHIP of these MOVABLE edges to the 'hard limit' # EDGES (defined next) WILL DEPEND on the "Split" .vs. "Combine" mode lassign "$S $E $S $E" splcmb(lu) splcmb(ll) splcmb(ru) splcmb(rl) incr splcmb(ll) ;# Txt-wdg require 'lower' edge specs be 1 lower incr splcmb(rl) # Next, a (static) set of 'hard limits' semantically BRACKETING the edges # This semantic is an ['i'nner/'o'uter -plus- 'u'pper/'l'ower] concept # describing where any given BTN (and its implied EDGE) is HEADING to. # NOTE: this will LATER REQUIRE a mode-specific reverse-mapping # conversion (in "splcmb-adj") that can mirror the distinct edge VALUE # REARRANGEMENT being done here (would've been easy if Tcl had pointers!) lassign "$nS $S $E $nE" splcmb(ou) splcmb(iu) splcmb(il) splcmb(ol) incr splcmb(ol) ;# As before, lower bnds must be BELOW range (for Txt-wdg) incr splcmb(il) # Last config step - setup for the Txt-wdg tagging, ensuring visibility... foreach wdg "$w(LeftText) $w(RightText)" { $wdg tag configure scCDR -background $opts(adjcdr) $wdg tag configure scADD -background $opts(mapins) $wdg tag configure scCHG -background $opts(mapchg) $wdg tag configure scDEL -background $opts(mapdel) $wdg tag configure scPSH -bgstipple gray50 $wdg SEE $S.0 ;# N.B> grab will BLOCK scrolling: becomes OUR problem } # ... and now 'paint' the CURRENT (starting) state for the user. # (Note: this ALSO *creates* datums describing the Split/Combine STATE) splcmb-Feedback $Combine # # # # # # # # # # # # # # # # # # # # # # FINALLY ... Display and Invoke the actual Dialog Dialog show $w(scDialog) w(scDialogRet) 0 # # # # # # # # # # # # # # # # # # # # # # # waits here for the user to do their thing ... (tick, tick, tick) # # # # # # # # # # # # # # # # # # # # # # # Continue processing, beginning with taking down the Dialog itself Dialog dismiss $w(scDialog) # ELIMINATE all Dialog-overlaid-tagging in the Text widgets foreach wdg "$w(LeftText) $w(RightText)" { $wdg tag delete scADD scDEL scCHG scCDR scPSH } #splcmb-chk data ;# Formatted DEBUG output # And BAIL-OUT if user Cancelled -OR- made no ACTUAL changes # (each movable edge is AT its original STARTING position) if {!$w(scDialogRet) || \ ( ($splcmb(lu)==$splcmb(ru) && $splcmb(lu)==$S) && \ ($splcmb(ll)==$splcmb(rl) && $splcmb(ll)==$E+1) )} { # HOWEVER - partial operation MAY have moved the scrolling # RESTORE alignment if that mode is active if {$opts(autocenter)+$opts(syncscroll)} { centerCDR } return } # # # # # # # # # # # # # # # # # # # # # # Interpret/process the users interaction # # Factor-out/realign the minor inconsistencies between Split and Combine if {$Combine} { # Among the hIDs within 'splcmb(rnge)', ignore ALL that the user has # chosen to NOT coalesce any portion of BACK within the CDR boundary # (Remember: to discount the implicit +1 of lower EDGE values) foreach {tS tE na tOl na tOr thID} [join $splcmb(rnge)] { if {($splcmb(lu) > $tE && $splcmb(ru) > $tE) \ || ($splcmb(ll)-1 < $tS && $splcmb(rl)-1 < $tS)} {continue} lappend rnge $thID # Realign Numbering to FIRST involved hunk (to init LN(l/r) below) if {[llength $rnge]==1} { lassign "$tS $tOl $tOr" S Ol Or } # Rewrite (promote) the CDR type UNLESS they will ALL agree if {"$CDRtyp" != "c" && "$thID" != \ [regexp -inline "\[0-9,]+$CDRtyp\[0-9,]+" $thID]} { set CDRtyp "c" } } } else { set rnge [list $hID] } ;# However, Split only involves the CDR # Neither mode should EVER evaluate the 'Pad'-side of a "NON-chg" CDR if {"$CDRtyp" == "a"} {set splcmb(l2) 0} if {"$CDRtyp" == "d"} {set splcmb(r2) 0} # (L)ine (N)umbering begins with values just PRIOR to first INVOLVED hunk set LN(l) [expr {$S -$Ol -1}] set LN(r) [expr {$S -$Or -1}] # At the moment, 'rnge' is a list of the INVOLVED hIDs (to be deleted). # Grab its count, to use later in ensuring g(pos) REMAINS a legal value # when the hunks being deleted HAPPEN to be at the high end of g(diff). set minpos [llength $rnge] # Walk each region - forming any NEW "hID"s (into 'rnge') as we go foreach rgn {1 2 3} { set NEWid {} # Skip entire region if BOTH sides empty ... if {!$splcmb(l$rgn) && !$splcmb(r$rgn)} { continue } # ... otherwise process BOTH halves to construct the SINGLE new hID # using a technique that roughly parallels what "mark-diffs" would do # Step through the (D)datum item (bounds and type) for each side foreach LR {l r} { if {$splcmb(${LR}$rgn)} { foreach "bgn($LR) end($LR) typ" $splcmb(${LR}${rgn}D) { # factor out encompassed jump entries (if any) set i 0 foreach {n1 n2} $splcmb(j$LR) { if {$bgn($LR) <= $n1 && $n2 <= $end($LR)} { set i [expr {$i + $n2 - $n1 + 1}] } } # THEN compute number of LOGICAL lines, and MAP the type set sz($LR) [expr {$end($LR) - $bgn($LR) - $i}] set t [string map "CDR $CDRtyp ADD a DEL d CHG c" $typ] switch $t { "a" { append NEWid $LN(l) a [incr LN(r)] if {$sz($LR)} { append NEWid "," [incr LN(r) $sz($LR)] } } "d" { append NEWid [incr LN(l)] if {$sz($LR)} { append NEWid "," [incr LN(l) $sz($LR)] } append NEWid d $LN(r) } "c" {if {"$LR" == "r" } { append NEWid [incr LN(l)] if {$bgn(l) != $end(l)} { append NEWid "," [incr LN(l) $sz(l)] } append NEWid c [incr LN(r)] if {$bgn(r) != $end(r)} { append NEWid "," [incr LN(r) $sz(r)] } } } } } } } lappend rnge $NEWid } # Combine will likely REMOVE more hunks than it ADDS. # Ensure g(pos) REMAINS within its eventual bounds; preferably unchanged # (minpos was earlier set to the number of hunks being removed) set minpos [expr {(-2 * $minpos) + [llength $rnge] + [llength $g(diff)]}] set g(pos) [min $minpos $g(pos)] # Remove and Replace the designated HIDs (Note: does NO scrolling!), but # because g(pos) WAS precomputed it WILL BE properly tagged as CDR # N.B> CANT EVER reduce to ZERO diffs - no need to test RetCod mark-diffs $rnge # Cleanup any alignment requirements and the general display state if {$opts(autocenter)+$opts(syncscroll)} { centerCDR } update-display } ############################################################################### # Split/Combine dialog button callback: perform edge movement (and update UI) ############################################################################### proc splcmb-adj {side edge btn} { global w splcmb # Only PERMITTED actions can invoke us, so NO CHECKs are EVER reqd # (buttons are enabled/disabled as needed per invocation) # N.B> Args not only describe the action, but also the INVOKING widget Dbg "\n Btn HIT: Side<$side> Edge<$edge> Btn<$btn>" # Invent some static translations to provide "symbolic meta-programming". # Many are basically just 'inverse mappings' indexed by an EDGE or a BTN, # (or a +/- 'btn' move defn). "push" (a predicate) says WHEN # colocated edges MUST move together and is indexed by an EDGE plus a BTN lassign { 1 1 0 0 1 -1 r l l u d u } \ push(ud) push(lu) push(uu) push(ld) mvEg(d) mvEg(u) \ otherS(l) otherS(r) otherE(u) otherE(l) otherB(u) otherB(d) # Recover the semantic MODE we are operating under (because we can't PASS # its value from a widget cmd), then use it to create a CONTEXT-SPECIFIC # mapping from Edge/Btn specs to the 'LIMit edge' each is APPROACHING # N.B> The Combine-mode mapping is NECESSARILY DIFFERENT than Split-mode # Edge - Btn "Combine" "Split" # Upperedge-Up -> Outer-Upper -> Outer-Upper # Upperedge-Down -> Inner-Upper -> Outer-Lower # Loweredge-Up -> Inner-Lower -> Outer-Upper # Loweredge-Down -> Outer-Lower -> Outer-Lower if {[set CS [expr {[llength $splcmb(rnge)] - 1}]]} { set CSmap {uu ou ud iu lu il ld ol} } else { set CSmap {uu ou ud ol lu ou ld ol} } # OK - Extract/categorize the CURRENT edge location values # THEN actually MOVE the designated edge ... # (HOWEVER when in ): IFF both edges WERE coincident, also # conceptually PUSH (really drag) the OPPOSING edge along as well ... # UNLESS the movement logically SEPARATEs the edges (ie. stops pushing) set aLIM $splcmb([string map $CSmap ${edge}$btn]) ;# (a)pproached LIM set bLIM $splcmb([string map $CSmap ${edge}$otherB($btn)]) ;# (b)ehind LIM set oldE $splcmb(${side}$edge) ;# Edge ABOUT to move set oppE $splcmb(${side}$otherE($edge)) ;# (opp)osed Edge # MOVE the EDGE !! set newE [incr splcmb(${side}$edge) $mvEg($btn)] # Special condition (mostly meaningful for Combine): # If moved edge WAS sitting *on* the "Opposite" LIM, its possibly ALSO # a jump entry - so PRETEND we just moved THERE and let jumping fix it. # HOWEVER - This is really all about ensuring we NEVER "jump BACKWARD" by # accidentally STARTing from the "wrong direction" half of a jump tuple. # (because *that* causes an endless-loop toggling jump condition) if {($oldE == $bLIM && [set i [lsearch $splcmb(j$side) $oldE]] >= 0) \ && (($i & 1 && $mvEg($btn) < 0) || (!($i & 1) && $mvEg($btn) > 0))} { set newE $oldE} set i 0 # Check if the move TRIGGERS a "jump": jumping moves to the "other end" # of the jump tuple (which MUST be in the direction we are moving) ... # and THEN moves the edge AGAIN (by 1) UNLESS doing so would exceed the # approaching limit. Barring that, each successful jump forces a new pass, # looking for an ABUTTED jump, until no more exist (or 'aLIM' is found) # N.B> A Split NEVER has abutted entries - Combine may have several while {$i < [llength $splcmb(j$side)]} { set i 0 ;# (start a new pass - ends @ aLIM or when NO jump is found) foreach jmp $splcmb(j$side) { if {$jmp == $newE} { set newE [lindex $splcmb(j$side) [expr {$i & 1 ? $i-1 : $i+1}]] if {$newE == $aLIM} { set i [llength $splcmb(j$side)] set splcmb(${side}$edge) $newE } else { set splcmb(${side}$edge) [incr newE $mvEg($btn)] if {$newE == $aLIM} { set i [llength $splcmb(j$side)] } } break } incr i } } # Also check if moving was "push"ing the opposing edge with it (Split only) if {$oldE == $oppE && $push(${edge}$btn)} { set oppE [set splcmb(${side}$otherE($edge)) $newE] } # Now the FUN - First, readjust which buttons will NOW be available ... set Bwdg $w(scDialog).btn.$side ;# (just conserving src-code typing) # First two rules apply to EITHER Combine OR Split (for moving edge) # Exitting the 'behind' limit(activate OTHER Button); and # Entering the 'ahead' limit(deactivate THIS Button) if {$oldE==$bLIM} { ${Bwdg}${edge}$otherB($btn) configure -state normal } if {$newE==$aLIM} { ${Bwdg}${edge}$btn configure -state disabled} # The remainder applies ONLY to SPLIT (and is caused by PUSHING) # Push other edge INTO 'approach' limit (deactivate other edge+SAME btn) # Push other edge OUT of 'behind' limit (activate OTHER edge AND button) if {!$CS && $push(${edge}$btn) && $oppE==$newE} { if {$oppE == $aLIM} { ${Bwdg}$otherE($edge)$btn configure -state disabled} if {$oldE == $bLIM} { ${Bwdg}$otherE($edge)$otherB($btn) configure -state normal } } # ... THEN add visual user feedback of what this boundary move MEANT splcmb-Feedback $CS # ADJUST Text VIEW (in the side just changed) so we see what happenned # (N.B> user is UNABLE to scroll for themselves ... grab is in force) # # Conceptually, we test for whether oldE is visible (but must CALC (=i) # an "equivalent" oldE to eliminate any potential "jump" usage earlier) # Ultimately we choose the faked oldE, or a horizoned-version of newE # and tell the widget to FORCE that line to be visible - EITHER yeilds # a view that keeps the moved subregion boundary edge ONSCREEN. # (Only adjusts the widget whose 'side' actually moved if scroll!=synced) set side [string map {l LeftText r RightText} $side] set i $newE # If our 'faked' oldE IS ALREADY onscreen, maintain the "horizoned" view if {[$w($side) bbox [incr i $mvEg($otherB($btn))].0]!={}} { incr mvEg(u) -1 ;# (modify into a BALANCED horizon envelope) incr newE $mvEg($btn) ;# ensure NEW edge is INSIDE that horizon # else PUTTING that oldE location ONscreen will CREATE the "horizoned" view } { set newE $i } $w($side) SEE $newE.0 } ############################################################################### # Interpret, display and produce a data mapping of the CURRENT moved-edge state ############################################################################### proc splcmb-Feedback {Combine} { global g w splcmb # Begin by UNtagging all Split/Combine highlighting from affected area foreach wdg "$w(LeftText) $w(RightText)" { foreach tag {scCDR scADD scDEL scCHG scPSH} { $wdg tag remove $tag $splcmb(ou).0 $splcmb(ol).0 } } # Then put back what belongs based on CURRENT boundary conditions # For Combine, compute the current EFFECTIVE Outer (U/L) bounds; # Split ALREADY knows those bounds - just copy to the local vars if {$Combine} { # Begin by FINDING the outer (u/l) edges of the INVOLVED hIDs # (remember to discount the +1 of the lower edges when comparing) set upper [set lower 0] foreach hunk $splcmb(rnge) { lassign $hunk S E na na na na hID if {($splcmb(lu) > $E && $splcmb(ru) > $E) \ || ($splcmb(ll)-1 < $S && $splcmb(rl)-1 < $S)} {continue} # extract type regexp {[0-9,]*([acd])[0-9,]*} $hID na type # Retain JUST the first and last edge values (and its diff-type) if {!$upper} {set upper $S; set typ(u) $type} if {$E > $upper} {set lower $E; set typ(l) $type; incr lower} } } else { lassign "$splcmb(ou) $splcmb(ol)" upper lower } # Now, arrange ALL edges (working and limits) as 3 top-to-btm # sub-regions, noting which HAS any content (per sub-region, per side). foreach LR {l r} { lassign {0 1 0} splcmb(${LR}1) splcmb(${LR}2) splcmb(${LR}3) set splcmb(${LR}1) [expr \ {[set t(1$LR) $upper] < [set b(1$LR) $splcmb(${LR}u)]}] set splcmb(${LR}2) [expr \ {[set t(2$LR) $splcmb(${LR}u)] < [set b(2$LR) $splcmb(${LR}l)]}] set splcmb(${LR}3) [expr \ {[set t(3$LR) $splcmb(${LR}l)] < [set b(3$LR) $lower]}] # Dbg [join [list \ "<${LR}1>$splcmb(${LR}1) $t(1$LR) $b(1$LR)" \ "<${LR}2>$splcmb(${LR}2) $t(2$LR) $b(2$LR)" \ "<${LR}3>$splcmb(${LR}3) $t(3$LR) $b(3$LR)"] "\n "] } # Then "paint" (tag) the occupied sub-regions in appropriate MAP colors # based on the LOGICALLY IMPLIED DIFFERENCE of each sub-region pairing # ALSO RECORD (via L/R sub-region 'D'atums) WHICH lines + type was set # # N.B> DECREMENTing 'bottom' values IN-BETWEEN its widget use and the # subsequent recording produces a PURE "screen Lnum" data viewpoint # # Note: The only distinction reqd for 'Combine' is to PREVENT treating # the 'Pad'-only half of region 1&3 'a/d'-type hunks AS data (by turning # the 'occupied' flag OFF ... *AFTER* highlighting for user feedback) foreach rgn {1 2 3} { if {$splcmb(r$rgn) && $splcmb(l$rgn)} { if {$rgn == 2} { set tag scCDR if {! $splcmb(r$rgn)} {set tag scDEL} if {! $splcmb(l$rgn)} {set tag scADD} } else {set tag scCHG} $w(LeftText) tag add $tag $t(${rgn}l).0 $b(${rgn}l).0 $w(RightText) tag add $tag $t(${rgn}r).0 $b(${rgn}r).0 incr b(${rgn}l) -1 incr b(${rgn}r) -1 set splcmb(l${rgn}D) \ "$t(${rgn}l) $b(${rgn}l) [string range $tag 2 4]" set splcmb(r${rgn}D) \ "$t(${rgn}r) $b(${rgn}r) [string range $tag 2 4]" } elseif {$splcmb(r$rgn)} { $w(RightText) tag add scADD $t(${rgn}r).0 $b(${rgn}r).0 if {!$Combine && $rgn==2} { $w(LeftText) tag add scPSH $t(2l).0 [expr $b(2l)+1].0 } incr b(${rgn}r) -1 if {$Combine && (($rgn==1 && "$typ(u)"=="d") \ || ($rgn==3 && "$typ(l)"=="d"))} {set splcmb(r$rgn) 0} set splcmb(r${rgn}D) "$t(${rgn}r) $b(${rgn}r) ADD" } elseif {$splcmb(l$rgn)} { $w(LeftText) tag add scDEL $t(${rgn}l).0 $b(${rgn}l).0 if {!$Combine && $rgn==2} { $w(RightText) tag add scPSH $t(2r).0 [expr $b(2r)+1].0 } incr b(${rgn}l) -1 if {$Combine && (($rgn==1 && "$typ(l)"=="a") \ || ($rgn==3 && "$typ(l)"=="a"))} {set splcmb(l$rgn) 0} set splcmb(l${rgn}D) "$t(${rgn}l) $b(${rgn}l) DEL" } } } ############################################################################### # Primarily code that advises (1|0) on eligibility of hunk for Split/Combine... # ...but also provides a formatted STDOUT data-dump for debugging purposes ############################################################################### proc splcmb-chk {what {pos 0}} { global g splcmb switch -exact -- $what { "split" { # Is dependant on there being MORE than 1 line on EITHER side # N.B> this PREVENTS splitting ANY one-line hunk (incl. "chg"-type) if {$pos <= $g(count) && $g(count) > 0} { lassign $g(scrInf,[hunk-id $pos]) S E Pl na na Pr return [expr {($E - $S) || ($Pl + $Pr > 1)}] } } "cmbin" { # Is dependant on there being some hunk ABUTTED either above/below if {$pos <= $g(count) && $g(count) > 1} { # Grab edge values of the target CDR at 'pos' lassign $g(scrInf,[hunk-id $pos]) S E # Validate and check BELOW target first, then ABOVE - and exit ASAP if {[incr pos -1]} { if {($S - 1 == [lindex $g(scrInf,[hunk-id $pos]) 1])} {return 1} } if {[incr pos 2] <= $g(count)} { if {($E + 1 == [lindex $g(scrInf,[hunk-id $pos]) 0])} {return 1} } } } "data" { if {"$pos" != "0"} { puts "***** $pos" } ;# <-- simply a dump identifier # This is a DRAMATICALLY more READABLE output format!!! puts " EDGES : $splcmb(lu) $splcmb(ll) $splcmb(ru) $splcmb(rl)" puts " AMONG :" foreach {S E Pl Ol Pr Or hID} [join $splcmb(rnge)] { puts "[format "\t%d %d P=%d,%d O=%d,%d %s" \ $S $E $Pl $Pr $Ol $Or $hID]" } puts "\nou $splcmb(ou)" foreach side {l r} { foreach rgn {1 2 3} { if {$splcmb(${side}$rgn)} { puts "\t${side}$rgn $splcmb(${side}$rgn)\t${side}${rgn}D\ $splcmb(${side}${rgn}D)" } else {puts "\t${side}$rgn $splcmb(${side}$rgn)"} } if {"$splcmb(j$side)" != {}} {puts "\t\tj$side $splcmb(j$side)"} if {"$side" == "l"} { if {[llength $splcmb(rnge)] > 1} { puts "iu $splcmb(iu)\n\t(CDR)\nil $splcmb(il)" } { puts "" } } } puts "ol+ $splcmb(ol)\n" } } return 0 } ############################################################################### # All the code to implement the report writing dialog. # N.B> the ONLY "public" subcmd is 'popup'; all others are for INTERNAL usage ############################################################################### proc rpt-gen {subcmd args} { global g w opts finfo report set w(reportPopup) .reportPopup # N.B> we COULD have 'passed' these around, but this was actually clearer # # Need the number of SCREEN lines that exist (either side will do) # (and "F" is simply a static list of FIELD NAMEs we read hunk data into) set maxlns [file rootname [$w(acTxWdg) index end-1lines]] lappend F S E P(Left) O(Left) C(Left) P(Right) O(Right) C(Right) switch -- $subcmd { popup { # Put the dialog up on screen if {![Dialog MODAL $w(reportPopup)]} { wm title $w(reportPopup) "$g(name) - Generate Report" wm group $w(reportPopup) . wm transient $w(reportPopup) . wm protocol $w(reportPopup) WM_DELETE_WINDOW {rpt-gen dismiss} # Populate content ... # and perform a ONE-TIME centering ... rpt-gen build centerWindow $w(reportPopup) } # Configure it for this usage unset -nocomplain report(stats) rpt-gen update set report(filename) [file join [pwd] $report(filename)] # The following does NOT return until the *Dialog* is completed Dialog show $w(reportPopup) w(status$w(reportPopup)) 0 # Whether we WROTE or NOT we are done, take down the dialog # (and Reset the filename validity to 'needs check' for next time) Dialog dismiss $w(reportPopup) set report(fnamVetted) 0 } save - dismiss { # RELEASING the 'Dialog show' depends on the asking subcmd # AND if a writing REQUEST was actually permitted/successful if {$subcmd eq "save"} { if {![set rc [rpt-gen write]]} { # DO NOT release the Dialog - # Let user pick a new filename or CHOOSE to bail out! return } } { set rc 0 } set w(status$w(reportPopup)) $rc } update { # Align all GUI elements with current settings lassign {disabled disabled} state(Left) state(Right) if {$report(doSideLeft)} { set state(Left) "normal" } if {$report(doSideRight)} { set state(Right) "normal" } foreach side {Left Right} { foreach item {lnums cmrks text} { $w(reportPopup).cFrm.$item$side configure -state $state($side) } } # Compute the (minimally formatted) stats, posting it TO the dialog, # AND also HOLD onto it for report output (ONCE per dialog usage) if {![info exists report(stats)] || ![string length $report(stats)]} { $w(reportPopup).msg configure \ -text [join [set report(stats) [rpt-gen stats $maxlns]] "\n"] } # Lastly, decide if a 'Bookmark"-style report choice is permitted set bkmOK [expr {[llength $report(BMrptgen)] ? "normal" : "disabled"}] foreach side {Left Right} { $w(reportTextMnu$side) entryconfigure "B*" -state $bkmOK } } stats { # Develop some simple statistical data (for REAL hunks ONLY) lassign { 0 0 0 0 "" 0 0 "" } {*}$F set aCnt [set dCnt [set cCnt [set modLft 0]]] set aTot [set dTot [set cTot [set modRgt 0]]] foreach hID $g(diff) { lassign $g(scrInf,$hID) {*}$F switch -- "[append C(Left) $C(Right)]" { "+" { incr aCnt ; incr aTot $P(Left) ; incr modRgt $P(Left) } "-" { incr dCnt ; incr dTot $P(Right) ; incr modLft $P(Right)} "!!" { incr cCnt ; incr cTot [expr {$P(Left) - $P(Right)}] incr modLft [expr {$E - $S - $P(Left) + 1}] incr modRgt [expr {$E - $S - $P(Right) + 1}] } } } # ... next compute what we can from them ... # (Note: maxlns derived from a WIDGET: has an EXTRA empty line) set sz(Left) [expr {$maxlns - 1 - $O(Left) - $P(Left) }] set sz(Right) [expr {$maxlns - 1 - $O(Right) - $P(Right) }] set pctLft [expr {double($modLft*100) /double($sz(Left)) }] set pctRgt [expr {double($modRgt*100) /double($sz(Right))}] set totsz [expr { $sz(Left) + $sz(Right)}] set totmod [expr { $modLft + $modRgt }] set totpct [expr { $pctLft + $pctRgt }] set effpct [expr {double($totmod*100) / double($totsz) }] # ... then format our findings (kinda NEEDs a MONO font) and ... lappend out "Number of diffs: $g(count)\n" set fmt "%6d regions were %s: %d(net) modified lines" lappend out [format "$fmt" $dCnt "deleted" $dTot] lappend out [format "$fmt" $aCnt " added " $aTot] lappend out [format "$fmt\n" $cCnt "changed" $cTot] set fmt "%6d %s lines were affected: %4.4g %% of %6d" lappend out [format "$fmt" $modLft "Left " $pctLft $sz(Left) ] lappend out [format "$fmt" $modRgt "Right" $pctRgt $sz(Right)] set fmt "%6d %s lines were involved: %4.4g %% or %6.4g %%" lappend out [format "$fmt" $totmod "Total" $totpct $effpct] # send it all back to the caller return $out } browse { set path [tk_getSaveFile -parent $w(reportPopup) \ -filetypes $opts(filetypes) \ -initialdir [file dirname $report(filename)] \ -initialfile [file tail $report(filename)]] if {[string length $path] > 0} { set report(filename) $path set report(fnamVetted) 1 } } write { if {!$report(fnamVetted)} { # Either this was just a default-generated name, or its a name that # was PLAYED with AFTER having BEEN Vetted - either way force user # to confirm and/or alter the name before we trash something. rpt-gen browse if {!$report(fnamVetted)} { return 0 } } # Apparently we are good to go - reset for next time and just DO it set report(fnamVetted) 0 set handle [open $report(filename) w] puts $handle "$g(name) $g(version) report\t\t\ [clock format [clock seconds]]" # Mention the file name(s) ... BOTH unless exactly one is OFF set not([set not(Right) Left]) Right foreach {side} {Left Right} { if {$report(doSide$side) || !$report(doSide$not($side))} { # (N.B> 'alignDecor' left this cookie just for us - pick it up) if {$g(tooltip,${side}Label)!={}} { set mtime [string range $g(tooltip,${side}Label) \ [string first "\n" $g(tooltip,${side}Label)]+1 end-1] } { set mtime "(@ today)" } # Yeah I know the padding seems strange - but it lines # up things (because L/R are 4/5 chars in length, resp.) puts $handle " $side\tfile : $finfo(lbl,$side) $mtime" } } # Stats have already been Computed and Formatted, just include them # (BUT remember to adapt its NL & spacing relative to the report) puts $handle "\n[join $report(stats) "\n "]\n\n" # Translate the GUI setting regarding the DESIRED output format into # something a bit EASIER to use (if not understand -> boolean logic) # Fairly simple - Should output be limited to: # 2 ALL 'D'iff 'R'egions # 1 SPECIFIC 'DR's (those bookmarked) # 0 no DR-related restrictions whatsoever switch -glob $report(doText$side) { "Diff*" { set DR 2 } "Book*" { set DR 1 } default { set DR 0 } } # Pre-Load FIRST PHYSICAL hunk (if any - IGNOREs MAY still exist) # ("H", "skpH" & "pfxH" just track the hunk 'ndx' for use later) # # IMPORTANT: Note we are walking through g(DIFF) not g(diff) !! # N.B. code DETECTs & INTERPOLATEs further hunks AS lines advance if {$g(COUNT) > [set i [set skpH [set pfxH [set H 0]]]]} { lassign $g(scrInf,[set hID [hunk-id [incr H] DIFF]]) {*}$F if {[info exists g(overlap$hID)]} { set C(Left) [set C(Right) "?"]} \ elseif {"$C(Left)$C(Right)" == ""} { incr skpH ;# must account for an 'ignored' hunk } # A 'S'ignificant 'D'iff 'R'egion is one that can LIMIT the output # based on a confluence of chosen MODE and the specific region set SDR [expr {($DR > 1) || ($DR && $hID in $report(BMrptgen))}] } else { lassign { 0 0 0 0 "" 0 0 "" 0 } {*}$F SDR} # Now produce the requested categories of data (if any) if {(!$report(doSideRight) && !$report(doSideLeft))} {set maxlns 0} while {[incr i] < $maxlns} { set out(Left) [set out(Right) ""] foreach side {Left Right} { if {!$report(doSide$side)} {continue} # Waterfall test detects phase of WHERE "$i" falls IN hunk, # thus what SHOULD be displayed (if not 'off' by request) # # N.B> DESPITE coding as loop - this RARELY ever needs to! # It exists ENTIRELY because there is NO 'goto' in Tcl; # thus a 'continue' is the ONLY way to RE-start this code ! while {true} { if {$H > 0 && $i >= $S} { if {$i > ($E - $P($side))} { if {$i > $E} { if {$H < $g(COUNT)} { # Step forward to the NEXT hunk mapping set hID [hunk-id [incr H] DIFF] lassign $g(scrInf,$hID) {*}$F if {[info exists g(overlap$hID)]} { set C(Left) [set C(Right) "?"]} \ elseif {"$C(Left)$C(Right)" == ""} { incr skpH ;# account for 'ignored' hunks } # Establish 'significance' of this NEW region set SDR [expr {($DR > 1) \ || ($DR && $hID in $report(BMrptgen))}] # WHY IS THERE NO goto IN THIS LANGUAGE!!! # # RESTART waterfall: 'i' MIGHT now be INSIDE # newly read-in hunk (supports abutted hunk # defs as created by Split/Combine feature) continue ## (Poor PGMRS is the problem - NOT goto !) } elseif {$P($side)} { # Fixup trailing Lnums when FINAL hunk padded incr O($side) $P($side); set P($side) 0} set LN 1;set CB 0 ;# Is beyond hunk } else { set LN [set CB 0]} ;# A PADDING line } else { set LN [set CB 1]} ;# A DIFF line } else { set LN 1;set CB 0 } ;# Is before hunk break ;# if we reach here, we need NOT go back around!! } # "Diffs Only" or "Bookmarked" acts as a filter, blocking ALL # output UNTIL we are INSIDE a diff region. Else it does NADA! # The derivation of a 'S'ignificant 'D'iff 'R'egion comes # from both the Text mode chosen and the CURRENT region and # was determined earlier as we encountered each region if {$DR} { # If line is OUTSIDE of ANY hunk, SKIP (due to DR mode) if {($LN ^ $CB)} { continue # Watch for the 1st line of ANY Diff (it needs counting) } elseif {$pfxH < ($H - $skpH)} { # if 'significant' - produce a label AND count it # (but count REGARDLESS to keep # correct) if {$SDR} { puts $handle "\nDiff #[incr pfxH] ($hID):" } { incr pfxH ; continue } # But suppress ANY Diff line that is NOT significant } elseif {!$SDR} { continue } } if {$report(doLnums$side)} { if {$LN} { append out($side) \ [format "%*d " $g(lnumDigits) [expr {$i-$O($side)}]] } else {continue} # N.B> LN==0 implys a PAD line (No CMrk/Text can exist) # Thus no need to append ANYTHING more to this line !! } if {$report(doCMrks$side)} { append out($side) [string range \ [expr {$CB ? "$C($side) " : " "}] 0 1] } if {"$report(doText$side)" != " (no text) "} { append out($side) [string trimright \ [$w(${side}Text) get "$i.0" "$i.0 lineend"]] } } if {$report(doSideLeft) == 1 && $report(doSideRight) == 1} { set output [format "%-90s%-90s" "$out(Left)" "$out(Right)"] } elseif {$report(doSideRight) == 1} { set output "$out(Right)" } elseif {$report(doSideLeft) == 1} { set output "$out(Left)" } set output "[string trimright "$output"]" if {[string length "$output"]} { puts $handle "$output" } } close $handle return 1 } build { # The major guts goes inside the "client Frame" (cFrm) # except for buttons (so we can hold onto them during resizing) set cf [frame $w(reportPopup).cFrm -bd 2 -relief groove] set bf [frame $w(reportPopup).bFrm -bd 0] pack $bf -side bottom -fill x -expand n pack $cf -side bottom -fill both -expand y -padx 5 -pady 5 # Apologies, but this REALLY NEEDS a Mono-spaced font!!! pack [message $w(reportPopup).msg -aspect 500 \ -font {"Courier" 11 italic}] -pady 5 # buttons... pack [button $bf.cancel -text "Cancel" -underline 0 -width 6 \ -command {rpt-gen dismiss}] -side right -padx 5 -pady 5 pack [button $bf.save -text "Save" -underline 0 -width 6 \ -command {rpt-gen save}] -side right -pady 5 # client area. # Treat this as a 5-col area, so we can basically spread any # expansion SPACING among the EMPTY columns set col(Left) 1 set col(Right) 3 foreach side {Left Right} { set pickS [checkbutton $cf.pickS$side -command {rpt-gen update}] set lnums [checkbutton $cf.lnums$side] set cmrks [checkbutton $cf.cmrks$side] set mnu [tk_optionMenu [set txt $cf.text$side] report(doText$side)\ "Full Text" "Diffs Only" "Bookmarked" " (no text) "] $pickS configure -text "$side Side" -var report(doSide$side) $lnums configure -text "Line Numbers" -var report(doLnums$side) $cmrks configure -text "Change Markers" -var report(doCMrks$side) # we need this MENU from the above for config ops in subcmd 'updat' set w(reportTextMnu$side) $mnu grid $pickS -row 0 -column $col($side) -sticky w grid $lnums -row 1 -column $col($side) -sticky w -padx {10 0} grid $cmrks -row 2 -column $col($side) -sticky w -padx {10 0} grid $txt -row 3 -column $col($side) -sticky w -padx {10 0} } # the entry, label and button for the filename will get # stuffed into a "file frame" (fFrm) for convenience... frame $cf.fFrm -bd 0 grid $cf.fFrm -row 4 -column 0 -columnspan 5 -sticky ew -padx {0 5} label $cf.fFrm.l -text "File:" entry $cf.fFrm.e -textvar report(filename) -width 30 -validate key \ -vcmd {set report(fnamVetted) 0; return true} button $cf.fFrm.b -text "Browse..." -command {rpt-gen browse} \ -highlightthickness 0 -bd 1 -pady 0 pack $cf.fFrm.b -side right -pady 4 -anchor se -padx 2 pack $cf.fFrm.l -side left -pady 4 -anchor sw -padx 2 pack $cf.fFrm.e -side left -pady 4 -fill x -expand y grid rowconfigure $cf {0 1 2 3} -weight 0 grid columnconfigure $cf {0 2 4} -weight 1 -uniform a } } } ############################################################################### # Open one of the diff'd files in an editor - IF PERMITTED # Fundamentally depends on w(acTxWdg) to designate which file # # Always attempts to use FOCUS to SHIFT the active window first (which only # works if that window IS one of the Text windows), then OVERRIDES it # with the window containing (optionally provided) X,Y ROOT coordinates # (implying it came from a mouse-based binding and NOT a keyboard one). # We accept ANY window having a L/R attribute to perform the override (as # they are the only ones even HAVING the binding needed to MAKE the call). # IN ANY EVENT - w(acTxWdg) is adjusted and then directs the file to grab. ############################################################################### proc do-edit { {X {}} {Y {}} } { global g w opts finfo # IF ROOT coordinates were provided, we use them to PICK the Window # being TARGETTED as 'active' (with a fallback to current FOCUS) if {$X!={} && $Y!={}} { set win [list [focus] [winfo containing $X $Y]] } { set win [list [focus]] } # Attempt to assign w(acTxWdg) reasonably # First is FOCUS (to establish the fallback), # then OVERRIDE with the mouse coordinates (IFF they were provided) foreach win $win { foreach side {Left Right} { foreach item {Text Info VSB HSB Label} { # Only LEGITIMATE windows are permitted to TRY if {$win == $w($side$item)} { set w(acTxWdg) $w(${side}Text) break } } } } # Locate the correct filename set ndx [expr {$finfo(fCurpair) * 2}] if {$w(acTxWdg) == $w(LeftText)} {incr ndx -1} if {![info exists finfo(tmp,$ndx)]} { # Got the file - GET the line number set file "$finfo(pth,$ndx)" if {$g(count)} { lassign $g(scrInf,$g(currdiff)) line na na O(1) na na O(0) incr line -$O([expr {int($ndx & 1)}]) } else {set line 1} ;# have to pick something if no CDR exists if {[string length [string trim $opts(editor)]] == 0} { simpleEd open "$file" $line } elseif {[regexp "\\\$file" "$opts(editor)"] == 1} { eval set cmdline \"$opts(editor) &\" Dbg "exec $cmdline" eval exec $cmdline } else { Dbg "exec $opts(editor) \"{$file}\" &" eval exec $opts(editor) "{$file}" & } } else { popmsg "This file is not editable" warning "Dis-allowed" } } ########################################################################## # A simple editor, from Bryan Oakley. # 22Jun2018 mpm: now accepts (opt.) line number to display (dflt = 1) # 04Aug2018 mpm: additional keywords/parsing added for open subcmd # mpm: now provides line numbering (in adjoining subwindow) ########################################################################## proc simpleEd {command args} { global textfont switch -- $command { open { # Ingest required args (and establish default options): # filename if {[set argn [llength $args]]} { set filename [lindex $args [set count 0]] set line 1 set title "$filename - Simple Editor" set FG {} set BG {} } {error "simpleEd open ?filename?: reqd arg missing"} # ... then see if others were provided (in any order) # [Lnum] ['fg' color] ['bg' color] ['title' xxxx] ['ro'] while {[incr count] < $argn} { switch -glob [set arg [lindex $args $count]] { "\[0-9]" { set line $arg } "f*" { lappend FG -fg [lindex $args [incr count]] } "b*" { lappend BG -bg [lindex $args [incr count]] } "t*" { set title [lindex $args [incr count]] } "ro" { set RO [list configure -state disabled] } } } set w .editor set count 0 while {[winfo exists ${w}$count]} { incr count 1 } set w ${w}$count toplevel $w -borderwidth 2 -relief sunken wm title $w $title wm group $w . menu $w.menubar $w configure -menu $w.menubar $w.menubar add cascade -label "File" -menu $w.menubar.fileMenu menu $w.menubar.fileMenu if {![info exists RO]} { $w.menubar.fileMenu add command -label "Save" \ -underline 1 -command [list simpleEd save $filename $w] $w.menubar.fileMenu add command -label "Save As..." \ -underline 1 -command [list simpleEd saveAs $filename $w] $w.menubar.fileMenu add separator } $w.menubar.fileMenu add command -label "Exit" -underline 1 \ -command [list simpleEd exit $w] if {![info exists RO]} { $w.menubar add cascade -label "Edit" -menu $w.menubar.editMenu menu $w.menubar.editMenu $w.menubar.editMenu add command -label "Cut" -command \ [list event generate $w.text <>] $w.menubar.editMenu add command -label "Copy" -command \ [list event generate $w.text <>] $w.menubar.editMenu add command -label "Paste" -command \ [list event generate $w.text <>] } text $w.text -wrap none -xscrollcommand [list $w.hsb set] \ -yscrollcommand [list $w.vsb set] -borderwidth 0 \ -font $textfont {*}$FG {*}$BG scrollbar $w.vsb -orient vertical -command [list $w.text yview] scrollbar $w.hsb -orient horizontal -command [list $w.text xview] # Derive needed info to fabricate/utilize a line numbering canvas set Aft [font metrics $textfont -ascent] ;# Ascent of font set Dw [font measure $textfont "8"] ;# Digit width set Fg [$w.text cget -fg] ;# Same foreground & background canvas $w.cnvs -highlightthickness 0 -bg [$w.text cget -bg] grid $w.cnvs -row 0 -column 0 -sticky nsew grid $w.text -row 0 -column 1 -sticky nsew grid $w.vsb -row 0 -column 2 -sticky ns grid $w.hsb -row 1 -column 1 -sticky ew grid columnconfigure $w 0 -weight 0 grid columnconfigure $w 1 -weight 1 grid columnconfigure $w 2 -weight 0 grid rowconfigure $w 0 -weight 1 grid rowconfigure $w 1 -weight 0 set fd [open $filename] # PREVENT V9.x from throwing 'encoding' errors if {$::tcl_version >= 9.0} { fconfigure $fd -profile tcl8 } $w.text insert 1.0 [read $fd] close $fd set lenDigits [string length [$w.text index end]] $w.cnvs configure -width [set X [expr {int($lenDigits-2)*$Dw+3}]] # N.B> tracing on the Vert-Scrlbar trips on window resizes too trace add exec $w.vsb leave [list apply "{Fg Asc X args} { $w.cnvs delete all set Lnum \[file rootname \[$w.text index @0,0]] set LastLnum \[file rootname \[$w.text index end-1lines]] while {\[llength \[set dl \[$w.text dlineinfo \$Lnum.0]]]>0} { if {\$Lnum == \$LastLnum} {break} ;# ignore extra last line lassign \$dl na y na na bl incr y \$bl incr y -\$Asc $w.cnvs create text \$X \$y -anchor ne -font \"$textfont\" \ -fill \$Fg -text \$Lnum incr Lnum } update idletasks }" $Fg $Aft [incr X -2]] $w.text see $line.0 ;# N.B> done AFTER the trace setup to tickle it if {[info exists RO]} {$w.text {*}$RO } } save { set filename [lindex $args 0] set w [lindex $args 1] set fd [open $filename w] puts $fd [$w.text get 1.0 "end-1c"] close $fd } saveAs { set filename [lindex $args 0] set w [lindex $args 1] set filename [tk_getSaveFile -filetypes $opts(filetypes) \ -initialfile [file tail $filename] \ -initialdir [file dirname $filename]] if {$filename != ""} { simpleEd save $filename $w } } exit { set w [lindex $args 0] destroy $w } } } # end of simpleEd # tooltips version 0.1 # Paul Boyer # Science Applications International Corp. # # MODIFIED (for TkDiff) # 31Jul2018 mpm: NO-OP/UN-bind(s) if setting to an empty description ############################## # set_tooltips gets a button's name and the tooltip string as arguments # and creates the proper bindings for entering and leaving the button # Serves as the external interface to the feature # (helper procs carry a "i"nternal "T"ool "T"ip naming prefix) ############################## proc set_tooltips {widget tiptxt} { global g if {$tiptxt == {}} { bind $widget {} bind $widget {} bind $widget {} return } if {![info exists g(tooltip_id)]} {set g(tooltip_id) "Initialized"} bind $widget " catch { after 500 { iTT_PopUp %W $tiptxt } } g(tooltip_id) " bind $widget {iTT_PopDown} bind $widget {iTT_PopDown} } ############################## # internal_tooltips_PopDown is used to de-activate the tooltip window ############################## proc iTT_PopDown {} { global g after cancel $g(tooltip_id) catch {destroy .tooltips_wind} } ############################## # internal_tooltips_PopUp is used to activate the tooltip window # # MODIFIED (for TkDiff) # 20Oct2020 mpm: TK issue? (lack of multi-monitor screen(x/y) ORIGIN) # (also tighten'd minor extraneous border, etc. pixels) ############################## proc iTT_PopUp {wid tiptxt} { global g w opts # get rid of other existing tooltips catch {destroy .tooltips_wind} toplevel .tooltips_wind -class ToolTip -highlightthickness 0 -bd 0 set size_changed 0 # get the cursor position set X [winfo pointerx $wid] set Y [winfo pointery $wid] # add a slight offset to make tooltips fall below cursor set Y [expr {$Y + 20}] # Now pop up the new widgetLabel wm overrideredirect .tooltips_wind 1 wm geometry .tooltips_wind +$X+$Y label .tooltips_wind.l -text $tiptxt -border 1 -relief raised \ -background $opts(inform) -foreground $w(fgnd) pack .tooltips_wind.l # make invisible wm withdraw .tooltips_wind update idletasks # Dont let the ToolTip get CLIPPED by the screen edge # N.B> would have PREFERRED "winfo screen[x|y] $wid" but doesn't exist! # *mpm* (TK missing-feature bug?: can FAIL on 2nd,3rd...etc monitors) # Need to know SOME extent (aka display bounds) cursor is WITHIN !! lassign [iTT_scrnEdges $wid] na na RgtLoc BotLoc # adjust for bottom of screen if {($Y + [winfo reqheight .tooltips_wind]) > $BotLoc } { # ?? shouldn't the 25 REALLY be 2 times the original offset of 20 ?? set Y [expr {$BotLoc - [winfo reqheight .tooltips_wind] - 25}] set size_changed 1 } # adjust for right border of screen if {($X + [winfo reqwidth .tooltips_wind]) > $RgtLoc } { set X [expr {$RgtLoc - [winfo reqwidth .tooltips_wind]}] set size_changed 1 } # reset position if {$size_changed == 1} { wm geometry .tooltips_wind +$X+$Y } # make visible wm deiconify .tooltips_wind raise .tooltips_wind ;# Reqd MacOS (no harm anybody else): AFTER deiconify! # make tooltip disappear after 5 sec set g(tooltip_id) [after 5000 { iTT_PopDown }] } ############################################################################### # internal_tooltips_scrnEdges is used to avoid clipping the tooltip window # # TK-BUG/oversight/failure: # In a multi-screen configuration, TK fails to provide a means to LOCATE the # screen edges. Historically (aka: single screen) the location was IMPLIED to # be at (0,0), thus only the width/height were ever provided. However, it is # UNCLEAR the PROPER (W,H) is being returned when requested, as the POSITION of # the requestor can appear to be OUTSIDE that returned (0,0)-based (W,H). # This proc compensates (poorly) by USING the (W,H) when it "appears" to be # valid, and substitutes the dimensions of its "Toplevel" when not. As such it # must be possible to ASK for the position/size of a REALIZED toplevel (not # one still under construction, or incompletely modified). Be careful! # # Arg: the same as "winfo screen(width/height)": an 'exemplar' window # # Returns: list of 4 (position) values "minX minY maxX maxY" of edges to USE ############################################################################### proc iTT_scrnEdges { win } { lassign "[winfo vrootx $win] [winfo vrooty $win] [winfo rootx $win] [winfo rooty $win] [winfo width $win] [winfo height $win] 0 0 [winfo screenw $win] [winfo screenh $win]" vx vy x y w h X Y W H # DBG shows everything known; PROVING TK cant tell us where the edges are of any # ONE monitor is when the Display is configured in a multi-monitor arrangement !! # Dbg "vx($vx) vy($vy) x($x) y($y) w($w) h($h) X($X) Y($Y) W($W) H($H)\ .WxH([winfo screenw .] [winfo screenh .])" # If the LOCATION of the exemplar window is WITHIN the TK-provided screen # width/height, then use IT; otherwise fallback to using the Toplevel it # belongs to (best option - lousy though it is)! # ('inclusion' test LOOKS for any aspect of non-inclusion: 0==inside) if {($x+$vx+$w<$X) ||($x+$vx+$w>$X+$W) ||($x+$vx<$X) ||($x+$vx>$X+$W) || ($y+$vy+$h<$Y) ||($y+$vy+$h>$Y+$H) ||($y+$vy<$Y) ||($y+$vy>$Y+$H)} { set TL [winfo toplevel $win] lassign "[winfo rootx $TL] [winfo rooty $TL] [winfo width $TL] [winfo height $TL]" X Y W H incr W $X incr H $Y } return "$X $Y $W $H" } proc get_gtk_params { } { global w if {! [llength [auto_execok xrdb]]} { return 0 } set pipe [open "|xrdb -q" r] while {[gets $pipe ln] > -1} { switch -glob -- $ln { {\*Toplevel.background:*} { set bg [lindex $ln 1] } {\*Toplevel.foreground:*} { set fg [lindex $ln 1] } {\*Text.background:*} { set textbg [lindex $ln 1] } {\*Text.foreground:*} { set textfg [lindex $ln 1] } {\*Text.selectBackground:*} { set hlbg [lindex $ln 1] } {\*Text.selectForeground:*} { set hlfg [lindex $ln 1] } } } close $pipe if {! [info exists bg] || ! [info exists fg]} { return 0 } set w(selcolor) $hlbg option add *Entry.Background $textbg option add *Entry.Foreground $textfg option add *Entry.selectBackground $hlbg option add *Entry.selectForeground $hlfg option add *Entry.readonlyBackground $bg option add *Listbox.background $textbg option add *Listbox.selectBackground $hlbg option add *Listbox.selectForeground $hlfg option add *Text.Background $textbg option add *Text.Foreground $textfg option add *Text.selectBackground $hlbg option add *Text.selectForeground $hlfg # Menu checkboxes option add *Menu.selectColor $fg option add *Checkbutton.selectColor "" option add *Radiobutton.selectColor "" Dbg "Gtk default visual options established" return 1 } ############################################################################### # Mac platform-specific display stuff # Note: The 'Dbg' used to be a DBoxProc setting (which is/was ALSO Modal) # When we added $modal to be able to CHOOSE, we had to DROP its use # (which was FINE as it also slipped into "no-longer-recognized") # SO - we either tell Aqua about MODAL windows or we tell it nothing - # Tclers Wiki reference page "Aqua Toplevels" has broken refs or we would # have tried to pick an explicit NON-modal style keyword (if there is one) ############################################################################### proc setAquaDialogStyle {toplev modal {err {}}} { if { !$modal || [catch {tk::unsupported::MacWindowStyle style $toplev moveableModal} err]} { Dbg "if modal($modal) then MacWindowStyle moveableModal failed? {$err}" } } proc get_aqua_params {} { global w # No longer invoked as of Tk8.6 # since it now uses the OS's lignt/dark themes appropriately # Keep everything from being blinding white option add *Frame.background #ebebeb userDefault option add *Label.background #ebebeb userDefault option add *Checkbutton.Background #ebebeb userDefault option add *Radiobutton.Background #ebebeb userDefault option add *Message.Background #ebebeb userDefault # or else there are little white boxes around the button "pill" option add *Button.highlightBackground #ebebeb userDefault option add *Entry.highlightBackground #ebebeb userDefault Dbg "Default AQUA visual options established" } ############################################################################### # Report the version of wish ############################################################################### proc about-wish {} { global tk_patchLevel set version $tk_patchLevel set whichwish [info nameofexecutable] set about_string "$whichwish\n\nTk version $version" popmsg $about_string info "About Wish" } ############################################################################### # Report the version of diff ############################################################################### proc about-diff {} { set whichdiff [auto_execok diff] if {[llength $whichdiff]} { set whichdiff [join $whichdiff] set cmdline "diff -v" catch {eval "exec $cmdline"} output set message "$whichdiff\n$output" } else { set message "diff was not found in your path!" } popmsg $message info "About Diff" } ############################################################################### # Throw up an "about" window. ############################################################################### proc about-TkD {} { global g set title "About $g(name)" set text { $g(name) $g(version) $g(name) is a Tcl/Tk front-end to diff\ for Unix-like & Windows platforms, and is originally Copyright (C) 1994-2006 by John M. Klassa, among others: Copyright (C) 1998 by Bryan Oakley Copyright (C) 1999-2001 by AccuRev Inc. Copyright (C) 2004 by Tom Dunne Copyright (C) 2004-2025 by Dorothy Robinson ("dorothyr") Copyright (C) 2017-2025 by Michael-M ("vampm") Many of the toolbar icons were created by Dean S. Jones and used with his\ permission. These icons have the following Copyright: Copyright(C) 1998 by Dean S. Jones dean@gallant.com http://www.gallant.com/icons.htm http://www.javalobby.org/jfa/projects/icons/ Others not coverred by the above are the work of Michael-M This program is free software; you can redistribute it and/or modify it\ under the terms of the GNU General Public License as published by the\ Free Software Foundation; either version 2 of the License, or (at your\ option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT\ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or\ FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License\ for more details. You should have received a copy of the GNU General Public License along with\ this program; if not, write to the Free Software Foundation, Inc., 59\ Temple Place, Suite 330, Boston, MA 02111-1307 USA } set text [subst -nobackslashes -nocommands $text] do-text-info .about $title $text } ############################################################################### # Throw up a "command line usage and concepts" window. ############################################################################### proc help-concept {mode} { global g pref set usage { $g(name) $g(version) may be started in any of the following forms(1-4): (Note that a FSPEC is either a file, directory or a Subversion- style URL; optional parameters are documented here in [brackets]) (1) Interactive selection of files to compare: tkdiff (2) Plain files: tkdiff FSPEC1 FSPEC2 (3) Plain file containing conflict markers: tkdiff -conflict FILE (4) Source control: (any of: AccuRev, BitKeeper, ClearCase, CVS, Git, Mercurial, Perforce, PVCS, RCS, SCCS, Subversion, Vpath) tkdiff -rREV1 [-rREV2] FSPEC1 [FSPEC2] tkdiff [-rREV1 [-rREV2]] (Search: CVS, Git or Subversion) tkdiff OLD-URL[@OLDREV] NEW-URL[@NEWREV] (Subversion) Additional optional parameters: -a ANCESTORFILE -@ REV (of Ancestorfile - if coming from Source control) -o MERGEOUTPUTFILE -L LEFT_FILE_LABEL [-L RIGHT_FILE_LABEL] -P PreferenceFilename (only when configured) -I RegularExpression (ignore matched-lines) -B (ignore empty-lines) -R (recursive Directory Tree searching) -1,-2 (preferred default merge side) -d (debugging output) } set text { Description (any references to GUI elements will be as shown here) $g(name) on its surface, appears as a tool to display and draw ones attention\ to modifications that have apparently occurred over some period of time\ by comparing two "states" of what began as an ORIGINAL text file. These\ modifications can be thought of as "differences" between any two data\ "states" of that file. But $g(name) as a TOOL, is about more than just\ presenting this picture of a files evolution over time. As a TOOL, it\ also is designed to help create yet MORE variations of a file, by\ selectively CHOOSING to "keep" some differences (or 'diff's), while\ simultaneously NOT "keeping" others. This is called "Merging" and is\ actually $g(name)s primary purpose. Classically speaking, a 'diff' is a directed comparison of two text\ files that describes what would need to be changed to convert the first\ such file content into the second. $g(name) therefore groups its\ parameters as specified into a "Left" and "Right" pairing based on their\ repetition on the command line. Thus the first\ FSPEC encountered is usually the "Left" and the\ next would be the "Right". Revision specifications work similarly. However, $g(name) often infers an argument (be it\ 'Filespec' or 'Revision') to satisfy the need for TWO items to compare.\ Some inferences are simple, such as when one FSPEC is a\ FILE, and the other is a DIRECTORY; it infers the same NAMED file from\ the directory as the FILE that was already specified. Similarly, if no\ second FSPEC is provided, $g(name) will attempt to access\ a Source Code Management system (SCM:\ see below) to provide the missing item, but in this particular case, it\ will ALSO force such item to be the "Left", or first,\ element of the comparison. Beyond this pairing convention,\ each parameter is independent of others on the command line. Ultimately,\ all "Left" args are collectively used to specify the item(s) to compare\ to item(s) collectively formed by "Right" args. Unfortunately, this\ "pairing" technique can be up-ended somewhat when using URLs\ because of their ability to specify not only a FSPEC, but also a REV\ simultaneously. $g(name) treats a FSPEC at a slightly higher\ precedence than a REV when parsing the arguments and it absolutely will\ not fracture a URL@REV which may make it\ challenging to anticipate which entity specified will end up as "Left".\ This can be mitigated somewhat by not using the "@rev" syntax\ offerred by a URL, and simply specifying it individually, however,\ formulating the command line parameters is, as always, up to you. In the first form(1), $g(name) will almost always present a dialog\ to allow you to choose the items to diff (subject only to a preference\ setting '$pref(autoSrch)' described in the Help\ menu "On Preferences" page). This dialog, known as the New... Diff dialog, provides an\ interactive means of specifying the majority of command line parameters.\ Because the command line appears to offer such things as\ "tilde" and/or "glob" notations, AND furthermore owing to the extremely\ interactive nature of this Dialog, it warrants its own\ detailed description which can be found within the Help menu\ topic On GUI under the heading\ "The New Diff Dialog". For now, just know it not only provides\ for simple parameter data entry, but constantly analyzes what such data\ implys to the remainder of $g(name) INCLUDING which of the\ four forms shown above will be honored! In the second form(2), either or both FSPECs may be to a local\ file or directory, or symbolic links to such. When a directory is\ involved, only its contained FILES sharing a common name will be paired\ together, one from each originally given FSPEC. Note that\ this CAN produce multiple pairs of files to be Diff'ed (if\ both were directories). $g(name) remembers all of them, and permits\ switching among them later. Generally, only the files of the given directory are\ considered as possible candidates, depending on the value of the\ other FSPEC: when that is a FILE,\ only a single comparison will result. Yet, when trying to\ use a URL in this form (versioned or not), be advised that the OTHER\ filespec will not be accepted as a directory unless\ such directory is KNOWN to Subversion, (ie. the Working Copy).\ See form(4) below for more details. However, when both FSPECs (or a singleton, which would\ technically be a form(4) occurrence), is/are real directories,\ another possibility occurs, as to whether said directory(s) should be\ searched recursively or not, producing a TREE of FILE\ candidates. From the command line, this distinction is answered by the\ presence (or lack thereof) of the option '-R', but is also\ dependent on a viable preference setting\ ("$pref(egnSrchCmd)") having been established. See the\ Help topic On Preferences for further details. In the third form(3), a single FILE containing "conflict markers"\ will be split into two (or three) temporary files and used as ordinary\ input by $g(name). Such files can be generated by external tools such as\ "merge", "cvs", "vmrg", or even\ "diff3 -m" and perhaps others. Note that the\ '-conflict' flag is also available on the dialog (via the\ hidden grouping), but the corresponding FSPEC1\ must then also be an actual FILE, or\ the setting will be ignored. Note that if the conflict file CONTAINS\ appropriate internal "markers" that indicate a THIRD file was involved,\ $g(name) will configure itself to process in what is called,\ 3-Way Diff mode, using the third derived file as an Ancestor. The fourth form(4) is conditional on $g(name) being able to detect a viable SCM\ system (see below). It can further depend on the presence (or perceived\ NEED) of a Revision value - to distinguish it from a form(2)\ request! However, make note that if it DOES, find a SCM, it\ may effectively override the first form as described earlier\ (i.e. interactive startup). Presently only "CVS", "Git" or "Subversion"\ SCM systems will behave this way, when invoked with no arguments as is\ suggested in this form(4) as syntactically possible. The determining\ factor (as to accessing the interactive dialog or not) is controlled by\ the preference setting '$pref(autoSrch)', more fully\ described in the Help topic On Preferences page. Remember that besides the explicit specification of REV\ arguments, $g(name) interprets a LACK of TWO Fspecs as an\ implicit request for additional assistance from an SCM. Under\ certain circumstances, this presumption might not be what was\ INTENDED, leading to complaints of "insufficient input", where the REAL\ issue is that $g(name) has detected a potential SCM which\ then FAILED to locate a tracked file, where what was DESIRED was to\ treat the FSPECs as just FILES (or DIRECTORIES) which in the\ command line circumstance, can only be accomplished by adjusting the\ setting "$pref(scmPrefer)" to tell $g(name) to ignore the\ detected SCM, OR using the New... dialog to prefer the pseudo\ SCM setting "None". See the section "Source Code Management" below\ concerning further details on how SCMs are detected. User Preferences Practically everything in $g(name) is customizable and as such, those settings\ are paramount to making the most of what can be done with its usage.\ While $g(name) comes reasonably configured out of the box (specifically\ for the "Diff" engine), personalization to your own taste, or even to a\ given Projects expectations are all reasons why just ONE set of\ customizations may be insufficient. You might wish to review the details (in the Help topic\ On Preferences page) of how to adjust your runtime environment\ to take advantage of the capability to have MORE than just a\ single personal Preference file. Note that as delivered,\ $g(name) does not provide this feature, nor its companion\ command line option ("-P"), until the specific configuration\ action is taken by the user, as described on that page. Source Code Management In all the SCM forms, $g(name) will detect which SCM system(s) are possible.\ This detection supports RCS, CVS and SCCS by looking for a directory\ with the same name, although RCS can also be detected via its ",v" file\ naming suffix convention. It detects and supports PVCS by looking for a\ vcs.cfg file. It detects and supports AccuRev, Perforce, ClearCase and\ Vpath by looking for the environment variables named ACCUREV_BIN,\ P4CLIENT, CLEARCASE_ROOT and VPATH respectively. It detects Git by\ looking for a .git directory, but will only work when started from within\ a Git work-tree. Similarly, Subversion looks for a .svn directory, except\ when using URLs, expecting any FSPEC to reside within a\ recognized "Working Copy" (WC). Mercurial is\ supported by looking for a directory named ".hg" in the\ FSPEC directory or any of its ancestor directories, which\ is also how .svn and (for the most part) .git are searched. It is important to recognize that several detections are based on the\ provided FSPEC(s), or alternately the "Current\ Working Directory" (CWD) where $g(name) was\ invoked, and at MOST times, BOTH! Often this can necessitate invoking\ $g(name) from within the "Sandbox" (a synonym for "WC")\ which are the actual files and directories that the specific SCM is\ actively tracking. This implicit use of the CWD is often instrumental in\ making a given SCM interaction not only detectable, but functional. On the other hand, often depending on the specific SCM involved, this\ tendency to detect an SCM from its FSPEC pathname, or the CWD can IMPLY a\ SCM where one was not WANTED. This is why the $pref(scmPrefer)\ preference provides a special value of "None"; effectively\ preventing the detection when it was not wanted in the first place. Just\ know that this flag is available as either an actual\ preference (used every time) or as a ONE-TIME override (via its selection\ from the New... dialog). In practice, the dialog approach is\ often the simpler mechanism to use. REV1 and REV2, when given, must be a valid revision value\ for FSPEC. When the SCM system (RCS, CVS, etc.) is detected\ (see above), but no revision number is given, FSPEC is\ compared with the "default" revision (as defined by the\ specific SCM); often the most recently checked in. Again, multiple\ pairings may still be possible, if FSPEC was specified as\ a directory; where each would then attempt to use the same\ revision. For some SCMs, (those that expect every file to have its OWN\ revision, eg. SCCS or RCS) this can be problematic, unless the given\ revision format were to be something interprettable by that SCM as\ universally applicable, such as a "date". Revision values are generally peculiar to a specific SCM. For example, a Git\ REV (see manpage for git-rev-parse) offers several unusual\ variations: FILE [compare with HEAD by default] -r HEAD FILE [compare with HEAD] -r HEAD^ FILE [compare with parent of HEAD] -r HEAD~5 FILE [compare with 5th parent of HEAD] -r HEAD~20 -r HEAD^ FILE [compare 20th parent and parent of HEAD] -r 29329e FILE [compare with commit 29329e (full/partial SHA1)] -r v1.2.3 FILE [compare with tag (UNTESTED)] $g(name) does not, itself, do anything with the value other than pass it along. Because there are two FSPECs there can also be potentially two\ distinct SCM systems. Although most people will only ever need to\ deal with one SCM system for a given situation, there IS\ an unusual arrangement possible that offers a distinct advantage. For example, presume you use Subversion, or any other network-based\ repository, but will be unable to assure a viable network connection\ for some stretch of time. One solution would be to create a RCS\ subdirectory and post local modifications to it (avoiding the network)\ until such time as you can once again contact the server, at which point\ you can reinstate whichever RCS version you wish to send to Subversion\ using $g(name) to confirm exactly which changes you want current. Even with just a single SCM system, you may have multiple WCs,\ representing perhaps different branches of the same code, and wish to\ fabricate a merged file as a hybrid of the two versions. $g(name) can\ address BOTH simultaneously, thus allowing the hybrid to be constructed. Special SCM circumstances While most SCM systems are generally some form of database with some method of\ designating unique "revision" identifiers, one, "Vpath", is really nothing\ more than a structured set of directories whose names are given as a list\ within their similarly named environment variable (VPATH). As such, its\ revisions are implied by the linear position each directory\ occupys. Each such directory in the list represents an earlier\ revision of whatever files it contains, thus when $g(name) needs an\ additional 'version' of some Fspec to create a pairing, it\ searches down the list finding the first-matched filename as the needed\ "predecessor" file. Some people like to think of this as a 3-dimensional\ filesystem, but its most important properties are that the topmost\ directory (under which $g(name) is invoked) is what other SCMs would\ consider its Sandbox, and EACH directory need only have the files that\ are unique (ie. changed). Thus each directory represents a "changeset"\ across all the files it specifies collectively. This particular form of\ REVs are simply inherent in the "Vpath" implementation, and\ are never actually specifed as arguments. However, the CWD\ can interact with a stated VPATH in two important ways: 1. when the CWD matches a Vpath node OTHER than the topmost; and 2. when the CWD specifies a Subdirectory of the matched Vpath node. In the first case, any Nodes SKIPPED are treated as-if they were never\ mentioned at all. This enables reaching DEEPER into the version history\ by "top-pruning" the latest nodes. In the second, it establishes the\ named Subdirectory as the subset of versioned files of interest. Fspecs\ specified as outside BOTH adjusted containments are treated as NOT\ within the VPATH, and thus ineligible to be "found" as a pairing, despite\ being readily available as just a "plain file" Fspec. Additionally, some SCM systems provide abilities that can identify which of\ their files are different given only some set of\ desired revisions (including defaulted). $g(name), using its capacity\ for accepting multiple pairings, will attempt to access those utilities\ it knows of to obtain such as an input source. We call this the "search"\ or "inquiry" mode. SCM systems lacking this ability will simply reject\ any provided Revision arguments as inadequate with an error message. Note that given the lack of a FSPEC in this\ instance, such SCM utilities basically expect the CWD (of, in this case,\ $g(name)) to be within the "WC" of the files they manage.\ Thus the directory where you invoke $g(name) again plays a role, but\ was likely instrumental in getting that SCM to be detected in the first\ place, so should not be an issue. Accordingly, if fewer than two revisions are given\ and the SCM can accomodate it, inferred revisions will be\ supplied (generally the latest or HEAD, or similar). However, note that\ the Git SCM has an unusual arrangement in that an intermediate\ UNNAMED revision (referred to as the 'stage' or 'index') sits between\ the working copy and the last commit; $g(name) will allow you to specify\ this quasi-revision using a revision value of " " (blank) either on the\ command line or in the GUI dialog. Remember that on the command line this\ will require quoting (to be parsed correctly), the simplest being "-r ".\ For the dialog, the field label for the revision will be\ dimmed when it is EMPTY, as it would otherwise be difficult to actually\ SEE a legally enterred blank. Finally, when "inquiry" mode is active, it is entirely possible that one\ such detected difference might be a "conflict"ed file, as is\ often created when a prior SCM merge request was not fully completed.\ $g(name) will accept it as such, even when it is one of multiple files\ being provided, and automatically switch into "conflict" or even "3-Way"\ mode when later processing that particular entry, as needed. One last point about SCM systems - as described earlier, it should be apparent\ that owing to the many varied ways any one system might be\ detected, $g(name) needs to try ALL of them, albeit in some unseen order.\ Because $g(name) has existed for decades, often longer than many of the\ SCM systems themselves, that ORDER is more a case of historical\ randomness we mustn't change (to preserve existing usage), than of a\ well-reasoned rational choice. As delivered, $g(name) defaults the preference\ "$pref(scmPrefer)" to the value "Auto Auto", which will\ choose the first such SCM to sucessfully be detected for\ each of the two respective Text windows. You may need to tune one or\ both settings to the SCM you Prefer per each window if more\ than one system is detectable in the environment you run within, and the\ one you want, doesn't happen to come out as "first".\ For the record, this internal precedence ORDER is presently: CVS SVN GIT BK SCCS RCS PVCS Perforce Accurev Clearcase HG Vpath with only detected systems participating. This admittedly arbitrary\ looking order MAY have had a reason when each was added to $g(name), but\ if so, the explanation was never noted, and is thus lost to history. A quick word about quoting Most command environments, a Unix/Linux Shell for example, offer multiple\ means of quoting (such as single or double quote characters). As a\ general rule, any $g(name) option flag that takes a value\ (such as a REV or others) may be specified as directly\ prefixed to that value, or separated by "white space" (blanks, tabs,\ etc.). However you must not try to pack multiple\ $g(name) flags into a single parameter as they will not be\ recognized as such by $g(name), and would thus likely be passed directly\ to "Diff" or whatever other differencing engine has been configured,\ as is. See the section "The Diff engine" below for further specific rules. Limitations of URLs Besides Subversion being the only SCM to "define" the usage (and syntax) of\ URLs for accessing the remote repository, there are other issues their\ existance causes to the general semantics of $g(name) insofar as their\ tacit use as a FSPEC. First is their ability to additionally specify\ a revision. $g(name) will ensure that the revision STAYS with the URL,\ even if it means jumbling the apparent command line order of arguments\ and what that might mean to which entity ends up as 'Left' .vs. 'Right'.\ Separating these aspects ON THE COMMAND LINE, may make predictability\ of what ends up where easier for experienced users. Lastly, because\ $g(name) has no ability (at present) to determine exactly WHAT the URL\ may point at, trying to treat a URL as naming a directory (to take\ advantage of pairs generation, etc.), EVEN IF IT ACTUALLY DOES, will\ not be honored as $g(name) expects the URL to name a FILE! Perhaps this\ may be addressed in the future, but for now - thems the rules! One final point about the Subversion URL: while there are multiple forms\ of Revisions (an ever increasing integer value, various keywords (HEAD,\ BASE, PREVIOUS and COMMITTED) and even a DATE format, only HEAD appears\ to be valid when using a URL! Accordingly, while filename\ based access will default to using BASE, when a\ URL is used, that default will become HEAD! Expect\ to see access failures using other Revison forms WITH a URL specification! Requesting a 3-Way diff A "3-Way" diff is most often used for merging a file that different people\ may have worked on both independently and\ simultaneously, back into a single file. Just as\ files for comparison are designated with some combination of a FSPEC\ (and possible REV value), an ANCESTORFILE may be specified as a\ third file using the "-a" option to designate it. To be useful, this file should be a version that closely\ predates BOTH versions being compared/merged. If using an SCM to track\ past versions, also specifying the "-@" option will provide\ the necessary REV value to obtain the proper file. Note however, that\ should $g(name) detect that the Ancestor file happens to be\ identical to EITHER of the other two, "3-Way"\ mode will be discontinued and instead treated as a simple two-file\ comparison. A notification of this happening will be provided. Additional hints With regard to inferred SCM revision fields, invoking $g(name) with no viable\ arguments at all MAY result in either an SCM\ trying to supply such args OR presenting the interactive\ dialog. However, when an SCM is detected and searched, but\ results in not finding any files to compare, often only a\ termination message will be produced. This is even MORE likely if\ $g(name) was started WITH ARGUMENTS from the command line; whereas if it\ was initiated via the interactive New... dialog, $g(name)\ will issue the message and then TRY to return to the dialog to perhaps\ adjust the settings to values that DO function. It is NOT recommended to specify an\ ANCESTORFILE, MERGEOUTPUTFILE or more than two\ "-L File-label" options when using any form that will resolve\ to more than a single diff pair (i.e. generally when a\ directory FSPEC is paired against anything but a\ FSPEC that is a single FILE). It will likely\ produce undesired results, an example of which is outlined as\ follows: When the merge output filename is not specified, $g(name) will present a\ dialog to allow you to choose a name for that file when attempting to\ write it. This is actually the simplest method of operation. If you\ do choose to provide a name (via the command line\ or the New... Diff dialog window) $g(name) will\ try to honor it. But there is a strong possibility you may\ be asked to reconfirm that name OR be presented with an\ entirely new name when you attempt to write to it. This generally occurs\ when $g(name) detects that multiple file pairs are in use, which would\ result in cross associating the single given merge output name to an\ indeterminate file pairing. Thus $g(name) then reverts to "suggesting"\ its own name. Of course, you may at that point then choose\ whatever filename you wish. In a similar fashion, many of the "Additional optional parameters"\ shown are intended for use when $g(name) is invoked to process a\ SINGLE file pair, as was its original historical heritage. As a further note regarding the $g(name) "suggested" merge file\ output names, be advised that $g(name) will try to fabricate a name that\ derives from the filename used in the Left window, unless that file\ itself derives from an SCM system, in which case it will try to choose\ its name from that of the Right window. When BOTH windows represent SCM\ files, it will aim for the current directory that $g(name) was invoked\ from, but the default name chosen would then be based from a fairly\ cryptic tempfile name which almost certainly will need renaming.\ Regardless of the default name presented, you may, of\ course, place the output in any filename you designate. The remaining options perform the following services: Both -B and -I RegularExpression are intended to\ suppress differences from EMPTY or RE-matched lines respectively, and\ you may specify the "-I" option more than once. Each operates\ as described by the GNU Diff documentation, but are part of $g(name)\ itself and NEITHER is passed to the Diff engine (thus making them usable\ by any such engine). The mutually exclusive options -1 and -2 allow\ one to suggest to $g(name) which side (Left or Right, respectively),\ should be chosen during initial read-in as the contributing\ merge side for any diff region for which $g(name) cannot discern a reason\ (such as in a 3way ancestor-file situation) to choose one versus the\ other. Oftentimes the intent of the merge (back porting, etc.) and\ the order of files on the command line can dictate which file should\ be treated as the contributing "source" for the eventual merge outputs,\ such that the majority of merge choices will be "pre-selected"\ for you. In fact, it is possible to toggle this value\ after-the-fact if you find that the left-to-right order of the\ files did not turn out as you expected; simply invoke\ New... Diff, flip the setting and allow $g(name) to redo that\ difference computation, then proceed to make the fewer number of needed\ merge choice assignments. Debug output (-d), while not really\ meant for the average user, is simply mentioned here for completeness\ sake. When used, it produces somewhat cryptic textual output via the\ STDERR output stream showing significant status and/or mileposts with\ varying degrees of usefullness to those familiar with $g(name) internals. Network latency $g(name) does not, itself, require network access to run. However, certain\ SCM systems are based on such technology and can thus introduce delays\ in the processing performed by $g(name). In fact, a network\ outage could even hang $g(name) while waiting for a response. To help combat that possibility,\ particularly at tool startup, $g(name) may alert\ you that such a delay appears to be occurring. A popup status panel, in\ advance of the main $g(name) display, will present messages of\ activities occurring. As long as new activities continue to occur\ (perhaps every few seconds), no action is needed on your part. However, be advised that should the messages stall and you attempt to\ dismiss this panel, you are, in fact, requesting that\ $g(name) ABORT completely. This feedback mechanism is intended to simply provide you with interim\ updates until sufficient information can be obtained to present the main\ display. Under normal conditions, no such messages are needed nor\ produced, and $g(name) will remove the status display itself\ when the main display is ready. The Diff engine (and more quoting) Although $g(name) was designed as a frontend to the classic, UNIX derived,\ "diff" command, there is no specific reason some other utility meeting\ its input/output and invocation requirements cannot be used. Because of\ this, $g(name) can be configured to interoperate with other differencing\ engines, some having perhaps more advanced (or desireable) detection\ methods. Prior to $g(name) V5.5, the primary requirement for such engines\ was it must produce what GNU Diff called "normal" diff output\ format (NOT "Unified" NOR "Context"). This is NO LONGER TRUE.\ $g(name) now accepts Unified format automatically with no\ further user action required ("Context" remains unsupported). With regard to telling the Engine what optional features it should\ perform, $g(name) always communicated these via "comand line options"\ and still does, although it has become more formalized via an Engine\ configuration section added to, and described in, the\ On Preferences topic of Help. This should be\ consulted for details when deciding to use an Engine OTHER than the\ default UNIX-derivative "DIFF" command. Because this "option flag" method is ALSO how one invokes $g(name), it\ is POSSIBLE for options intended for the Engine to be supplied via the\ $g(name) command line as a simple way to augment the operation of the\ current $g(name) session. The only requirements are it needs to be a flag\ that $g(name) does not, itself, recognize AND must parse as a SINGLE-WORD! Accordingly, any option flag having a leading dash that is not\ recognized as a $g(name) option is passed virtually untouched\ to your Diff engine of choice. This "pass through" feature permits you to\ temporarily alter the way the Diff engine is called,\ for the entire session, without resorting to a change in your\ preferences file or settings. However it also means that to use, for\ example, the "-d" option for GNU diff (which is a $g(name)\ option), you would need to pass it using its long-form equivalent of\ "--minimal" (to avoid the mis-interpretation). Just be aware, that should you make preference changes that ALTER the\ use of ANY flags currently being passed from $g(name) TO the Engine,\ this special "pass thru" option will be removed and no longer\ in force, UNLESS specifically re-enterred via the preferences dialog.\ The best way to think of this, is to believe that specifying a random\ option from the $g(name) command line is EQUIVALENT to having added it\ to the current session VIA the preference dialog - and thus any FURTHER\ preference changes (related to the options PASSED to Diff) is simply\ responding to your new changes (which never knew the temporary option\ was ever present). BUT as a related issue, trying to pass any option that\ requires a value MAY necessitate an unusual form\ of quoting to preserve syntactically required "white space" characters.\ As noted earlier, if the value portion has NO blanks and is permitted to\ be physically attached to its option flag, no special action is required. But if the value itself requires a "space" -or- must be SEPARATED from\ its option flag by one (to satisfy the parsing rules of the Diff engine),\ then you should pass the entire construct within double quote\ characters, and perhaps even doubly so. As an example,\ GNU diff has an option whose syntax is: -I, --ignore-matching-lines=RE Admittedly, this option is a $g(name) recognized option (at least\ via the "-I" flag) and thus would not be passed on to the engine, but it\ can illustrate the issues involved. Thus if something similar\ WERE to be passed to tell Diff (in this example) to not\ consider any line that starts with a octathorp (#) followed by a space,\ you might think to specify this to $g(name) as either : "--ignore-matching-lines=^# " (or better "-I^# ") or "-I \"^# \" " (or "-I {^# }") Note in each case, the quoting of BOTH the flag and its value\ together. But particularly, in the second form, note the extra\ quoting (done with escaped double quotes or "brace" characters as shown)\ surrounding the value as well; this demonstrates how to pass a flag that\ MUST be separated from the value it passes. Be aware that single\ quotes will NOT work here. The "brace" character is simply the\ lexical mechanism used by the internals of $g(name) to quote its content\ where potential "substitutions" are to be avoided. Without this 'extra'\ quoting as shown, $g(name) would pass the option, but the\ resulting Diff would MISS the trailing blank of the value. The reason is primarily that $g(name) has no true syntactic\ understanding of nearly ANY flags being passed to the engine, nor\ if they might legitimately require a value, or need said value to be\ separated from its flag while still preserving any embedded\ blanks. Yet, certain flags ARE understood (notably the classic Engine\ options that deal with difference suppressions) and are provided for by\ the Engine configuration section of the preference settings,\ to address these specific syntactic concerns. Recommended reading! IMPORTANT NOTE - from a $g(name) perspective, this example GNU Diff\ option should never be passed to ANY diff engine\ ... it was designed to make the direct output of Diff itself\ more meaningful to a human by simply suppressing what is,\ in reality, actual differences. Besides, the functionality\ can be PROVIDED by $g(name) itself (VIA the recognized "-I" flag).\ $g(name) will fail badly if you were to perhaps\ sneak THIS option to Diff (using its long-form flag name).\ You have been warned. } set usage [subst -nobackslashes -nocommands $usage] if {$mode == "cline"} { puts $usage } { append gui "Command line" $usage [subst -nobac -nocom $text] do-text-info .usage "$g(name) Concepts + Syntax" $gui } } ############################################################################### # Throw up a help window for the GUI. ############################################################################### proc help-GUI {{mode {}}} { global g pref set DOLLAR {$} ;# TCL quoting trick embeds a literal dollar sign into text set title "How to use the $g(name) GUI" set topic1 { (Disclaimer: Historically, $g(name) had provided support [meager though\ it was] for Monochrome displays. As of release V5.1, such support has\ been withdrawn entirely. While it is possible to re-instate\ it, the ready availability and/or cost of Color monitors makes doing so\ unlikely). Layout The top row contains the File, Edit, View,\ Mark, Merge and Help menus. Note that\ on some platforms, common practice is to relocate this menubar to a\ specific screen location, often the top of the display. This happens\ automatically on such platforms, and is not peculiar to, nor caused by\ $g(name). The second row is a toolbar having diff-region management,\ search, navigation and merge selection tools, each represented by either\ a symbolic image or just text to convey their specialty. Below that are\ labels which identify the contents for each of the two text windows that\ follow just below them. Note that these labels will also\ produce a "tooltip" popup (a brief description) showing the ACTUAL\ filename and its modification time when hovering over it with the mouse,\ provided it is not a tempfile (such as extracted from a SCM). In addition, if an ANCESTORFILE was specified at startup, a\ third label (a small graphic denoting a text file labelled "A") will\ appear between the other two labels. It also will display a tooltip\ indicating its underlying name, and possibly its modification\ time, the latter based (again) on the file not having been\ extracted from an SCM or not. But in reality it is also a\ button that when pressed, will popup a display only\ presentation of that Ancestor file, for those who simply have\ to be able to see it. To the left of EACH Text window is another (optional) narrow window of the\ same height, known as the INFO window, in which additional data\ ABOUT the individual text lines can be displayed, such as its line\ number and various markers or highlighting that $g(name) will provide\ based on yet further settings and/or its analysis. Toggling the\ $pref(showln) menu item of the View Menu controls\ if this window is present, as does changing its setting as a Preference. The left-most text window displays the contents of FILE1, the most\ recently checked-in revision, REV or REV1,\ respectively (as per the startup options described in\ the "On Concepts+Syntax" help). The right-most window displays the\ contents of FILE2, FILE or REV2,\ respectively. Clicking the right mouse button over either of\ these windows will give you a context sensitive menu with actions that\ will act on the window you clicked over. For example, if you click\ right over the right hand window and select "Edit", the file displayed\ on the right hand side would be loaded into a text editor. Outboard of\ BOTH Text+INFO windows are conventional vertical scrollbars, with\ horizontal ones located below their respective Text windows, which\ can be operated independently or synchronously at the users preference.\ Between the two text windows is an optional display known as\ the "Diff Map" which serves not only as a graphical overview of\ where ALL the difference regions exist across the\ entire file, it will also behave as a conventional vertical scrollbar.\ The View menu item "Show Diff Map" specifies if\ this display element is actually shown onscreen or not, as you choose.\ And finally, located between the two horizontal scrollbars, is what is\ called a "grip" which can be dragged horizontally with the\ mouse to re-distribute the relative screen space allocated among the\ Left and Right windows themeselves. Following all these MAY be an optional two line window called the\ "Line Comparison" window. This will show the "current line" from each of\ the Left and Right text windows, one on top of the other. This\ "current line" is defined as the line that shows the blinking "insertion"\ cursor, which can be set by merely clicking on any line in either text\ display and/or "driven about" utilizing numerous keyboard accelerators.\ The entire window may be hidden (or requested) by the View\ menu item "Show Line Comparison Window" being chosen, or not,\ as desired. At the bottom of the main display is the Status bar, where tool activity and/or\ informational messages of various sorts will display from time to time.\ At the far right edge of this bar, are two dedicated displays; the first\ is a stylized count of the number of merge choices that presently select\ either the Left or Right version of each Diff Region. These values will\ be modifed as choices are made within the tool. As such, it serves to\ suggest how much MERGE work is at potential risk of loss, should a NEW\ execution of "Diff" take place. The second is a COUNT of the regions that presently exist (and if any,\ which region is "current" - ie. the "CDR"). The SUM of the\ Left/Right merge choices at times may not equal the TOTAL of\ all regions, as some regions COULD be set to select BOTH sides, which is\ NOT counted. The merge counts are additionally a reminder of which side\ is providing the bulk of the merge selections, which might signal the\ need to toggle the "$pref(predomMrg)" preference, BEFORE\ expending the time to review and make individual selections. } set topic2 { The New Diff Dialog Beyond the main display window, there exists a Dialog window describing the\ input parameters $g(name) was provided, either via the command line,\ or by having this very window PRESENTED when $g(name) senses it lacks\ sufficient (or perhaps, unsuitable) input parameters. The Dialog itself\ is highly interactive where nearly every user manipulation\ results in the Dialog displaying or hiding elements, recalculating\ pertinent values, and even monitoring keystrokes and providing highlight\ feedback as to whether an in-progress file specification being\ typed is acceptable. Because of its desire to emulate all inherent abilities of\ the (historical UNIX) command line, it also provides for such things as\ "tilde" and/or "glob" notation; basically typing shortcuts for specifying\ file-system based names, to avoid the drudgery of typing the WHOLE\ literal path. There are 3 defined 'tilde' shortcuts that ALL\ work ONLY when they are the FIRST character of a file path: 1. a SINGLE tilde (~) is replaced by the users HOME (aka login)\ directory 2. a tilde-minus PAIR yeilds the most recent PRIOR current\ directory visited, and 3. a tilde-word group considers word to be a UserID and\ supplies its HOME directory. 'Glob', on the other hand, is a PATTERN-match syntax where\ you can describe portions of the desired name, rather than\ TYPING them literally. Notably, an asterisk (*) stands for any number of\ characters (except a forward-slash), while a question mark (?) represents\ any single character. There are others such as\ [bracket] sets for a single SPECIFIED char from the\ enumerated set, but the trait they ALL share is they only combine (with\ other literal characters) within any single fragment of an\ overall path name, delimited by forward slashes. Note that these "features" are a natural consequence of that (original)\ command line environment (commonly called 'the SHELL') itself,\ but are so ingrained that NOT providing them via the Dialog would be\ perceived as a penalty. Sadly, attempting to USE "Glob"ing WILL NEVER work when combined into a\ URL syntactic form, NOR can you "Glob" a UserID - but it wouldn't have\ worked from the SHELL command line either!\ Yet, the SHELL ability to expand (so-named) Environment Variables\ (eg. ${DOLLAR}HOME/.../...) has NOT been replicated for the Dialog. While the command line uses repetition exclusively to distinguish "Left" and\ "Right" parameter instances, the dialog obviously expects such values to\ be filled in a similar "Left first" order; as a reminder,\ entering a value (such as a FSPEC or REV) into\ the "second position" while the "first" remains empty will\ result in a red warning highlight of the (possibly) mis-positioned value;\ you may, of course, enter values in any order you wish: it is, after all\ only a reminder, which will disappear when both are populated. However, simply because you entered the value into the second\ position, will not ensure that it LOGICALLY remains there if\ you fail to populate ANYTHING into the first position. In such\ a case, $g(name) will interpret the given value as belonging\ to the first position and will apply its command line\ "pairing" rules accordingly. The same applies to Revision data enterred,\ although not when BOTH FSPEC fields have data present. Another distinction of the dialog is its presentation and adjustability\ of the SCM that will be used if and when the command syntax\ requires one. Where the command line operates purely by preference\ settings, the dialog allows you to adjust the final interpretation\ within the bounds of all presently entered parameters, which\ is to say the dialog will continually readjust as values are enterred\ or removed. In fact, even the simple act of TYPING into either FSpec (1 or 2)\ or Ancestor fields may cause an immediate highlight to occur on that\ fields LABEL! The intention of this highlight is to help you\ recognize when the name as currently shown, represents an\ ACTUAL filesystem-named entity, be that a FILE, DIRECTORY, or (to a limited\ degree), a URL! The color of the highlight is patterned on a conventional stoplight\ paradigm, where YELLOW (really, whatever color was defined by the toolwide\ preference "$pref(inform)") signifies the name is NOT (yet)\ recognized as real: generally, you need to keep typing.\ But if it should be Red, continued typing MAY\ not help, as it signifies what is ALREADY entered can easily\ NOT produce a real entity name! You are thus reminded (via a\ popup message) to PERHAPS backspace and try again. In general, a RED highlight means the problem stems from a\ tilde related issue (such as typing something that is NOT YET\ the intended UserID. You can continue typing to complete the\ name, as long as you don't type a fragment-delimiting\ slash character BEFORE completion. Doing so will result in the\ popup message re-appearing AND THE SLASH WILL NOT BE ACCEPTED! This "hard" error is a recognition that IF the slash were\ allowed, the file name typed thus far can NEVER be found or used by\ $g(name), regardless of what might be typed afterward. But other situations exist. For instance, because $g(name) permits 'Glob'\ syntax (described earlier), its possible you entered something that could\ actually match MULTIPLE real items AT THAT fragment\ level in the name, which is considered mildly illegal: your\ GOAL here is entering something that resolves to a SINGLE item\ name ONLY! Accordingly, trying to enter a forward-slash at such a point\ would again be treated as a hard error - but\ because its NOT tilde related, the highlight would only be YELLOW. Note\ however, that continued typing where earlier Glob-fragments MAY have been\ overly loose in their specification (eg. a single asterisk), the nature\ of evaluating an entire PATH of further fragments, can quickly narrow the\ scope of that earlier fragment DOWN to being a SINGLE possibility,\ provided the later fragments become more and more distinctive! And there\ is yet even MORE to consider. In addition to both "Tilde" and/or "Glob" syntax, there is the extremely\ twisted notion of a REAL filename that BEGINS (within SOME\ directory fragment) with an ACTUAL literal tilde! $g(name) WILL PERMIT direct access to such a name, from that\ current fragment, provided it does NOT actually\ duplicate an ACTUAL Userid (from which it would be\ indestinguishable)! $g(name) will ALWAYS prefer the "Tilde"\ interpretation (if it works) over that of a "plain old tilde-filename"! There are various reasons for this choice, but the most compelling one is\ that OUTSIDE of $g(name), the SHELL environment would invariably make the\ same choice, making it exceptionally difficult to MANIPULATE such files\ until one realizes that it can be SUBVERTED by prefacing the name with a\ DOT-SLASH prefix (./) thereby causing the "tilde" to no longer\ BE the first character of the PATH. While this SAME work-around IS VIABLE for $g(name) as well, in practice,\ remembering to ALWAYS protect such a filename becomes tedious, and thus\ $g(name) while allowing such names, would highly NOT recommended their\ use - and while $g(name) will often get it right, YOUR environment\ OUTSIDE of $g(name) can easily get it WRONG, ALWAYS believing it\ represents SOMEONES HOME directory. So why mention all this? Because you may be a user who OPERATES from a command line! And while\ this Dialog will watch over what you type AS YOU TYPE IT, the command\ line and the SHELL running at that point, will DELIVER such names fully\ formed (admittedly having handled both Tilde and Glob itself, when\ it can); some may LEAVE unexpandble names intact and simply pass\ them as-is. But if $g(name) sees the name is\ unusable, IT will deliver you directly to this Dialog to FIX\ the problem, without you having TYPED anything! Thus where the dialog\ would have prevented you from compounding your errors with extra\ (useless) path fragments, the problem could NOW be as far\ back as a leading tilde. ONE WAY to dodge this issue could be\ to prefix the tilde with the dot-slash (./) as already described; but\ NOW that you are sitting IN the Dialog, your best action might be to\ just Backspace until the highlight DISAPPEARS -or- just USE one of the\ BROWSER options to rewrite the whole filename by navigating to and\ PICKING a replacement (as will be described shortly). Lastly, there is no 'green' in this semi-streetlight analogy;\ in its place, is merely NO highlight at all. This is what you are aiming\ for when typing, as trying to OK the Dialog with\ "invalid" names (as suggested by the highlights) will most\ often result in SOMETHING-not-found messages elsewhere in\ $g(name), and a good chance of finding yourself BACK in this Dialog! One final detail, involving URLs, is that until the 'protocol'-delimiter\ (://) can be seen, $g(name) will THINK its watching a file\ name being typed with its YELLOW highlight just asking for more - but\ once seen, the highlight will disappear, SUGGESTING it thus\ 'exists' - but that cant actually be determined:\ you simply MUST finish entering it correctly. But even ALL THAT is not the end of the Dialogs perception of what you wish to\ accomplish. A heretofore hidden button, Recurse\ Directory can appear allowing you to choose if the currently\ enterred FileSpecs, where both (or only the first, with the second empty)\ are directories to specify if it/they should be searched\ recursively or not, producing a TREE of FILE candidates.\ Pressing it toggles it on (or off) with highlighting for\ feedback. Note that if the equivalent command line option (-R) was\ ALREADY given, the button may appear as already activated.\ Yet, one last point - if the button displays as disabled\ (regardless of showing as activated) it will not function,\ and is simply reminding you that the NEEDED preference setting\ ("$pref(egnSrchCmd)") has not yet been established. Still, one of the clear advantages of the dialog, besides the instantaneous\ reaction to individual argument adjustments, is the ability to "Browse"\ to files or directories, although typing always remains valid.\ In contrast to the preference-controlled 'automatic' search mode of the\ command line (see $pref(autoSrch) setting in the\ "On Preferences" Help page), requesting that mode\ via the dialog is handled via a checkbox, that will only be presented\ when conditions indicate it is possible. Please note that most of the "Additional optional parameters"\ are available from the dialog, but are initially hidden from\ view, as they are often not applicable except in special cases. If you\ need to set them, press More to view them but\ do not re-"hide" them (by pressing Less) before\ clicking the OK button on the dialog as hiding them\ ALSO causes them ALL to become completely unset.\ Lastly, those items not provided for within the dialog ('Ignore...'\ settings, etc.), or really ANY of the\ "Additional optional parameters" listed may still be provided on the\ command line without forfeit of invoking the dialog. } set topic3 { Recognizing and Selecting the CDR All difference regions (DRs) are typically highlighted to set them\ apart from the surrounding text, unless the "$pref(tagtext)"\ preference has been deselected. The current difference region,\ or CDR, is further set apart in the Left text window so that\ it can be correlated to its partner in the other (that is, the CDR on\ the left matches the CDR on the right). This "correlation" is most easily\ seen by requesting that the CDR be "centered" in both text windows,\ either on demand: using either the popup menu, toolbar button, or keyboard\ accelerator hotkey; or by choosing an applicable user preference such as\ "$pref(autocenter)", which when paired with\ "$pref(syncscroll)", will cause both Left and Right CDRs to\ nearly always be aligned as well. You can read more about\ these and other preference settings in the Help menu topic\ "On Preferences". The CDR can be chosen in a sequential manner by means of the Next\ and Previous buttons. Similarly, the First and\ Last buttons allow you to quickly navigate to the\ first or last CDR, respectively. For random access to the DRs, use the\ dropdown listbox in the toolbar or the diff map, described below. By clicking right over MOST windows and using the popup menu you can select\ Find Nearest Diff to find the diff region nearest the point\ where you right-clicked, or simply double-click either on or\ near an existing DR, as a shortcut to the same result. As double-clicking over the Text window can ALSO be interpretted as a\ request to "select" a word in that window, you may perform the\ double-click over the INFO window (if displayed) NEXT to the line(s)\ that comprise the equivalent lines of its text window to AVOID the\ selection process. HOWEVER, note that using Find Nearest Diff\ from either the popup-menu OR by double-clicking when clicked OVER the\ "Diff Map" is interpretted differently BECAUSE the content\ of the Map represents the entire file and not just the lines\ that appear to be adjacent on either side of it. It is THAT position\ in the file where the search for the "nearest" DR will begin. For keyboard-centric power users, be advised that causing $g(name) to nominate\ a new CDR will cause the text display "insert" cursor to immediately\ jump to that CDRs first line. Accordingly, you might benefit from making\ some minor adjustments to the "Text widget options" preference\ setting (specifically adding "-insertbackground color" and\ "-insertwidth numberOfPixels") with appropriate values to make\ it easier to see the location of this critical piece of many\ keyboard-based operations. Operations 1. From the File menu: The New... item displays a dialog where you may choose two files\ to compare. Selecting "Ok" from that dialog will diff the two files. Be\ advised that this is the same dialog as may appear when $g(name) is\ started with no command line parameters given, and its described\ behavior there is the same as invoking it from this context (see the\ help topic "On Concepts+Syntax" for specific details). Next, the File List item will only be active when the current\ $g(name) command parameters yeilds more than a single pairing of files\ to compare; pressing it produces a submenu that gives access to the list\ of the other available comparisons. Depending on how lengthy that list\ might be, it may be shown directly in the menu itself, up to\ an adjustable maximum of 25 names. When that is the case,\ choosing one re-initializes the display by performing a Diff to the file\ pair thus selected. The names themselves are only the "Left"-side files,\ but they represent both of the paired files being compared.\ Note that after choosing an item, the background of that item\ will henceforth be red or green when the mouse hovers over that item,\ based on whether that pairing was successfully read into $g(name). When\ no color is shown, that item has NOT yet been accessed.\ List items may require noticeable time to load\ if the files each represents requires network access to be processed;\ however, once loaded, subsequent reloading is entirely a local task. When the submenu does NOT display the files, the FIRST entry\ of the menu will read "Choose File..." which, in turn, causes\ a popup window to be displayed containing the list. The operation of the\ list is the same regardless of which (menu or popup) is in use. Remaining\ items on the submenu simply select either the Previous File or\ Next File relative to whatever file was current. However,\ there is an additional control on the popup that permits you to\ adjust the threshold value that $g(name) should use in\ determining which form of the list to provide. As this threshold is also\ a user preference ("$pref(fLMmax)"), more details are available in the\ help category "On Preferences", including recommended uses. For the case where files ARE shown in the submenu, the\ Choose File... item becomes renamed to\ Reconfig Threshold... allowing you to switch to using the popup\ list at your discretion. Note that because the list presentation depends\ on the current number of files, performing a New...\ Diff, may fall above or below your present threshold. The Recompute Diffs item recomputes the differences between\ the two files whose names appear above each of the two text display\ windows. The Write Report... item lets you create various text\ report files that can contain information content of your choosing from\ the text windows(s). In addition, simply visiting the dialog to compose\ your report will provided detailed statistics on the breadth and\ complexity of the differences between the current file pair, which will\ automatically be included in any such report created. You may, of course,\ choose to not produce ANY report, and simply view the\ statistics. For more information about the reports themselves, see the\ section "Report Generation" presented later. Lastly, the Exit\ item terminates $g(name). 2. From the Edit menu: (be advised that many items of this menu are ALSO included as toolbar buttons, further described under section 8 below. It is recommend you read BOTH) Copy copies the currently selected text to the system clipboard.\ Find pops up a dialog to let you search either text window\ for a specified text string, but see additional details in section #8\ below. Ignore CDR allows you to designate the\ present CDR as no longer being of any concern whatsoever to\ $g(name). It can be used for those situations where it would be\ otherwise dangerous to attempt to automatically\ ignore the Diff region by some rule (such as implied by the\ Ignore RE-matched Lines mechanism of the View menu\ described shortly). Split... and Combine... pops\ up a dialog that allows you to rearrange the CONTENT of the CDR to\ isolate specific lines, facilitating specific merge file generation\ goals. It should be noted however, that these last three operations\ ("Split", "Combine", and "Ignore") are LOCAL to $g(name) itself; meaning\ that each represents work performed by you to adjust the\ result of the most recent Diff, generally in pursuit of some\ "Merge" goal. Such work is ONLY VALID until such time as a\ mergefile is written out (to lock the work in place) or a subsequent\ Diff is run by any means to effectively cancel\ such work! See the upcoming sub-heading Merging for further\ info. Edit File 1 and Edit File 2 launch an editor\ on the files displayed in the left- and right-hand panes.\ Preferences pops up a dialog box from which display\ (and other) options can be changed and saved. 3. From the View menu: This menu is organized into a few sections, the first of which deals with\ how the output from the diff engine can be tuned or interpretted.\ Utilize Suppressions toggles whether certain user preference\ defined options should (or not) be used when invoking Diff. Both of\ Ignore Blank Lines and Ignore RE-matched Lines\ in turn, toggle an ability to suppress (basically NOT notice or\ highlight) any difference region identified by the engine that is\ exclusively comprised of the indicated category. Lines that\ otherwise seem to match, but have been "grouped" by Diff into a larger\ difference region are NEVER suppressed. IMPORTANT: toggling any of these settings will cause $g(name)\ to immediately re-invoke the diff engine so as to provide\ the requested interpretation. This will cause the loss of\ any merge work that may have been in progress at that time. For this\ reason, when the keyboard or mouse is positioned to select any of them,\ they will be highlighted to remind you of this impending loss. In the second section are items controlling what information gets\ displayed within the tool itself. Both $pref(showln) and\ $pref(showcbs) toggle the display of line numbers and\ markers (respectively) in the text displays. Show Diff Map\ toggles the display of the diff map (see below) on or off.\ The Show Line Comparison Window item toggles the display of a\ literal two line over/under "line comparison" window near the bottom of\ the display. As an alternative to that, the two mutually exclusive items\ Show Inline Comparison (byte) or\ Show Inline Comparison (recursive) will display the specific\ interline differences as configurable highlighting directly\ within the Left and Right text displays themselves. You may\ choose any combination, at any time, as suits your comprehension needs. HOWEVER - be advised the (so-called) 'recursive' method is particularly\ compute-intensive, which is at odds with being an interactive\ tool; you may notice a slight hesitation as these appear on screen. This\ is normal, and wiill complete often within a single or more second(s). Yet\ owing to the nature of how such interactive response is provided, its\ POSSIBLE the display may MISS a specific hilite situation if you happen\ to be SCROLLING when it decides the calculation is required. DO NOT\ PANIC - simply toggle the View menu item\ Show Inline Comparison (recursive) OFF and back ON, and the\ missing Hilites will appear. The third section addresses automatic processing that can be performed\ as other interactions in $g(name) take place.\ If Synchronize Scrollbars is on, the Left and Right\ text windows are synchronized i.e. scrolling one of the windows scrolls\ the other. If Auto Center is on, jumping (by whatever means)\ to a new CDR centers that new CDR automatically. Auto Select\ will attempt to designate the diff region currently closest to the\ middle of a scrolled Left/Right text window AS the new CDR;\ however, only when $pref(syncscroll) is also ON.\ Furthermore, if the window is in the process of being manually\ scrolled (via a mousewheel or driving the insert-cursor about the screen\ by way of keyboard actions), Auto Select will continue to\ operate, yet Auto Center (if active) will be temporarily\ suppressed, to avoid fighting over what (or who) should control scrolling. The fourth (and final) section basically reiterates simple navigation\ actions available elsewhere (toolbar, popup menu) for moving among the\ various diff regions. 4. From the Mark menu: The Bookmark Current Diff creates a new toolbar button that will\ jump to the current diff region. The Clear Current Diff Mark\ will remove the toolbar mark button associated with the current diff\ region, if one exists. When created, each is labelled with the index of\ the present CDR (as depicted in the first tool on the toolbar - see\ below in subsection #8). Be advised that during Split or\ Combine\operations (described shortly), or ANY\ operation that would recompute one or more DRs, these "bookmark" buttons\ may automatically be cleared, but only when they are\ directly involved. 5. From the Merge menu: The Show Merge Window item pops up a window with the current\ merged version of the two files. This will be described further in a\ later section called "Merge Preview" below.\ The Write Merge File item (or possibly the\ Write Merge File...) will allow you to save the contents of\ that window to a file. Pay special attention to the existance of those three trailing dots when\ electing to write the Merge File (either here OR from the\ buttons on the dialog itself) - if they are NOT present,\ it means $g(name) already knows what filename to produce,\ (i.e. from the command line) and you will not be given a\ chance to confirm or alter that name. 6. From the Help menu: The About $g(name) item displays copyright and author\ information. The On GUI item generates this window. The\ On Concepts+Syntax item displays help on the $g(name) command\ line options and syntax, but also includes discussions on topics\ related to tool startup such as initiating a particular run-mode or\ interactively supplying the command arguments. Lastly, user-settable\ preferences help is provided via the On Preferences item. 7. From the Popup menu: The Popup menu is generally available over the majority of individual windows\ comprising the "Left/Right" aspects of the overall display, activated by\ the, so-called "menu" button of the mouse. Each of the operations it\ provides is available elsewhere, although it can be convenient to have\ the mechanisms "close by" during operation. It is a "context sensitive"\ menu in that not every operation is ALWAYS available, depending on WHERE\ the original popup request was made. Yet each item still performs the\ same functionality as the other locations (toolbar, keyboard, mouse)\ would have. This functionality consists of all the toolbar navigation\ choices (First, Last, Next, Previous, Center) CDRs, plus a selection of\ others such as Find, Edit and "Copy Selection" (to the clipboard), along\ with the earlier discussed "Find Nearest Diff". Just dont expect to ask\ to "Edit" one of the files, when popped-up over the Diff Map... you NEED\ the context (where you popped-up) to hint at which SIDE, thus which file,\ is being requested! 8. From the toolbar: (Be advised that in these explanations, the button descriptions refer to the\ textual name ON that button as would be seen when\ the user preference to "$pref(toolbarIcons)" is unset.) The first tool is a dropdown list of all of the differences in a standard\ diff-type format (prefixed with a simple consecutive index number).\ You may use this list to go directly to any diff\ region. Further navigation tools will be described in due turn.\ Proceeding left-to-right, the next tool, Rediff, simply\ re-computes the diff of the CURRENT two files from scratch as if it was\ a new Diff. This could be appropriate if you have invoked an editor on\ either file since starting and now wish to see the net effects of your\ editting; just recall that doing so will cause the loss of\ pending interactive work such as merge choices, Splits, and\ so forth. The next tool Ignore will cause the CDR to no\ longer be treated AS a DR; it is a interactive method not\ unlike those that perform a similar service based on command line flags\ that match either a empty or regular-expression defined line. The next\ two tools, Split and Combine, each provide\ complimentary abilities to adjust the boundaries of the CDR. The reasons\ for doing this are further explained in the section below on Merging. The remaining tools on the toolbar consist of the Find tool\ for searching the text for a given word or phrase. Because of its\ ability to search EITHER Text window independently, it will IGNORE\ any setting of "$pref(syncscroll)" while active, and instead\ use the Stay Sync'd toggle ON the search panel itself. When\ subsequently dismissed, synchronization will revert back to the prior\ established value; further, any scroll operations performed DIRECTLY on\ the windows themselves will continue to be governed by that same master\ setting. Following this are, in order, groupings of tools dealing with merge\ choice selections, navigation, and lastly a Bookmarking facility for\ remembering specific diff positions so that jumping among them does\ not require memorization of somewhat meaningless numbers. These, among\ other topics, will now be further detailed. (Editors note: The next physical group of tools ("Merge:") will be deferred until after the others, as it is predicated on understanding practically ALL of the others and how they may interact - besides being a complex topic in its own right). Navigation tools Adjacent to the label Diff:, the Next and\ Prev buttons take you to the "next" and "previous" DR,\ respectively; just as the First and Last buttons\ take you to the "first" and "last" DR. These actions will also\ affect the Merge Window (when displayed). The Center button\ centers the CDRs in their respective text windows. You can also set\ Auto Center in Preferences (or via the\ View menu) to do this automatically for you as you navigate\ through the diff regions. Dont forget that the dropdown list (the first\ tool on the toolbar) ALSO provides movement to any\ DR, as well. Even Bookmarks (explained shortly) can do the same. Keyboard Navigation When $g(name) has the current keyboard focus, you may also use the following\ (global default) keyboard shortcut keys: ^[ (Ctrl-Bracketleft) Load NEXT file pair ^] (Ctrl-Bracketright) Load PREV file pair c Center current diff f First diff l Last diff n Next diff p Previous diff e Load a text editor with the 'current' file ^f (Ctrl-f) Find some specified piece of text ^r (Ctrl-r) Recompute Diffs of current file pair ^q (Ctrl-q) Exit $g(name) immediately 1 Elect Left as the CDR Merge Choice 2 Elect Right as the CDR Merge Choice 3 Elect Left-then-Right as the CDR Merge Choice 4 Elect Right-then-Left as the CDR Merge Choice There are, of course, other keyboard operations that apply as well, such as\ platform specific keys to invoke a "button", but all such keys (including\ ours) each require a concept known as "keyboard focus" to be properly\ located on the object which is intended to respond. The windowing toolkit\ (Tcl/Tk in our case) defines most of these, as it does the means of\ assigning such focus (pressing 'Tab' or 'Shift-Tab') to switch\ among such items capable of responding. But while the\ "keystroke-to-action" relations (aka. bindings) defined by Tcl/Tk are\ nearly always targetted at a given type of "widget", those of\ $g(name) are more "global" in nature, mostly only requiring the current\ focus to be somewhere within the "main" window. That is not to say that ambiguous situations are impossible. Most notable\ of these is the "e" (edit) Hotkey: assuming the current focus\ is associated with anything having a suitable "Left" or\ "Right" connotation (such as a text display or scrollbar) that will\ dictate which file is accessed. Failing that, $g(name) will look at where\ the Mouse currently rests and retry using its position (such as when the\ focus is on a toolbutton). For this reason, it is generally safest to use\ the popup menu to invoke the editor, ensuring the desired file is loaded.\ However, note $g(name) DOES add one "extra" builtin hotkey\ which is: Return Make the closest diff range become the CDR where closest means the range closest to the 'insert cursor' in the text\ window having the active keyboard focus only. It is important to emphasize that these are only the DEFAULT hotkeys\ as defined by $g(name) before any customizations or applied preferences.\ Prior to Version 5.1, these values (well, most of them) were\ hard-coded and non-customizable. That is\ NO LONGER THE SITUATION! But, due to concerns over accidental\ loss of in-progress work from a simple keypress, the "Control"-modifier\ has been added to the historical bindings of "r" and "q", AS\ defaults; you can, after all, now re-instate or alter them as\ you see fit. See the section entitled "Behavior" under the\ Help topic On Preferences for the details on\ choosing your own settings. In addition, the cursor keys, Home, End, PageUp and PageDown work as\ expected, affecting the view in whichever Text window has the focus.\ Note that, as expected, if $pref(syncscroll) is set in\ Preferences, and the keyboard actions imply scrolling, both\ will scroll simultaneously, despite these keys only affecting the insert\ cursor of the presently focussed window. Scrolling To scroll the text widgets independently, make sure\ $pref(syncscroll) in Preferences is off. If it is\ on, scrolling either text widget scrolls the other. Scrolling will not\ change the current diff region (CDR) in this condition, nor will it cause\ the Merge Window (if displayed) to scroll. A Mouse scroll-wheel is also\ recognized for scrolling vertically, or, if the Shift key\ is simultaneously pressed, horizontally, as well. Book Marks Located adjacent to the label BkMark:, you can set "bookmarks" that\ identify specific diff regions, primarily for easier navigation.\ To do this, click on the Set bookmark button when the desired\ DR is currently the CDR. It will create a new toolbar button\ that will jump back to this specific diff region when pressed. To clear a diff mark, first make that DR the CDR, then click\ on the Clear bookmark button. Each is labelled with the\ sequence number of the DR it represents. Note however, that because\ Split or Combine can both manufacture or\ destroy specific DRs, it can become necessary for $g(name) to\ "Clear" a given bookmark. The same can be said for Ignore.\ Only those specific markers involved are affected; however, any marker\ carrying a label beyond any addition or contraction of DRs\ will always have their labels 'adjusted' accordingly to\ maintain their originally designated region association. The actual Bookmark buttons themselves, will appear in whatever remaining\ space exists on the righthand side of the toolbar. However, should you\ create more than the available space can handle, $g(name) will provide a\ pair of "scroller" buttons to enable you to create as many as needed, yet\ still be able to access them as required. These "scrollers" will\ auto-repeat when pressed-and-held with the mouse, deactivating when the\ designated end-of-the-list is reached, and disappearing altogether when\ no longer needed. Bookmarks are created, and are maintained, in the order you\ choose to manufacture them. Thus those created earlier will be nearer the\ Left edge of all bookmarks available. As mentioned earlier, each is\ labelled with the DR sequence number it represents, but if it is\ important to have a more-permanent "identity" for the given\ DR, you can right-click the bookmark and select annotate from\ its popup menu to assign a short description of your choosing. This\ naming, like the default one internally assigned, will be displayed in\ the Status bar whenever the mouse hovers over that bookmark.\ Note however, that despite naming a bookmark, the bookmark is still\ susceptible to being deleted. The other item on the bookmark-button menu, is a toggle,\ in report, that can be used to designate the DR to participate\ (or not) in a specific Write Report... feature that allows you\ to include only those DRs that have been "tagged" for inclusion. In this\ fashion, you can document only the specific changes you choose to\ identify, perhaps to illustrate some particular issue in addressing how\ best to resolve it. Report Generation $g(name) can output various textual forms of the same data as viewed in the\ main display windows. At the present time, this does not\ include the many various forms of "highlighting" rendered by the tool\ directly onscreen. Nonetheless, the data can be assembled in several\ different combinations from the full text of BOTH (or either) side(s);\ or only the "difference regions" (again for either side), and even just\ SELECTED DRs (courtesy of the "Bookmark" menu options). When\ presented with the dialog to make your choices, you will also be shown\ statistics on the magnitude of the DRs in various breakdowns. This same\ set of data will form part of the Heading within the report, which also\ includes the file names (with applicable modification timestamps where\ possible) and, of course, the date the report is generated. It is even\ permitted to get just the header information with NONE of the actual\ file content as the output. While an output filename is provided by default, you may retype it OR\ use the Browse... to specify a replacement. Note however that\ regardless of your simply "taking" the default or typing (or RE-typing)\ a replacement, $g(name) will verify that the name provided is "safe" to\ write to, meaning that if it refers to an existing file,\ you will be given the opportunity to change or confirm it via the\ provided file browser window. Diff Map The diff map is a graphic index of where all the diff regions exist. It is\ shown in the middle of the main window if Show Diff Map on\ the View menu is on. The map is a miniature of the file's\ DRs from top to bottom. Each DR is rendered as a patch of color;\ initially Delete as red, Insert as green and Change as blue and in the\ case of a 3-way merge, overlap regions, called "collisions" are marked\ in yellow. These colors are simply the defaults provided by $g(name),\ and can be adjusted via the Preferences... item in the\ Edit menu, to perhaps compensate for better contrast or\ spectrum adjustments given other objects onscreen with your particular\ monitor (or simply personal taste). The height of each patch corresponds to the relative size of the diff\ region. A transparent "thumb" lets you interact with the map as if it\ were a scrollbar, and Mouse scroll-wheel actions are fully supported,\ but will be directed to whichever of the two text windows is\ holding the current input focus, if the windows are not synchronized.\ All diff regions are drawn on the map even if too thin to ordinarily be\ visible. For large files with small nearby diff regions, this may result\ in patches overwriting each other, due to scaling issues. Merge Preview To see an ongoing preview of the file that would be written by\ Write Merge File, select Show Merge Window in the\ Merge menu. A separate window will be shown containing the\ preview. It is updated as you select merge choices, and provides markers\ that remind you as to which side (Left/Right) is presently contributing\ its region into the result. Note that when viewing a choice such as the\ Left-side of an "add"-type, or the Right-side of a "del"-type CDR,\ there is nothing to actually display. Additionally, the\ Preview window is responsive to the current $pref(showln)\ preference setting. It is also synchronized with the other text widgets\ when Synchronize Scrollbars is on, at least as far as actions\ that change the CDR, however it does not actually\ scroll in unison with the other windows, primarily because as\ a representation of the eventual Merge file, it does NOT HAVE any of the\ padding lines which accounts for a substantial amount of the\ vertical spacing being scrolled by the other windows. Merging To merge the two files, go through the difference regions (via Next,\ Prev or whatever other means you prefer) and select\ L (for "Left") or R (for "Right"), located\ adjacent to the toolbar Merge: label, assigning which side\ should be used for each. Alternately, the "1" & "2"\ (default) hotkeys will do the same, respectively. The initial selections\ (after invoking Diff) will have already been established by a user\ preference and/or whether a 3way (involving an ancestor file) was\ performed (explained further in the section "3way merging"\ below). Selecting L means that the the left-most file's version of\ the difference will be used in creating the final result; choosing\ R means that the right-most file's difference is used. Each\ choice is recorded, and can be changed arbitrarily many times.\ If you need pieces from BOTH the Left AND Right versions you may choose\ the LR or RL (Left-then-Right or\ Right-then-Left, respectively) choices instead, but then you\ must remember to eventually edit the merged result AFTER you\ commit it to disk. This might be useful, for example, if both\ variations should exist with additional wording, or in the case of source\ coding, a conditional inclusion macro, surrounding the entire result. To\ commit the final, merged result to disk, choose\ Write Merge File from the Merge menu, or one of the\ Save buttons provided on the dialog (if it is displayed).\ Remember that each of these items may be labelled with a trailing "..."\ if $g(name) is uncertain of what the target filename should\ be, thereby providing a file browser dialog to either specify and/or\ confirm the name. Merging - in more detail Oftentimes, you may find that the "Diff" engine has packed several lines\ worth of differences into a large chunk, simply because it never found a\ common line that BOTH files could agree was the SAME in both\ files. Yet only a SINGLE defined difference region (a CDR)\ can have its Left or Right side chosen for merging at any one time.\ As a side note, "context" and "unified" diff output formats tend\ to exacerbate this problem, and is part of the reason we dont generally\ like them as a data format, although we DO allow them,\ automatically deconstructing them into the equivalent "normal" format.\ Nevertheless, this is the "problem" that Split or\ Combine are intended to address. Using these tools, you will\ be permitted to repartition the exact lines that should be treated as\ a distinct difference region. In each case, you start from some specific\ CDR, and then either break it apart into smaller pieces ("Split") or\ reassemble it ("Combine") at line boundaries of your choice. A dialog window is provided to oversee the movement of the CDR boundary\ edges, with feedback provided in the Text windows. You need only to\ click on arrows to adjust either or both edges in the Left or Right\ text window displays until satisfied that the NEW CDR\ describes the change content you wish to convey. Be aware these arrow\ buttons will automatically advance if you press and hold\ instead of clicking, making it easier to adjust a large expanse. Note that only legal edge motions are ever permitted,\ and the buttons will automatically deactivate as necesssary. Most\ actions will make a visible change in highlighting as seen in the main\ text windows. One specific highlight is worthy of extra explanation,\ however. When performing the movement of an edge during a "Split"\ operation and that edge begins "pushing" against its opposing\ edge, movement will STILL occur. But because the highlighting that\ was representing the middle region of the three, will have\ NOW been squeezed shut, that highlighting will then be\ represented by a different shading of the LOWER of the TWO edges that\ sit on opposing sides of the demarcation of the two remaining regions.\ Backing off one step, in either direction however, will\ "re-open" that center region and revert its associated highlighting. As the dialog is in complete control of the text windows at this point,\ it will also control scrolling the window as necessary to keep the edge\ being moved visible. When a moving edge gets within two\ lines of the top or bottom of the window, the window will be scrolled\ to maintain that visibility. This can be disorienting when the DR is\ exceptionally large. Because of this FORCED individual scrolling of\ the windows, even in the presence of options to request\ "$pref(syncscroll)" or "$pref(autocenter)",\ BOTH Split and Combine will automatically\ RESTORE the view per those settings when they terminate, regardless\ if that is a successful or cancelled operation. Once accepted, $g(name) will treat the new difference region exactly\ the same as any other, despite the fact that it appears run together\ with other adjoining regions, having NO common line to separate them.\ The power of this is that two modifications, having NOTHING to do\ with each other beyond proximity, can thus be merged (or not)\ INDIVIDUALLY as needed. Given that many version control\ systems prefer that only those lines pertinent to a specific logical\ change reside in a given 'patch', these features allows the user to\ surgically distinguish one logical change from another. Note that ONLY a previously Split region, can ever be Combined,\ provided you do NOT choose to Ignore CDR\ some portion of it in the interim. Note further that $g(name) will\ always assign each line of the original CDR into an appropriate region\ (creating and/or removing existing regions as necessary), and\ automatically assigning its type (add/change/delete). If you have difficulty envisioning which edges to move to accomplish\ a specific goal, think of the edges as defining 3 individual regions\ per side of data: Above-the-CDR, the NEW CDR, and Below-the-CDR. Then\ remember that changes always flow from the left side to the right. Thus\ when a Left side region has a zero size, the corresponding Right side\ region is being "added". Conversely, if a right-side region describes\ zero lines, the left-side region describes a "delete". Regions that BOTH\ have lines are simply "changes". Note that only REAL lines (those having Line numbers, when shown) are\ ever counted toward the occupancy of the regions. Padding lines\ (displayed to align CDRs on screen) mean nothing despite their being\ highlighted as part of a CDR, and will be stepped over as\ edges are moved. Finally, remember that any changes YOU might\ make to any CDR content is transitory, and only exists within $g(name)\ until the next time any "Diff" is invoked, even a Rediff. This\ suggests that before beginning any merge work, you shoud ensure that all\ settings or menu choices that adjust or interpret the Diff results\ (predominate side, ignored blanks/lines), or worse, those that might\ trigger a new Diff invocation if they are changed,\ have all been configured appropriately. ALL interactive merge work\ (including Split/Combine and Ignore) is transitory until the merge file\ is actually written out, and can not be automatically\ recovered; only reconstructed! 3way Merging A 3way merge, as the name suggests, involves a third file that is expected\ to have been an earlier common version to both\ files presently being compared. Providing this ancestor file\ will cause an icon to appear between the normal Left/Right\ file labels on the display (indicating the mode is in force and\ permitting viewing access if absolutely necessary) and thereby\ allow $g(name) to look backward in time, to address the unique issue of\ intentionally diverged independent modifications (the Left\ and Right files) being merged back together into a single output file. Specifically, $g(name) wants to identify the modifications that\ created the Left and Right variants, with the intention of\ preserving ALL such changes (both sides) into the final\ result, as automatically as possible. Thus, among the Left/Right diffs\ being shown by $g(name), certain lines may, or may not, have been\ modified during their creation from the ancestor. We call these\ ancestral artifacts, and $g(name) will annotate such lines\ using markers to the left of the line numbers (if displayed), denoting\ what kind of modification (add, chg, del) had previously occurred. Note\ that ancestral deletions technically no longer\ exist in their respective Left/Right files, and thus were\ effectively and implicitly embedded into those files at that time. HOWEVER, given the notion that "merging" is supposed to be the proper\ inclusion of BOTH sets of changes, that would\ mean Deletions must also be fully included. Accordingly\ if only ONE side were to delete a specific line, the failure\ of the OTHER side to do the same, suggests that the decision to remove\ the line in one version and not the other is questionable, and is no\ different than the case of Adding a line in one version and not the\ other. Because of this, $g(name) WILL PROVIDE an ancestral\ artifact on lines that were NOT deleted as they were by the\ opposing version; to remind the user that choosing one side versus the\ other when merging is not always just a "simple" choice. To distinguish a "Deletion" artifact from an Additive one, $g(name) will\ display such items in inverse video AND as Capitalized. Just\ remember that the inverse video is signalling that the ancestral\ Deletion - from the other side - decided the line SHOULD BE\ (and has been) removed, while the marked side says the line should\ remain - NOT that you the user should CHOOSE the side with\ the inverse mark to CAUSE the line to be deleted (which it would NOT do). Generally, when ancestral markers show up in ONLY the Left (or Right)\ windows, $g(name) simply responds by choosing that side as the initial\ merge choice for that region (except, obviously, for inverse Deletion\ marks). When BOTH sides show markers of the same\ type (regarding it being Capitalized .vs. NOT Capitalized) $g(name)\ selects the "Right" side as the merge choice, but also declares the\ region as a collision which requires user assistance to solve,\ highlighting it appropriately to draw it to your attention. As a further reminder, it will also highlight within the dropdown list\ of diff regions on the toolbar, which can thus be used to quickly locate\ these problematic areas, simply by scrolling throught the list looking\ for the highlighted items. Despite all automatic attempts to choose the proper merge choice,\ $g(name) does not and can not, itself, resolve arbitrary\ collisions. However, as it turns out, the Split tool, by\ repartitioning the region into distinct smaller regions, can often be\ used to resolve what we call simple collisions by\ ensuring only one side of each split portion carries markers from\ a single side (if possible). At such time, $g(name) will re-assign the\ affected merge choices appropriately, possibly eliminating the entire\ collision altogether. Because of this ability to remove a collision through direct user\ interaction using Split, $g(name) will also presume\ that independently choosing any manually selected merge\ choice, when dealing with a collision region is trying to\ accomplish the same goal, and will remove the primary\ indications (highlighting) of the collision, provided you\ agree via a popup question. Yet note however, that the responsibility in\ that case, is yours; $g(name) has no additional means to actually\ determine if the collision was truely resolved. Note that "resolved"\ regions are only ever de-highlighted from the Left and Right\ windows; the toolbar diff region dropdown list ALWAYS retains which\ regions were formerly collisions unless the region was fully\ resolved via the Split tool. Finally, remember that like all "adjustments" done after having run a\ Diff, all of it is entirely transitory until the Merge output\ file is generated, or another Diff is invoked, by any means. Original Author John M. Klassa Comments Questions and comments may be sent to the TkDiff mailing list at tkdiff-discuss@lists.sourceforge.net. Or directly into the Discussion forum at https://sourceforge.net/p/tkdiff/discussion } # Just hand newDiff Dialog only its PIECE of the larger description ?? if {$mode=="newDiff"} { return [subst -nobackslashes -nocommands $topic2] } do-text-info .help $title \ [subst -nobackslashes -nocommands [append $topic1 $topic2 $topic3]] } ############################################################################### # display help on the preferences ############################################################################### proc help-prefs {} { global g pref set title "$g(name) Preferences" set text { Overview Preferences control almost everything within $g(name): colors, fonts, what to\ highlight, algorithmic strategies, and even what information should be\ displayed (or not). $g(name) has a complete set of builtin values for\ it all, a builtin editor to modify them for the current session,\ and a way to PRESERVE the current values as a set\ into a file for use in future sessions: The Preference file. This file is automatically searched and (when found) loaded, every time\ $g(name) is invoked; and indeed even WHERE $g(name) will\ look for it is subject to your control. Preferences are located (by default) in your home directory (identified by the\ environment variable HOME.) If this variable is not set, the\ platform-specific variant of "/" (the system ROOT directory) will be\ attempted, although its more than likely you will be unable to SAVE\ anything to that location based entirely on write permissions. If you are on a Windows platform the default file NAME will\ be "_tkdiff.rc" and will be given the attribute "hidden".\ For any other platform this name is ".tkdiffrc". You may override the name AND location of this file by setting the\ environment variable TKDIFFRC to whatever filepath you wish.\ But thats not the end of your choices. While the description thus far\ has depicted the location of what is PRESUMED to be a file,\ and represents the default actions $g(name) will take on\ startup, the situation can be altered if that targeted location is,\ in fact, a Directory (except in the system ROOT variant). In this alternate case, $g(name) will look WITHIN that directory for the\ same base-name used to originally find the directory\ UNLESS a different name was supplied on the command line via\ the "-P filename" option. This permits you to have\ more than just the SINGLE set of preferences (YOUR default), should you\ need different settings when it comes to which SCM system to use, or the\ TAB-size for the files being examined, etc., etc. Note however, $g(name)\ WILL NOT create this target directory itself. That is YOUR task to\ configure. Without it, all you will have is a single Preference file,\ and the command line option (-P filename) will\ become ignored for this purpose; yet remember that options\ given on the command line NOT RECOGNIZED as belonging to\ $g(name) are automatically thought to belong to Diff itself. IMPORTANT: This can easily lead to invalid syntactic commands, and failed\ operations - in particular, any attempt to pass a PreferenceFilename when\ a directory is NOT in use will certainly fail! Lastly, please note that the "filename" in this context is\ NOT permitted to contain "spaces", regardless of being quoted or NOT on\ the command line. As hinted earlier, you may view, edit, locally apply and even save preferences\ (into whichever file was designated per above) from a provided dialog\ accessible via the Edit menu Preferences... item;\ note that the dialog titlebar will specify the individual Preference\ filename that will be subject to updating should you Save any\ changes. It is necessary to actually Apply any changes\ before attempting to Save them, as saving to the\ preferences file will only save the current\ setting values, and not those that may have been editted, but not yet\ applied. Should any individual setting be deemed unworkable, its\ prior value will most often be reverted AND a popup message\ produced. Dismiss, besides removing the dialog will also\ attempt to CANCEL any edits made after the most recent\ Apply. You will be asked for confirmation to proceed in this\ case, to give you the opportunity to Apply them before\ losing them completely. There is one small side-effect of Applying the preferences,\ and that is an unavoidable "re-balancing" of the Grip that is\ used for apportioning horizontal space among the Left and Right windows. Be aware though, that certain preferences, when subsequently\ Applyed, will cause $g(name) to immediately re-invoke "Diff",\ which will destroy any UN-SAVED interactive work\ (specifically any merge choices, "Ignore"d or "Split/Combine"d CDRs)\ to their initial states. The following descriptions will, among other things, identify which of them\ can exhibit this behavior; yet the characteristic each has in common\ is that they somehow involve either the "formulation" of the\ Diff command itself, or the "interpretation" of its\ results (eg. blank-handling, ignores, etc.). To remind you\ of the potential penalty involved, whenever a preference modification is\ made that would lead to an inevitable Diff INVOCATION,\ both individual items AND the Apply button will become\ highlighted. You may, of course, proceed at your own risk. However, as a\ safety net, should an Apply happen to encounter a "reverted"\ setting due to problems and ALSO note the need to Rediff,\ $g(name) will suspend that need and instead allow you to\ repair the failed settings. Besides a popup message to that\ effect, the Apply button itself will flash RED (briefly) upon\ detecting ANY errors (for which you will have already been notified).\ Conversely, if applying all settings has been successful, the button\ flash will be GREEN, in addition to any possibly visible\ changes you may observe in the main windows from your new settings. Preferences are organized onscreen into FIVE categories: General, Display,\ Behavior, Appearance and Engine. Yet, in the resulting file, they are\ kept in alphabetical order of the preference identifier key. But EACH\ will have the same descriptive labels (on screen, in this Help, or as a\ comment in the file). For the purposes here, they will be presented in\ their onscreen grouping and order. General $pref(diffcmd) This is the REAL command that will be run to create a diff of any two files.\ It is NOT a modifiable preference, at least not directly; It simply\ displays HOW the command is presently configured, to which $g(name) will\ append some pair of files. However, its "content" will respond\ to modifications made to OTHER pertinent preferences, including several\ that may reside in other sections of the dialog. As originally delivered,\ this will typically be "diff"; yet other differencing engines, providing\ other algorithms are possible. As this IS the prototype command $g(name) intends to invoke, when any implied\ modification occurs from manipulating OTHER preferences, the NEW value\ will be immediately highlighted, indicating that Apply WILL\ cause the newly configured command to be invoked. Should you need to\ review what the PRESENT value was BEFORE it was changed an hilighted,\ hovering the mouse over the item displays that value in the Status bar. $pref(xcludeFils) Whenever $g(name) is looking for file pairings within the file system, it first\ has to form candidate names, generally because the arguments it is\ working with are directories. This preference names one or more filename\ patterns which should NOT be considered for matching to produce\ a pairing. Simply seperate each pattern with at least\ one space, which implies the pattern itself CANNOT contain one. Note that\ it doesn't matter if the pattern matches an actual FILE or any other NAMED\ entity (eg. a directory) during the search - it is immediately skipped. Provides some level of control over what files $g(name) SHOULD find. $pref(tmpdir) The name of a directory for files that are temporarily created while $g(name)\ is running. This value is initially obtained from a somewhat platform\ dependent environment variable: Windows uses TEMP; and others, TMPDIR.\ However, the MacOS program-launcher ("Finder"), being a system-level\ tool, generally sets the TMPDIR variable with its OWN path (NOT a value\ suitable for the user/tool being launched); thus $g(name) initially will\ simply default to "/tmp" on that platform. You, of course, may override. $pref(editor) The name of an external editor program to use when editing a file (ie: when\ you select "Edit" from the popup menu). If this value is empty, a\ simple editor built in to $g(name) will be used, and will be positioned\ such that the current diff is visible. Windows users might want to set\ this to "notepad". Unix users may want to set this to "xterm -e vi" or perhaps "gnuclient". When run, the name of the file to edit will be appended as the last argument\ on the command line. Alternately, if the supplied value contains the\ string "\$file" (without the quotes), it's treated as a complete\ external command line, allowing any additional legal syntax, where the\ following parameters can be used: \$file: the file of the window you invoked upon \$line: the starting line of the current diff For example, in the case of NEdit or Emacs you could use "nc -line \$line \$file" and "emacs +\$line \$file" respectively. Or for VI, perhaps something like "xterm -e vi +:set\\\\ nu +\$line \$file" which opens VI in a separate\ Xterm window, loads the file at the designated CDR line AND causes line\ numbering within VI to be turned "on". $pref(ignoreRegexLnopt) An editable dropdown list of Regular Expressions that are used to identify text\ lines that should be ignored/suppressed (when possible, and activated)\ thereby eliminating them from being displayed/highlighted AS\ real Diff regions. But you must be very cautious when forming\ such Regular Expressions, so as to NOT IDENTIFY a line that might have\ OTHER legitimate differences on it. Initially, the item will display nothing except its dropdown arrow.\ To view the existing list, simply click the dropdown arrow, and scroll\ thru the resulting list. Clicking on an entry of that list,\ is a request to delete it, but you will be asked for\ confirmation first, which you may decline. However, declining conveniently PLACES that entry into the originally\ empty dropdown entry box, where you may then edit it by\ first clicking on it (to remove the selection highlight) and\ then using the keyboard to traverse about the entry (arrows, backspace,\ retyping) until satisfied, whereupon pressing [Return] will\ add it as a new value (not as an edit\ to the previous entry). Note that shifting the current focus\ away via a mouse click elsewhere, or pressing [Tab],\ also counts as a [Return], confirming your edit completion.\ Obviously if this happens prematurely, you only need delete it and\ try again. If instead you simply start typing first, either AFTER a declined\ deletion, or from the initial empty display state, you will directly\ add whatever is typed after pressing [Return]. Nevertheless, confirmation of each "add" or "delete" will be flashed\ momentarily whenever the list is actually modifed (and the entry will\ then be returned to its empty-looking initial state). If the entire item is shown disabled, it can be accessed by\ toggling the "$pref(ignoreRegexLn)" option described\ (shortly) below. However, note that IF that option *remains* "set", any changes made to\ this table qualifies as a REASON to re-invoke a new Diff, and thus will\ result in the warning highlight, and the concommitant concerns about\ in-progress work. $pref(filetypes) Another editable dropdown list, consisting this time of file suffixes you may\ wish to use as filters in the various file open and save dialogs\ throughout the tool. Editting procedures are as described immediately\ above, except that the format is that of two "words" separated by white\ space. The first word is used as a label, and if it contains spacing,\ should be enclosed in {braces}. The second is a file-glob\ pattern depicting applicable file extension you wish to see. Thus entries\ like "All *" or "{Text Files} *.txt" or even "{C Files} *.[cChH]" should\ all be self explanatory. For sanitys sake, it is best to keep the\ labels short! $pref(geometry) This defines the default size, in characters, of the two main text\ windows. The format must be WIDTHxHEIGHT. For example, "80x40". However, note that while $g(name) will TRY to honor this request, if it\ would result in the overall tool attempting to display as LARGER than the\ screen size of your monitor, the actual values used may be trimmed back\ to fit. While various realities (this setting, Font size, your Monitor\ resolution) may all affect the initial tool display, once\ completed, you are free to resize the tool as you desire, including\ making it larger than your screen; although doing so may make\ general operations more difficult. $pref(ignSuprs) If set, then whichever of the Engine-defined Suppressions are\ presently marked "active" are ADDED into the prototype "$pref(diffcmd)",\ obviously inducing that command to be changed, and (again) raising the\ issue of an impending "Diff" invocation and its warning highlight. This\ preference serves simply as a ON/OFF toggle to the suppression categories\ as a group, eliminating the need to toggle several items to accomplish\ the same result. Turning OFF all suppressions is an important step when\ making final merge choices, if INDENTATION in the final merged file is\ of any importance to you. $pref(autocenter) If set, whenever a new diff region becomes the CDR (for example,\ when pressing the Next or Prev buttons), the\ diff region will be automatically centered on the screen. If unset, no automatic centering will occur. However, the setting\ may also be ignored in the unique situation where\ "autoselection" (described shortly) is also set and the\ display is already being PHYSICALLY scrolled. Stated differently:\ auto-centering will not "fight" the user over who gets to position the\ text window content. $pref(ignoreEmptyLn) If set, then $g(name) will not count, nor highlight, any region\ that is exclusively comprised of empty (or possibly white space filled\ lines if the above "$pref(ignSuprs)" is active)\ whenever a diff is executed. This essentially mimics a feature of the\ original Diff program, but is performed entirely within $g(name). If unset, no special significance is attached to blank/empty lines\ and $g(name) will report the regions as Diff reports them. Note if you press Apply AFTER changing this setting (either to\ set or unset), it will trigger an\ immediate "Rediff" which WILL DISCARD\ any transitory activity not yet finalized. As such, it is yet another\ instance of the warning highlight that precedes such action. Also note that when you choose to ignore empty lines, you are implicitly\ saying that those affected lines will be retained in any\ merged output exactly as they appearred originally in the\ Left-hand text window. Note that for $g(name) to permit the DR to\ be ignored, every line must be classified as such\ regardless of the specific reason (ie. based on being BLANK,\ or as a result of matching any of the "$pref(ignoreRegexLnopt)"\ described earlier, provided THEY are active). $pref(autoselect) If set, automatically select the visible diff region nearest to the\ middle of the text window when scrolling. If unset, the current diff region will not change during scrolling. This only takes effect if "$pref(syncscroll)" is set,\ thus can be thought of as a "modifier" for that setting. $pref(ignoreRegexLn) If set, then the above "$pref(ignoreRegexLnopt)" will\ participate whenever a diff is executed. It also permits that option\ to be editted. If unset, that same option will not participate\ in any invoked diff and is also disabled from being modified. You may toggle this setting simply to gain editting access to the\ "$pref(ignoreRegexLnopt)", but if you press Apply\ BEFORE toggling BACK to the original value (be it set\ or unset), it will trigger an immediate\ "Rediff" which WILL DISCARD any\ transitory activity not yet finalized. Conversely, if you set this, but the list of REs is empty at the\ time of the "Apply", this setting will simply revert to unset\ without error. Again, note that when you choose to ignore matched lines, you are implicitly\ saying that those affected lines will be retained in any\ merged output exactly as they appeared originally in the Left\ text window. Also, as before, for $g(name) to permit the DR to\ be ignored, every line must be classified as such\ regardless of the specific reason (ie. based on being BLANK,\ or as a result of matching any ONE expression). $pref(autoSrch) When set, $g(name) will automatically initiate, at any tool startup\ that does NOT provide a FSPEC, an attempt to\ query a detected, preferred and capable SCM for files that it claims have\ differences. While this capability is always available at startup when at\ least one REV is provided, this setting\ overrides the normal behavior of $g(name) to produce the\ New... Diff dialog, when zero arguments are provided. Note that for most capable SCMs to be detected in this fashion, the\ Current Working Directory (CWD) for\ $g(name) needs to be inside the actual "Working Copy" (WC) set of files\ the particular SCM controls. When the choice is unset, normal dialog behavior is restored.\ This setting is mostly a convenience for users that find themselves\ actively persuing merge resolutions in a SCM-controlled environment on a\ day-to-day basis. $pref(syncscroll) If set, scrolling either text window will result in both windows\ scrolling. If unset, the windows will scroll independent of each other. Note that this setting has only a limited effect on the Merge\ Preview window contents, in that changes of the CDR will\ "jump" scroll, but direct interactive scrolling will not (see the\ Help topic "On GUI" for more details). In addition, there are various functions within $g(name) where it is\ either impossible, or impractical to maintain strict adherence to this\ setting. For features that require the windows to become\ "fractured", $g(name) will strive to reinstate the requested synchronous\ behavior as quickly as permitted as those operations are completed.\ this can OCCASIONALLY cause the windows to be "over eager" to comply,\ based on certain combinations of other related settings, such as\ "$pref(autoselect)" and "$pref(autocenter)".\ These do not tend to produce errors, quite so much as confusion. $pref(scmPrefer) This setting is actually a pair of values, describing which SCM you prefer to\ utilize for EACH of the two possible sides of the comparison. Initially\ both values default to "Auto" which produces the classical $g(name)\ behavior of the "first-detected" SCM possible (based on an internal\ precedence list of known SCM systems). By choosing a specific\ SCM system, you are effectively overriding that internal list\ provided the chosen value is still detectable.\ If not, then the behavior reverts to the classical norm whenever that\ side requires the use of an SCM. There is also a possible value of 'None', if you believe that\ NO SCM should be involved for that side, but be aware that\ such a setting may interfere with the ability to query an otherwise\ capable SCM from providing candidates to be compared. $g(name) will try\ to inform you should this seem to occur, although there are other\ reasons, besides this, for that possibility. Note however, that because\ of subtle differences between the two ways of starting the tool: the\ command line or the dialog, 'None' is generally ignored for\ command line uses, while it will behave as a override value\ on the dialog, until the dialog is actually accepted. $pref(predomMrg) This setting decides, for those cases where no specific reason (such as an\ implied choice from a 3way ancestor diff) exists, which of the two sides\ Left or Right, should be initialized\ as contributing its portion of the changed lines to the eventual merge\ result. Determining how best to toggle this setting involves not only the order\ of files as provided initially, but also on the specific goals\ envisioned by the user for the merge as a whole. For example, if\ back-porting some specific capability, it might be best to select the\ side of the older file, and then only interactively merge the needed\ individual regions from the newer one. This option most often comes into play when a Diff is invoked,\ although it will also apply when Split or Combine\ is used and there was no other reason to choose a side,\ as every region must ultimately posess SOME setting prior to\ being displayed. As a reminder of the oftentimes lopsided contributions from ONE side\ versus the other, a status display of how MANY merges favor the Left\ versus the Right is maintained near the lower right corner of the display. Display $pref(toolbarIcons) If set, the toolbar buttons will use icons instead of text labels. If unset, the toolbar buttons will use text labels instead of icons. Be advised that the toolbar can be a crowded place, and that generally speaking\ the icon-style buttons take less space, and provide Tooltip popup\ descriptions in the event you can't recall what any individual graphic\ means. $pref(fancyButtons) If set, toolbar buttons will mimic the visual behavior of typical\ Microsoft Windows applications. Buttons will initially be flat until the\ cursor moves over them, at which time they will be raised. If unset, toolbar buttons will always appear raised. This feature is not supported in MacOSX. $pref(showln) If set, line numbers are displayed alongside each line of each file. If unset, no line numbers will appear. $pref(tagln) If set, line numbers are highlighted with the options defined in\ the Appearance section of the preferences. If unset, line numbers won\'t be highlighted. $pref(showcbs) If set, change bars are displayed alongside each diff region line\ of each file. If unset, no change bars will appear. The exact form of such change-bars are controlled by further preferences,\ described next. $pref(tagcbs) If set, change indicators will be highlighted. The highlighting\ itself is the subject of yet another preference\ "$pref(colorcbs)" described shortly. If unset change indicators are simply displayed as encoded textual\ markers: a "+" for lines that exist in only one file; a "-" for lines\ that are missing from only one file, and "!" for lines that differ\ between the two files. $pref(showmap) If set, a colorized, graphical "diff map" will be displayed between\ the two files, showing regions that have changed. By default, Red is\ used to show deleted lines, Green for added lines, Blue for changed\ lines, and Yellow for overlapping lines during a 3-way merge. Note that\ any of these colors are themselves "preferences" and thus, changeable\ (See entries under section Appearance below). If unset, the diff map will not be shown. $pref(colorcbs) If set the change bars will appear as solid colored bars\ that match the colors used in the diff map. If unset, IN ADDITION to just the color bars, the change bars will\ display a "+" for lines that exist in only one file, a "-" for lines\ that are missing from only one file, and "!" for lines that differ\ between the two files. Due to color-on-color layering, the "!" markers\ may visually disappear in this situation from BOTH using the same color. $pref(tagtext) If set, the file contents will be highlighted with the options\ defined in the Appearance section of the preferences. If unset, the file contents won't be highlighted. Note - failure to generally highlight the text may make some functions of $g(name) problematic, but the choice remains yours. $pref(showinline1) If set, show inline diffs in the main window. This is useful to\ see what the actual diffs are within a large diff region. If unset, the inline diffs are neither computed nor shown. This\ is the simpler method, where byte-by-byte comparisons\ are used. This inline diff never honors\ any "$pref(ignSuprs)" value, regardless of that\ option being enabled; but see the following TWO preference (below) for\ a method to sidestep this limitation. $pref(showinline2) If set, show inline diffs in the main window. This is useful to see\ what the actual diffs are within a large diff region. If unset, the inline diffs are neither computed nor shown. This\ approach is more complex, but should give more pleasing\ results for source code and written text files. This is the\ Ratcliff/Obershelp pattern matching algorithm which recursively\ finds the largest common substring, and recursively repeats on the left\ and right remainders. When no more common substrings can be\ FOUND, whatever remains ARE the actual differences. $pref(inlSuprs) This is a collection of five distinct settings that collectively control what\ is NOT highlighted as different when the more complex inline\ mode ($pref(showinline2)) described above is used.\ You may set or unset any or none of them as best\ suits your needs, yet is itself only active (or even modifiable) when\ the "$pref(showinline2)" preference is marked active. Further\ recognize that some categories are actually subsets of one another and\ turning ON one, can result in OTHER PRECEDENCE items being turned OFF. Each of the five is a suppression category that just happens to\ parallel the same five Suppression values that can be\ configured for the Diff engine.\ Thus if you manually ALIGN these INDIVIDUAL settings to\ agree, you will SEE exactly why Diff chose the line as different. However, there are valid reasons to not always maintain this alignment,\ depending on what you are trying to understand at the moment. Many choose\ to perform Diffs as if BLANKS (or even character-case) do not matter. Yet\ one might still wish to SEE where such occurences are. The converse is\ also true: Diffing for EXACT matching, but VIEWING to ignore whitespace,\ or Capitalizations can be enlightening. The choice (and its alignment) is\ yours. The five suppressions are (in general precedence order): Case - Capitalizations (GNU DIFF option -i) Blanks - ALL Whitespace (GNU DIFF option -w) #Blanks - AMOUNT of Whitespace (GNU DIFF option -b) @TabX - Columnar Whitespace (GNU DIFF option -E) @EOL - Whitespace at End-of-Line (GNU DIFF option -Z) The initial (default) setting is to suppress none of these individual display\ categories. However, note that the "@TabX" category involves the USE of\ yet another preference ($pref(tabstops)), to compute the\ intended result of paired Whitespace that (after TAB expansion) reaches\ an IDENTICAL column in EACH file simultaneously, to qualify as ignored. $pref(showlineview) If set, display the window near the bottom of the display that\ shows the "current" line from each file, one above the other.\ Clicking on any specific line, or manuevering the text 'insert' cursor\ via the keyboard, in either text window selects which line to contribute.\ This window is most useful to do a visual byte-by-byte comparison of a\ line that has changed; by default, the display begins with text rendered\ the same as in the main display, with mismatched bytes marked with\ underlines, and a blue background and white foreground, but other\ approaches include configuring with a "constant width" font\ (via $pref(bytetag)) such as "Courier" to more easily spot\ the differences, and/or perhaps a different foreground color. If unset, the window will not be shown. $pref(fLMmax) This setting controls how $g(name) presents the list of potential file pairs\ when more than a single pair was derived from the input parameters. As\ the label on the control suggests, file counts less-than (or equal\ to) the value selected will be made available via the menu\ directly. Conversely, if the file count is greater, a popup\ window will be used. The primary reason for this choice is that a menu\ can become unweildy when it contains more than a handful of items. In addition, some users may prefer the ability to see the\ filelist at all times, via the popup window, which may be accomplished\ by setting the threshold to its minimum value. $g(name) defaults this\ value to 9 initially, but only permits a fixed maximum of 25. Behavior It is said that people who spend large blocks of time using any given tool\ often become what is termed "power users". As such they become so\ familiar with the sequence of operations, that they prefer to keep\ their hands on the keyboard and NOT the mouse. Nearly all operations\ in a tool have some keyboard equivalent to allow them to be invoked.\ These are called "keyboard accelerators", or simply, hotkeys.\ As of $g(name) V5.1, it is now possible for the user to specify what\ specific keys are preferred for tool functions previously provided\ almost exclusively via "menus" or "buttons". Those other\ mechanisms continue to exist, but $g(name) now allows the "power users"\ to select their own. Each of the following items operates in exactly the same fashion. Only\ the task each performs is unique. Thus the following describes how to\ review and/or change each key-combination for any of these features. Simply hovering the mouse over any given item will cause the item\ display to switch from its brief "task description" to showing the\ individual key-combination that will invoke said function. To actually change that value, clicking the specific item will\ "arm" it to accept the\ very next keyboard interaction to be made. Be advised:\ despite an item holding the current focus highlight, you may NOT\ use spacebar (or any other platform-specific\ keyboard-click equivalent) to perform that click. To alert\ you that this very critical step has been primed, the background of the\ item will be changed to the "inform" (ie. the ToolTip) color. At this\ juncture, if you move the mouse to LEAVE the item, the edit will be\ cancelled. If instead you actually press some key-combination\ (for example: Shift Z), that combination will\ temporarily replace whatever combination was previously\ present. It will ALSO visually SHIFT that displayed value from being\ centered to being "left-justified" still with the "inform"\ background color. You are now in a "textual-modify" phase, where it may be advantageous to\ adjust the value to something either more, or less, specific (ie. adding\ or removing various "modifier" keys, such as Shift, or Control, Numlock\ or the mostly useless descriptor "Key" - which must never be\ removed if the remaining value is a digit). The mouse is no\ longer required to stay within the item bounds at this time, but will\ only function in a restricted manner. You may use it to set the\ insert-cursor position for performing edits (just as any normal entry\ field). It is ALSO permitted to access certain Dialog buttons\ (specifically the Apply or Dismiss ones), which\ will finalize the edit in a manner consistent with each,\ as a shortcut. Beyond that shortcut, only one of two choices remain; either you press\ the "Escape" key (to cancel the entire edit sequence),\ or press "Return" to confirm that the sequence is as you intended it.\ Either finalizes the hotkey definition process, removes the special\ background "inform" color, and returns you to normal operation. As a convenience to the "power users", pressing [Tab] (or [Shift-Tab])\ will be treated as an implicit "Return". Clicking either of the two\ Dialog buttons (via mouse OR keyboard actions) mentioned earlier will\ complete the editting phase with the appropriate "cancel" or "accept"\ action (eg. Dismiss as a "cancel") while also immediately\ performing their normal task. Note that while MOST keys on a keyboard CAN be specified, including\ keypads and function keys, SOME may have been usurped by the Operating\ System or Window Manager and will never even be delivered to $g(name).\ Many OTHERS could have some generally defined meaning with Tcl/Tk;\ particularly within the various textual widgets. The good news there is\ that because nearly all of the $g(name) widgets operate in a\ "display only" mode within the main tool windows (where these hotkeys\ exist), there is a low chance of cross connecting your choice of hotkeys\ with those of the widgets themselves. Just be aware that anything\ YOU choose that has not been incapacitated (by virtue of that\ "display only" widget status) would operate\ in addition to (and after) anything Tcl/Tk might use the same\ keys for, unless the Tcl/Tk definition chooses to block further actions. Our recommendation, is to keep it simple and preferrably unique. Most\ typing keys would be available as there are few places in $g(name) where\ typing is possible. If you wish to create a "mode-based" family of\ hotkeys (eg. lots of people like the idea of using the "arrow" keys in\ place of the default "merge choice" keys), then perhaps pairing them\ with the use of "NumLock" would allow that use when desired, without\ sacrificing the normal arrow usage (such as moving the text insert\ cursor about), NOR requiring a second key (Shift, Control, etc) to be\ simultaneously held down. We specifically require the use of the mouse in the "arming" operation,\ to limit mis-struck keys, at in-opportune times. Safety for the less-than\ "power-user" community overrides the minor inconvenience to the real\ ones among you, who will likely use this capability once and\ then, never adjust it again! $pref(navFrst) This hotkey is defaulted to "f" $pref(navLast) This hotkey is defaulted to "l" $pref(navNext) This hotkey is defaulted to "n" $pref(navPrev) This hotkey is defaulted to "p" $pref(navCntr) This hotkey is defaulted to "c" $pref(mrgLeft) This hotkey is defaulted to "Key-1" $pref(mrgRght) This hotkey is defaulted to "Key-2" $pref(mrgLtoR) This hotkey is defaulted to "Key-3" $pref(mrgRtoL) This hotkey is defaulted to "Key-4" $pref(genEdit) This hotkey is defaulted to "e" $pref(genFind) This hotkey is defaulted to "Control-f" $pref(genNxfile) This hotkey is defaulted to "Control-[" $pref(genPvfile) This hotkey is defaulted to "Control-]" $pref(genRecalc) This hotkey is defaulted to "Control-r" $pref(genXit) This hotkey is defaulted to "Control-q" The final two settings are a deviation from historical $g(name) (which never\ required the Control-Key modifier) as it was considered safer to require\ TWO fingers on the keyboard before wiping out all in-progress transitory\ work, for which there is no recovery, beyond reconstruction. One other small point should be made about ALL of the Behavior settings -\ technically, each is platform dependent! Each platform has\ unique names, particularly for some of the "modifier" keys. $g(name)\ therefore will prefix the specific windowing system ID to each of the\ preference identifiers when storing and retrieving the values to the\ preferences file. While this was not originally intended to be a\ "feature", it does exhibit the unusual ability for a single preference\ file to be directly USABLE on multiple platforms, WITHOUT data\ collisions, and presuming you have a multi-platform situation all using\ a single preference file. It also means that each platform will require its OWN specialization\ work, as regards which specific keys are being configured to do what. Appearance As the majority of the $g(name) content is textual, the presentation of such\ information is at the heart of most of the tools features. Controlling\ and tuning that presentation is therefore key to obtaining the best\ experience in using it, but only when it matches the users expectations\ of proper degrees of emphasis - which is highly subjective. Tcl/Tk has\ a remarkably rich set of attributes that can be applied, and even\ layered atop each other. While $g(name) makes use of many of these\ attributes itself, it still makes sense to allow the user to make many\ of these adjustments on their own. While $g(name) must necessarily "OWN" the organization of the various\ display layers, to maintain functionality, describing such layering is\ important when trying to determine what "other" attributes may help the\ user obtain their most useful presentation. Just be aware that $g(name)\ utilizes several of these attributes itself, and might not\ operate correctly should some be arbitrarily introduced. As a general\ rule, colors, fonts and sizes are likely candidates for customization;\ with the syntax rules for their specification dictated by Tcl/Tk. $pref(textopt) This is a list of Tk text widget options that are applied to each of the two\ text windows in the main display, and the Merge Preview. If you have Tk\ installed on your machine (and you should) these will be documented in\ the "Text.n" manual page. These settings constitute the "base" layer of\ attributes which will be seen, unless some "higher layer" of attributes\ is designated as being ABOVE them. The remaining settings will describe\ when such a "change in layer" takes place. $pref(difftag) This is a list of Tk text widget tag options that are applied to all diff\ regions. These options have a higher priority than those for just plain\ text. Use this option to make diff regions stand out from regular text. $pref(deltag) This is a list of Tk text widget tag options that are applied to regions that\ have been deleted. These options have a higher priority than those for\ all diff regions. $pref(instag) This is a list of Tk text widget tag options that are applied to regions that\ have been inserted. These options have a higher priority than those for\ all diff regions. $pref(chgtag) This is a list of Tk text widget tag options that are applied to regions that\ have been changed. These options have a higher priority than those for\ all diff regions. $pref(currtag) This is a list of Tk text widget tag options that are applied to the current\ diff region. So, for example, if you set the forground for all diff\ regions to be black and set the foreground for this option to be blue,\ these current diff region settings (eg. foreground color) will be used.\ These tags have a higher priority than those for all diff regions, AND\ a higher priority than the change, inserted and deleted diff regions,\ but ONLY in the LEFT text window. In the RIGHT text window, these\ settings fall BELOW the individual change-category ones described. $pref(inlinetag) This is a list of Tk text widget tag options that are applied to differences\ within lines in a diff region. These tags have a higher priority than\ those for all diff regions, and a higher priority than the change,\ inserted and deleted diff regions, AND the current region. $pref(bytetag) This is a list of Tk text widget tag options that are applied to individual\ differing characters in the line view. These options do not\ affect the main text displays. Note that if a font specification is also\ included, that font will be used for ALL the characters, not\ just the differing ones. If you remove all settings, text will appear as\ it does in the main displays, with NO difference highlighting\ at all. Think of it as a completely independent "layering" stack. $pref(tabstops) This defines the number of characters for each tabstop in the main display\ windows. Be aware that with the ability to specify fonts, not only of\ the basic text display layer, but of layered individual character ranges\ (as happens with "inline-diff" highlighting), the mere presence of a\ [Tab] will not generally cause pieces of text to "align" as might\ ordinarily be expected. This problem gets worse when considering the use\ of "so called" proportional fonts. Nevertheless, the default is 8. Further note that ONE of the difference suppression categories (@TabX),\ both the display AND the Engine instances, will utilize this value when\ evaluating if that suppression will be applied. As such, it is MORE than\ just a means to spacing of its surrounding text. The remaining Appearance items are all formerly internal color settings that have now been made\ accessible for customization. Each takes the form of a button, when\ hovered over by the mouse, displays the current color each uses. Pressing that button will popup a color chooser dialog to make\ adjustments for the items (described) that the setting covers. $pref(inform) is used primarily in the production of popup ToolTip window backgrounds\ to help draw your attention to it (before it disappears). Other uses\ include a role in the editting sequence of a global hotkey definition to\ again draw your attention to the "sensitive state" where just\ touching practically ANY key on the keyboard will result in\ advancing the definition procedure. It also serves as the Highlight that\ warns of an impending "Diff" when modifying critical preferences -or-\ selecting certain specific items from the View menu, AND\ also serves as a indicator of 'existence' when entering input filenames\ interactively via the File->New... Dialog.\ The default is "Goldenrod1". $pref(adjcdr) is used exclusively by the Split or Combine\ features to highlight (in the text windows) the bounds of the CDR as\ it is being adjusted. The default is "magenta". $pref(mapins) is used by the "Diff Map" as well as Split/Combine text\ window feedback and potentially the highlighting of Line numbers or\ Changebars (if requested), to indicate something being "added". The\ default is "Pale Green". $pref(mapchg) is used by the "Diff Map" as well as Split/Combine text\ window feedback and potentially the highlighting of Line numbers or\ Changebars (if requested), to indicate something being "changed". The\ default is "Dodger Blue". $pref(mapdel) is used by the "Diff Map" as well as Split/Combine text\ window feedback and potentially the highlighting of Line numbers or\ Changebars (if requested), to indicate something being "deleted". The\ default is "Tomato". $pref(mapolp) is used by the "Diff Map" as well as Split/Combine text\ window feedback and potentially the highlighting of Line numbers or\ Changebars (if requested), to indicate a COLLISION between diff\ regions during a 3way diff. Classically this color had actually\ been hardcoded, let alone defaulted to "yellow". Engine As often mentioned, $g(name) was originally designed as a graphic wrapper\ to the UNIX-based "Diff" utility. As such, that tool served as the target\ of what was POSSIBLE, and thus what would comprise the general set of\ preferences to be parameterized. Yet several other "work-alike" Engines,\ some with exceptional capabilities have come to exist since. The following preferences, unlike most others, are intended to DEFINE the\ interface to a generic external differencing tool that\ $g(name) invokes when it needs to compare file pairs. It is divided into\ two nearly identical descriptor groups, corresponding to the two basic\ services $g(name) requires of its external engine: 1. a command to generate the actual Diff hunks themselves; and 2. a command to recursively FIND pairs of files HAVING differences. As delivered, these commands are, in fact, invocations of the SAME underlying\ tool (eg. Diff), though they need NOT be. Yet, in practice, many engines\ simply require an extra flag option (or two) to accomplish the\ recursive service named above. As each of these represents an\ external command each is identified by the FIRST WORD of\ their values. It is expected that such commands will be "found" by the\ operating system using this "name"-word alone (typically by searching\ for it wherever other such commands would be found, for instance via\ the users PATH environment variable). Associated with each command is a group of option flags that indicate\ specific features $g(name) is prepared to utilize IFF the\ engine itself HAS such a capability. Each option is presented as a\ text field where the LITERAL flag for the described option is SPECIFIED,\ together with a checkbox toggle item to designate if that option should\ be USED, when $g(name) requests either of the two services. However - when BOTH services have IDENTICAL "names" (ie. First word),\ then only ONE SET of associated options is presented for configuration\ (as they are actually the SAME underlying tool). Just recognize that the\ options of "$pref(egnCmd)" will be shared by the\ "$pref(egnSrchCmd)" service when invoked. Conversely, if that first "name"-word of the two commands differ, then\ EACH command will provide its OWN group of options, suitable for\ configuring, what is therefore DISTINCT external commands. From a configuration standpoint, these settings all operate the same\ way. Each is actually a PAIR of settings: a toggle (to say please USE\ this setting) and a text-field to DEFINE the literal flag it requires.\ Most flags are NOT designed to accept a "value", although if such a\ value can be CONCATENATED to the flag, it would work. For those few\ flags that EXPECT to have a value (identified below when possible) there\ is an special encoding that can be given if it is REQUIRED that the flag\ be seperated from its value: simply PREFIX the flag with a single blank\ and $g(name) will then format the flag AND value as desired. $pref(egnCmd) This is quite simply the "Diff" command to be used. It is the SOURCE of what\ is eventually used to form the "$pref(diffcmd)" preference.\ It is HERE that one could supply any "extra" option flags if, with the\ intent of causing a NEW prototype Diff command to be formed, thereby\ CAUSING any temporary pass-thru flags from the original\ command line to be eliminated. Subordinate to this basic command, are the following KNOWN option flags: $pref(egnCase) $pref(eopCase) (default -i) Ignores differences related to capitalizations. $pref(egnBlanks) $pref(eopBlanks) (default -w) Ignores differences relating to ANY form of Whitespace. $pref(egn#Blanks) $pref(eop#Blanks) (default -b) Ignores differences related to Whitespace of non-identical length. $pref(egn@TabX) $pref(eop@TabX) (default -E) Ignores differences related to Tab-expansion to a COMMON location. $pref(egn@EOL) $pref(eop@EOL) (default -Z) Ignores differences related to Whitespace found at an end-of-line. $pref(egnTabSiz) $pref(eopTabSiz) (default --tabsize) This defines the option to inform Diff of the WIDTH of a single [Tab]. The actual VALUE passed is defined by the "$pref(tabstops)" preference, within the Appearance tabbed section. $pref(egnSrchCmd) The command (with likely additional flags) $g(name) uses to search a given\ pair of directory trees recursively to locate all pairs of\ resultant files that contain differences. Each pair will be expected to\ be named identically as the search proceeds, except for the starting\ directories. $g(name) choosing to USE this service originates from either the command\ line (or the interactive dialog), and will only be effective when\ both given inputs ARE directories, AND the proper\ recursion-authorization option has been supplied (via dialog OR cmdline). However, in terms of its PRECEDENCE, using a directory pairing\ to recursively locate files only applies when no SCM is\ involved. This MAY result in complaints of\ "no files found" in certain circumstances; yet IF the SCM\ access were to be DISABLED (this IS why the value "None"\ exists as a choice in the "$pref(scmPrefer)" setting),\ the recursive search WOULD then work. The default value provided (diff -r) is somewhat better than\ the former default (which also included the -q flag). Both\ are reasonable, but not always ideal. First they presume\ the use of a GNU-like Diff Engine (to be understood to mean) "recursive"\ and "quiet" respectively. But the use of the "quiet" option implies how\ and what is eventually reported by the search. Using it, ALL\ like-named files are reported, even when they do not appear to be\ Text files. This means your resulting file list can contain files\ that are KNOWN to be different, despite not being files that can be\ readily compared or visually read, let alone reviewed, merged, etc.\ Leaving the "quiet" option OUT, effectively results in Diff\ SUPPRESSING any files that are considered (by the GNU Diff\ Engine, at least) to be binary (eg. non-text) from being\ returned as candidates. While this may be a better result, it is possibly still not perfect.\ There are instances, of seemingly "Text-like" files, for which $g(name)\ might still be inappropriate. A Cscope database, for one, comes to mind. Thus you may wish to use yet more options here\ (such as the Gnu Diff -x or -X options) that tell\ the Engine to ignore specified filename patterns when\ searching for file pairs. The first of these is provided as a possible\ (and value-passing) built-in configuration option (shown below). The\ values it would pass come from the "$pref(xcludeFils)"\ preference defined under the General tab, which is the\ same list of excluded file patterns used by any\ NON-recursive searches done bu $g(name). $pref(egnXcludFil) $pref(eopXcludFil) (default -x) This defines a REPEATING option to inform Diff what filename patterns to ignore. The VALUEs passed are defined by the preference "$pref(xcludeFils)", from the General section. As mentioned earlier, should the first word of the two command names\ DIFFER, an entire SECOND SET of suppression flag definition and use\ toggles will be made available for configuration. For completeness\ sake, we note their names here, but each is defaulted and operates\ EXACTLY as described earlier, but EXCLUSIVELY for recursive searching: $pref(egnSCase) $pref(eopSCase) (default -i) Ignores differences related to capitalizations. $pref(egnSBlanks) $pref(eopSBlanks) (default -w) Ignores differences relating to ANY form of Whitespace. $pref(egnS#Blanks) $pref(eopS#Blanks) (default -b) Ignores differences related to Whitespace of non-identical length. $pref(egnS@TabX) $pref(eopS@TabX) (default -E) Ignores differences related to Tab-expansion to a COMMON location. $pref(egnS@EOL) $pref(eopS@EOL) (default -Z) Ignores differences related to Whitespace found at an end-of-line. $pref(egnSTabSiz) $pref(eopSTabSiz) (default --tabsize) This defines the option to inform Diff of the WIDTH of a single [Tab]. Configuration notes You should review the documentation for your configured Engine to\ determine if other available options might assist in "getting the desired\ results". $g(name) does not, itself, interpret ANY of these option flags\ and simply sends them to the Engine when requesting either service.\ HOWEVER - because the handling of the results returned by the\ Engine drives what then happens, it is possible that YOUR\ chosen Engine might not "report back" its results in a syntax\ intelligible to $g(name), which presently understands both the "normal"\ AND "Unified" formats. If such is the case, contact us for assistance. But if you are the adventurous sort, or cant locate a viable copy of\ "Diff" for your platform, (or wish to try a DIFFERENT algorithm), you\ could configure something like: "$pref(egnCmd)" : git diff "$pref(egnCase)" : -i "$pref(egnBlanks)" : -w "$pref(egn#Blanks)" : -b "$pref(egn@TabX)" : (leave empty - Git non-support) "$pref(egn@EOL)" : --ignore-space-at-eol "$pref(egnTabSiz)" : (again leave this empty - Git non-support) "$pref(egnSrchCmd)" : git diff --diff-format=M "$pref(egnXcludFil)" : (empty: dont try ":!" - didnt work) We are neither GIT experts, nor actually ADVOCATING its usage, or\ suggesting that the above would be the ONLY way to configure for its use.\ This is nothing more than an EXAMPLE of configuring a DIFFERENT engine\ OTHER than the expected default. Git is both formidable AND ever\ changing; but it WAS POSSIBLE to configure it effectively. Remember that if two distinct commands are chosen for the two service\ routines, then a secondary set of "suppression" options will be presented\ for configuration for the recursive search service. BOTH sets are\ initially defined and defaulted per the original Diff Engine. Be aware\ any "extra" options ADDED to the "$pref(egnCmd)" preference\ should likely be added to the "$pref(egnSrchCmd)" preference\ to ensure SEARCHES that locate files will actually FIND the files that\ the other service is expected to report differences within. Custom Settings There is an additional setting built-in to the Preferences file called\ customCode (together with a comment about not using it) that\ nevertheless has some simple uses. The big advantage is that, like each\ other setting described above, the contents of this setting IS\ retained automatically when modified by the $g(name) Preferences Dialog. However, it can only be set or modified externally\ via a text editor. Still, occasionally there have been customizations of\ the GUI that many users found helpful that are often difficult (if not\ impossible) to specify correctly using other means. Although there are\ fewer at the moment (per the newer 'color' buttons described above), we\ offer up the following (still valid) possibilit(y/ies) as suggestions: 1. Highlighting the current Merge Choice (when in Icon mode) - This item, typically required the use of XResources in the past to do\ correctly, but the following is much simpler: set w(selcolor) orange cfg-toolbar makes it easier to see which of the four icons is presently "selected", as\ the default is generally only a greyed background shading of the\ unselected state. Note that the command "set" and name "w(selcolor)"\ must be exactly as shown (using parenthesis). More importantly, the\ cfg-toolbar function call is REQUIRED for it to have effect! CAVEAT: Doing more than this requires intimate knowledge of the internal\ code, and, as such, could be subject to future elimination or even\ promotion to a full fledged REAL 'Preference' setting. But for now,\ it works. Moreover, the admonishment to not misuse this facility still\ applies, as it is exceedingly easy to disrupt normal program operation. } # since we have embedded references to the preference labels in # the text, we need to perform substitutions. Because of this, if # you edit the above text, be sure to properly escape any dollar # signs that are not meant to be treated as a variable reference do-text-info .help-prefs $title [subst -nocommands $text] } ###################################################################### # # text formatting routines derived from Klondike # Reproduced here with permission from their author. # # Copyright (C) 1993,1994 by John Heidemann # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # 3. The name of John Heidemann may not be used to endorse or promote products # derived from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY JOHN HEIDEMANN ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL JOHN HEIDEMANN BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # ###################################################################### proc put-text {tw txt} { $tw configure -font {Fixed 12} $tw configure -font -*-Times-Medium-R-Normal-*-14-* $tw tag configure bld -font -*-Times-Bold-R-Normal-*-14-* $tw tag configure cmp -font -*-Courier-Medium-R-Normal-*-12-* $tw tag configure hdr -font -*-Helvetica-Bold-R-Normal-*-16-* -underline 1 $tw tag configure itl -font -*-Times-Medium-I-Normal-*-14-* $tw tag configure ttl -font -*-Helvetica-Bold-R-Normal-*-18-* #$tw tag configure h3 -font -*-Helvetica-Bold-R-Normal-*-14-* $tw tag configure btn -foreground white -background grey $tw mark set insert 0.0 set t $txt while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} { set start [lindex $inds 0] set end [lindex $inds 1] set keyword [string range $t $start $end] set oldend [$tw index end] $tw insert end [string range $t 0 [expr {$start - 2}]] purge-all-tags $tw $oldend insert if {[string range $keyword 0 0] == "/"} { set keyword [string trimleft $keyword "/"] if {[info exists tags($keyword)] == 0} { error "end tag $keyword without beginning" } $tw tag add $keyword $tags($keyword) insert unset tags($keyword) } else { if {[info exists tags($keyword)] == 1} { error "nesting of begin tag $keyword" } set tags($keyword) [$tw index insert] } set t [string range $t [expr {$end + 2}] end] } set oldend [$tw index end] $tw insert end $t purge-all-tags $tw $oldend insert } proc purge-all-tags {w start end} { foreach tag [$w tag names $start] { $w tag remove $tag $start $end } } ############################################################################## # Given 'namespace' changes of TclTk V9.0 # is SAFEST to HALT any further Dbg injections HERE # (if they were ever ACTIVATED in the first place) ############################################################################## if {[string length [info commands "proc_"]]} { rename "proc" "" ; rename "proc_" "proc" } # Copyright (c) 1998-2003, Bryan Oakley # All Rights Reserved # # Bryan Oakley # oakley@bardo.clearlight.com # # combobox v2.3 August 16, 2003 # # MODIFIED (for TkDiff) # 31Jul2018 mpm: (<-tagged) added support for 'list itemconfigure' subcommand # 25Oct2020 mpm: (<-tagged) added hack for multiple-monitor issue (TK bug?) # # a combobox / dropdown listbox (pick your favorite name) widget # written in pure tcl # # this code is freely distributable without restriction, but is # provided as-is with no warranty expressed or implied. # # thanks to the following people who provided beta test support or # patches to the code (in no particular order): # # Scott Beasley Alexandre Ferrieux Todd Helfter # Matt Gushee Laurent Duperval John Jackson # Fred Rapp Christopher Nelson # Eric Galluzzo Jean-Francois Moine Oliver Bienert # # A special thanks to Martin M. Hunt who provided several good ideas, # and always with a patch to implement them. Jean-Francois Moine, # Todd Helfter and John Jackson were also kind enough to send in some # code patches. # # ... and many others over the years. # ITSELF requires Tk 8.0- (but TkDiff already has that covered) package provide combobox 2.3 namespace eval ::combobox { # this is the public interface namespace export combobox # these contain references to available options variable widgetOptions # these contain references to available commands and subcommands variable widgetCommands variable scanCommands variable listCommands } # ::combobox::combobox -- # # This is the command that gets exported. It creates a new # combobox widget. # # Arguments: # # w path of new widget to create # args additional option/value pairs (eg: -background white, etc.) # # Results: # # It creates the widget and sets up all of the default bindings # # Returns: # # The name of the newly created widget proc ::combobox::combobox {w args} { variable widgetOptions variable widgetCommands variable scanCommands variable listCommands # perform a one time initialization if {![info exists widgetOptions]} { Init } # build it... eval Build $w $args # set some bindings... SetBindings $w # and we are done! return $w } # ::combobox::Init -- # # Initialize the namespace variables. This should only be called # once, immediately prior to creating the first instance of the # widget # # Arguments: # # none # # Results: # # All state variables are set to their default values; all of # the option database entries will exist. # # Returns: # # empty string proc ::combobox::Init {} { variable widgetOptions variable widgetCommands variable scanCommands variable listCommands variable defaultEntryCursor array set widgetOptions [list \ -background {background Background} \ -bd -borderwidth \ -bg -background \ -borderwidth {borderWidth BorderWidth} \ -buttonbackground {buttonBackground Background} \ -command {command Command} \ -commandstate {commandState State} \ -cursor {cursor Cursor} \ -disabledbackground {disabledBackground DisabledBackground} \ -disabledforeground {disabledForeground DisabledForeground} \ -dropdownwidth {dropdownWidth DropdownWidth} \ -editable {editable Editable} \ -elementborderwidth {elementBorderWidth BorderWidth} \ -fg -foreground \ -font {font Font} \ -foreground {foreground Foreground} \ -height {height Height} \ -highlightbackground {highlightBackground HighlightBackground} \ -highlightcolor {highlightColor HighlightColor} \ -highlightthickness {highlightThickness HighlightThickness} \ -image {image Image} \ -listvar {listVariable Variable} \ -maxheight {maxHeight Height} \ -opencommand {opencommand Command} \ -relief {relief Relief} \ -selectbackground {selectBackground Foreground} \ -selectborderwidth {selectBorderWidth BorderWidth} \ -selectforeground {selectForeground Background} \ -state {state State} \ -takefocus {takeFocus TakeFocus} \ -textvariable {textVariable Variable} \ -value {value Value} \ -width {width Width} \ -xscrollcommand {xScrollCommand ScrollCommand} \ ] set widgetCommands [list \ bbox cget configure curselection \ delete get icursor index \ insert list scan selection \ xview select toggle open \ close subwidget \ ] set listCommands [list \ delete get \ index insert itemconfigure size \ ] ;# mpm - added itemconfigure set scanCommands [list mark dragto] # why check for the Tk package? This lets us be sourced into # an interpreter that doesn't have Tk loaded, such as the slave # interpreter used by pkg_mkIndex. In theory it should have no # side effects when run if {[lsearch -exact [package names] "Tk"] != -1} { ################################################################## #- this initializes the option database. Kinda gross, but it works #- (I think). ################################################################## # the image used for the button... if {$::tcl_platform(platform) == "windows"} { image create bitmap ::combobox::bimage -data { #define down_arrow_width 12 #define down_arrow_height 12 static char down_arrow_bits[] = { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0xfc,0xf1,0xf8,0xf0,0x70,0xf0,0x20,0xf0, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00; } } } else { image create bitmap ::combobox::bimage -data { #define down_arrow_width 15 #define down_arrow_height 15 static char down_arrow_bits[] = { 0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80, 0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,0x83, 0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80, 0x00,0x80,0x00,0x80,0x00,0x80 } } } # compute a widget name we can use to create a temporary widget set tmpWidget ".__tmp__" set count 0 while {[winfo exists $tmpWidget] == 1} { set tmpWidget ".__tmp__$count" incr count } # get the scrollbar width. Because we try to be clever and draw our # own button instead of using a tk widget, we need to know what size # button to create. This little hack tells us the width of a scroll # bar. # # NB: we need to be sure and pick a window that doesn't already # exist... scrollbar $tmpWidget set sb_width [winfo reqwidth $tmpWidget] set bbg [$tmpWidget cget -background] destroy $tmpWidget # steal options from the entry widget # we want darn near all options, so we'll go ahead and do # them all. No harm done in adding the one or two that we # don't use. entry $tmpWidget foreach foo [$tmpWidget configure] { # the cursor option is special, so we'll save it in # a special way if {[lindex $foo 0] == "-cursor"} { set defaultEntryCursor [lindex $foo 4] } if {[llength $foo] == 5} { set option [lindex $foo 1] set value [lindex $foo 4] option add *Combobox.$option $value widgetDefault # these options also apply to the dropdown listbox if {[string compare $option "foreground"] == 0 \ || [string compare $option "background"] == 0 \ || [string compare $option "font"] == 0} { option add *Combobox*ComboboxListbox.$option $value \ widgetDefault } } } destroy $tmpWidget # these are unique to us... option add *Combobox.elementBorderWidth 1 widgetDefault option add *Combobox.buttonBackground $bbg widgetDefault option add *Combobox.dropdownWidth {} widgetDefault option add *Combobox.openCommand {} widgetDefault option add *Combobox.cursor {} widgetDefault option add *Combobox.commandState normal widgetDefault option add *Combobox.editable 1 widgetDefault option add *Combobox.maxHeight 10 widgetDefault option add *Combobox.height 0 } # set class bindings SetClassBindings } # ::combobox::SetClassBindings -- # # Sets up the default bindings for the widget class # # this proc exists since it's The Right Thing To Do, but # I haven't had the time to figure out how to do all the # binding stuff on a class level. The main problem is that # the entry widget must have focus for the insertion cursor # to be visible. So, I either have to have the entry widget # have the Combobox bindtag, or do some fancy juggling of # events or some such. What a pain. # # Arguments: # # none # # Returns: # # empty string proc ::combobox::SetClassBindings {} { # make sure we clean up after ourselves... bind Combobox [list ::combobox::DestroyHandler %W] # this will (hopefully) close (and lose the grab on) the # listbox if the user clicks anywhere outside of it. Note # that on Windows, you can click on some other app and # the listbox will still be there, because tcl won't see # that button click set this {[::combobox::convert %W -W]} bind Combobox "$this close" bind Combobox "$this close" # this helps (but doesn't fully solve) focus issues. The general # idea is, whenever the frame gets focus it gets passed on to # the entry widget bind Combobox {::combobox::tkTabToWindow \ [::combobox::convert %W -W].entry} # this closes the listbox if we get hidden bind Combobox {[::combobox::convert %W -W] close} return "" } # ::combobox::SetBindings -- # # here's where we do most of the binding foo. I think there's probably # a few bindings I ought to add that I just haven't thought # about... # # I'm not convinced these are the proper bindings. Ideally all # bindings should be on "Combobox", but because of my juggling of # bindtags I'm not convinced thats what I want to do. But, it all # seems to work, its just not as robust as it could be. # # Arguments: # # w widget pathname # # Returns: # # empty string proc ::combobox::SetBindings {w} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options # juggle the bindtags. The basic idea here is to associate the # widget name with the entry widget, so if a user does a bind # on the combobox it will get handled properly since it is # the entry widget that has keyboard focus. bindtags $widgets(entry) \ [concat $widgets(this) [bindtags $widgets(entry)]] bindtags $widgets(button) \ [concat $widgets(this) [bindtags $widgets(button)]] # override the default bindings for tab and shift-tab. The # focus procs take a widget as their only parameter and we # want to make sure the right window gets used (for shift- # tab we want it to appear as if the event was generated # on the frame rather than the entry. bind $widgets(entry) \ "::combobox::tkTabToWindow \[tk_focusNext $widgets(entry)\]; break" bind $widgets(entry) \ "::combobox::tkTabToWindow \[tk_focusPrev $widgets(this)\]; break" # this makes our "button" (which is actually a label) # do the right thing bind $widgets(button) [list $widgets(this) toggle] # this lets the autoscan of the listbox work, even if they # move the cursor over the entry widget. bind $widgets(entry) "break" bind $widgets(listbox) \ "::combobox::Select [list $widgets(this)] \ \[$widgets(listbox) nearest %y\]; break" bind $widgets(vsb) {continue} bind $widgets(vsb) {continue} bind $widgets(listbox) { %W selection clear 0 end %W activate @%x,%y %W selection anchor @%x,%y %W selection set @%x,%y @%x,%y # need to do a yview if the cursor goes off the top # or bottom of the window... (or do we?) } # these events need to be passed from the entry widget # to the listbox, or otherwise need some sort of special # handling. foreach event [list \ <1> \ ] { bind $widgets(entry) $event \ [list ::combobox::HandleEvent $widgets(this) $event] } # like the other events, needs to be passed from # the entry widget to the listbox. However, in this case we # need to add an additional parameter catch { bind $widgets(entry) \ [list ::combobox::HandleEvent $widgets(this) %D] } } # ::combobox::Build -- # # This does all of the work necessary to create the basic # combobox. # # Arguments: # # w widget name # args additional option/value pairs # # Results: # # Creates a new widget with the given name. Also creates a new # namespace patterened after the widget name, as a child namespace # to ::combobox # # Returns: # # the name of the widget proc ::combobox::Build {w args } { variable widgetOptions if {[winfo exists $w]} { error "window name \"$w\" already exists" } # create the namespace for this instance, and define a few # variables namespace eval ::combobox::$w { variable ignoreTrace 0 variable oldFocus {} variable oldGrab {} variable oldValue {} variable options variable this variable widgets set widgets(foo) foo ;# coerce into an array set options(foo) foo ;# coerce into an array unset widgets(foo) unset options(foo) } # import the widgets and options arrays into this proc so # we don't have to use fully qualified names, which is a # pain. upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options # this is our widget -- a frame of class Combobox. Naturally, # it will contain other widgets. We create it here because # we need it in order to set some default options. set widgets(this) [frame $w -class Combobox -takefocus 0] set widgets(entry) [entry $w.entry -takefocus 1] set widgets(button) [label $w.button -takefocus 0] # this defines all of the default options. We get the # values from the option database. Note that if an array # value is a list of length one it is an alias to another # option, so we just ignore it foreach name [array names widgetOptions] { if {[llength $widgetOptions($name)] == 1} continue set optName [lindex $widgetOptions($name) 0] set optClass [lindex $widgetOptions($name) 1] set value [option get $w $optName $optClass] set options($name) $value } # a couple options aren't available in earlier versions of # tcl, so we'll set them to sane values. For that matter, if # they exist but are empty, set them to sane values. if {[string length $options(-disabledforeground)] == 0} { set options(-disabledforeground) $options(-foreground) } if {[string length $options(-disabledbackground)] == 0} { set options(-disabledbackground) $options(-background) } # if -value is set to null, we'll remove it from our # local array. The assumption is, if the user sets it from # the option database, they will set it to something other # than null (since it's impossible to determine the difference # between a null value and no value at all). if {[info exists options(-value)] \ && [string length $options(-value)] == 0} { unset options(-value) } # we will later rename the frame's widget proc to be our # own custom widget proc. We need to keep track of this # new name, so we'll define and store it here... set widgets(frame) ::combobox::${w}::$w # gotta do this sooner or later. Might as well do it now pack $widgets(button) -side right -fill y -expand no pack $widgets(entry) -side left -fill both -expand yes # I should probably do this in a catch, but for now it's # good enough... What it does, obviously, is put all of # the option/values pairs into an array. Make them easier # to handle later on... array set options $args # Next, the dropdown list (built offscreen) ... # which also requires some extra window management foo wm withdraw [set widgets(dropdown) [toplevel $w.top]] wm overrideredirect $widgets(dropdown) 1 wm transient $widgets(dropdown) [winfo toplevel $w] wm group $widgets(dropdown) [winfo parent $w] wm resizable $widgets(dropdown) 0 0 # The listbox and scrollbar go INSIDE that window, # ... but we only manage the vsb (later on) AS NEEDED set widgets(listbox) [listbox $w.top.list] set widgets(vsb) [scrollbar $w.top.vsb] pack $widgets(listbox) -side left -fill both -expand y # now fine tune the widgets based on the options (and a few # arbitrary values...) # NB: we are going to use the frame to handle the relief # of the widget as a whole, so the entry widget will be # flat. This makes the button which drops down the list # to appear "inside" the entry widget. $widgets(vsb) configure \ -borderwidth 1 \ -command "$widgets(listbox) yview" \ -highlightthickness 0 $widgets(button) configure \ -background $options(-buttonbackground) \ -highlightthickness 0 \ -borderwidth $options(-elementborderwidth) \ -relief raised \ -width [expr {[winfo reqwidth $widgets(vsb)] - 2}] $widgets(entry) configure \ -borderwidth 0 \ -relief flat \ -highlightthickness 0 $widgets(dropdown) configure \ -borderwidth $options(-elementborderwidth) \ -relief sunken $widgets(listbox) configure \ -selectmode browse \ -background [$widgets(entry) cget -bg] \ -yscrollcommand "$widgets(vsb) set" \ -exportselection false \ -borderwidth 0 # trace add variable ::combobox::${w}::entryTextVariable write \ # [list ::combobox::EntryTrace $w] # this moves the original frame widget proc into our # namespace and gives it a handy name rename ::$w $widgets(frame) # Finally, create our widget proc. Obviously (?) it goes in # the global namespace. All combobox widgets will actually # share the same widget proc to cut down on the amount of # bloat. proc ::$w {command args} \ "eval ::combobox::WidgetProc $w \$command \$args" # ok, the thing exists... let's do a bit more INSTANCE configuration. if {[catch "::combobox::Configure \ [list $widgets(this)] [array get options]" error]} { catch {destroy $w} error "internal error: $error" } return "" } # ::combobox::HandleEvent -- # # this proc handles events from the entry widget that we want # handled specially (typically, to allow navigation of the list # even though the focus is in the entry widget) # # Arguments: # # w widget pathname # event a string representing the event (not necessarily an # actual event) # args additional arguments required by particular events proc ::combobox::HandleEvent {w event args} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options upvar ::combobox::${w}::oldValue oldValue # for all of these events, if we have a special action we'll # do that and do a "return -code break" to keep additional # bindings from firing. Otherwise we'll let the event fall # on through. switch $event { "" { if {[winfo ismapped $widgets(dropdown)]} { set D [lindex $args 0] # the '120' number in the following expression has # it's genesis in the tk bind manpage, which suggests # that the smallest value of %D for mousewheel events # will be 120. The intent is to scroll one line at a time. $widgets(listbox) yview scroll [expr {-($D/120)}] units } } "" { # if the widget is editable, clear the selection. # this makes it more obvious what will happen if the # user presses (and helps our code know what # to do if the user presses return) if {$options(-editable)} { $widgets(listbox) see 0 $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor 0 $widgets(listbox) activate 0 } } "" { set oldValue [$widgets(entry) get] } "" { if {![winfo ismapped $widgets(dropdown)]} { # did the value change? set newValue [$widgets(entry) get] if {$oldValue != $newValue} { CallCommand $widgets(this) $newValue } } } "<1>" { set editable [::combobox::GetBoolean $options(-editable)] if {!$editable} { if {[winfo ismapped $widgets(dropdown)]} { $widgets(this) close return -code break; } else { if {$options(-state) != "disabled"} { $widgets(this) open return -code break; } } } } "" { if {$options(-state) != "disabled"} { $widgets(this) toggle return -code break; } } "" { if {[winfo ismapped $widgets(dropdown)]} { ::combobox::Find $widgets(this) 0 return -code break; } else { ::combobox::SetValue $widgets(this) [$widgets(this) get] } } "" { # $widgets(entry) delete 0 end # $widgets(entry) insert 0 $oldValue if {[winfo ismapped $widgets(dropdown)]} { $widgets(this) close return -code break; } } "" { # did the value change? set newValue [$widgets(entry) get] if {$oldValue != $newValue} { CallCommand $widgets(this) $newValue } if {[winfo ismapped $widgets(dropdown)]} { ::combobox::Select $widgets(this) \ [$widgets(listbox) curselection] return -code break; } } "" { $widgets(listbox) yview scroll 1 pages set index [$widgets(listbox) index @0,0] $widgets(listbox) see $index $widgets(listbox) activate $index $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor $index $widgets(listbox) selection set $index } "" { $widgets(listbox) yview scroll -1 pages set index [$widgets(listbox) index @0,0] $widgets(listbox) activate $index $widgets(listbox) see $index $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor $index $widgets(listbox) selection set $index } "" { if {[winfo ismapped $widgets(dropdown)]} { ::combobox::tkListboxUpDown $widgets(listbox) 1 return -code break; } else { if {$options(-state) != "disabled"} { $widgets(this) open return -code break; } } } "" { if {[winfo ismapped $widgets(dropdown)]} { ::combobox::tkListboxUpDown $widgets(listbox) -1 return -code break; } else { if {$options(-state) != "disabled"} { $widgets(this) open return -code break; } } } } return "" } # ::combobox::DestroyHandler {w} -- # # Cleans up after a combobox widget is destroyed # # Arguments: # # w widget pathname # # Results: # # The namespace that was created for the widget is deleted, # and the widget proc is removed. proc ::combobox::DestroyHandler {w} { catch { # if the widget actually being destroyed is of class Combobox, # remove the namespace and associated proc. if {[string compare [winfo class $w] "Combobox"] == 0} { # delete the namespace and the proc which represents # our widget namespace delete ::combobox::$w rename $w {} } } return "" } # ::combobox::Find # # finds something in the listbox that matches the pattern in the # entry widget and selects it # # N.B. I'm not convinced this is working the way it ought to. It # works, but is the behavior what is expected? I've also got a gut # feeling that there's a better way to do this, but I'm too lazy to # figure it out... # # Arguments: # # w widget pathname # exact boolean; if true an exact match is desired # # Returns: # # Empty string proc ::combobox::Find {w {exact 0}} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options ## *sigh* this logic is rather gross and convoluted. Surely ## there is a more simple, straight-forward way to implement ## all this. As the saying goes, I lack the time to make it ## shorter... # use what is already in the entry widget as a pattern set pattern [$widgets(entry) get] if {[string length $pattern] == 0} { # clear the current selection $widgets(listbox) see 0 $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor 0 $widgets(listbox) activate 0 return } # we're going to be searching this list... set list [$widgets(listbox) get 0 end] # if we are doing an exact match, try to find, # well, an exact match set exactMatch -1 if {$exact} { set exactMatch [lsearch -exact $list $pattern] } # search for it. We'll try to be clever and not only # search for a match for what they typed, but a match for # something close to what they typed. We'll keep removing one # character at a time from the pattern until we find a match # of some sort. set index -1 while {$index == -1 && [string length $pattern]} { set index [lsearch -glob $list "$pattern*"] if {$index == -1} { regsub {.$} $pattern {} pattern } } # this is the item that most closely matches... set thisItem [lindex $list $index] # did we find a match? If so, do some additional munging... if {$index != -1} { # we need to find the part of the first item that is # unique WRT the second... I know there's probably a # simpler way to do this... set nextIndex [expr {$index + 1}] set nextItem [lindex $list $nextIndex] # we don't really need to do much if the next # item doesn't match our pattern... if {[string match $pattern* $nextItem]} { # ok, the next item matches our pattern, too # now the trick is to find the first character # where they *don't* match... set marker [string length $pattern] while {$marker <= [string length $pattern]} { set a [string index $thisItem $marker] set b [string index $nextItem $marker] if {[string compare $a $b] == 0} { append pattern $a incr marker } else { break } } } else { set marker [string length $pattern] } } else { set marker end set index 0 } # ok, we know the pattern and what part is unique; # update the entry widget and listbox appropriately if {$exact && $exactMatch == -1} { # this means we didn't find an exact match $widgets(listbox) selection clear 0 end $widgets(listbox) see $index } elseif {!$exact} { # this means we found something, but it isn't an exact # match. If we find something that *is* an exact match we # don't need to do the following, since it would merely # be replacing the data in the entry widget with itself set oldstate [$widgets(entry) cget -state] $widgets(entry) configure -state normal $widgets(entry) delete 0 end $widgets(entry) insert end $thisItem $widgets(entry) selection clear $widgets(entry) selection range $marker end $widgets(listbox) activate $index $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor $index $widgets(listbox) selection set $index $widgets(listbox) see $index $widgets(entry) configure -state $oldstate } } # ::combobox::Select -- # # selects an item from the list and sets the value of the combobox # to that value # # Arguments: # # w widget pathname # index listbox index of item to be selected # # Returns: # # empty string proc ::combobox::Select {w index} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options # the catch is because I'm sloppy -- presumably, the only time # an error will be caught is if there is no selection. if {![catch {set data [$widgets(listbox) get [lindex $index 0]]}]} { ::combobox::SetValue $widgets(this) $data $widgets(listbox) selection clear 0 end $widgets(listbox) selection anchor $index $widgets(listbox) selection set $index } $widgets(entry) selection range 0 end $widgets(entry) icursor end $widgets(this) close return "" } # ::combobox::HandleScrollbar -- # # causes the scrollbar of the dropdown list to appear or disappear # based on the contents of the dropdown listbox # # Arguments: # # w widget pathname # action the action to perform on the scrollbar # # Returns: # # an empty string proc ::combobox::HandleScrollbar {w {action "unknown"}} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options if {$options(-height) == 0} { set hlimit $options(-maxheight) } else { set hlimit $options(-height) } switch $action { "grow" { if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} { pack forget $widgets(listbox) pack $widgets(vsb) -side right -fill y -expand n pack $widgets(listbox) -side left -fill both -expand y } } "shrink" { if {$hlimit > 0 && [$widgets(listbox) size] <= $hlimit} { pack forget $widgets(vsb) } } "crop" { # this means the window was cropped and we definitely # need a scrollbar no matter what the user wants pack forget $widgets(listbox) pack $widgets(vsb) -side right -fill y -expand n pack $widgets(listbox) -side left -fill both -expand y } default { if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} { pack forget $widgets(listbox) pack $widgets(vsb) -side right -fill y -expand n pack $widgets(listbox) -side left -fill both -expand y } else { pack forget $widgets(vsb) } } } return "" } # ::combobox::ComputeGeometry -- # # computes the geometry of the dropdown list based on the size of the # combobox... # # Arguments: # # w widget pathname # # Returns: # # the desired geometry of the listbox proc ::combobox::ComputeGeometry {w} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options if {$options(-height) == 0 && $options(-maxheight) != "0"} { # if this is the case, count the items and see if # it exceeds our maxheight. If so, set the listbox # size to maxheight... set nitems [$widgets(listbox) size] if {$nitems > $options(-maxheight)} { # tweak the height of the listbox $widgets(listbox) configure -height $options(-maxheight) } else { # un-tweak the height of the listbox $widgets(listbox) configure -height 0 } update idletasks } # compute height and width of the dropdown list set bd [$widgets(dropdown) cget -borderwidth] set height [expr {[winfo reqheight $widgets(dropdown)] + $bd + $bd}] if {[string length $options(-dropdownwidth)] == 0 || $options(-dropdownwidth) == 0} { set width [winfo width $widgets(this)] } else { set m [font measure [$widgets(listbox) cget -font] "m"] set width [expr {$options(-dropdownwidth) * $m}] } # (Sadly, for Windows users the following measurements won't take into # consideration the height of the taskbar, but don't blame me -- there # isn't any way to detect it or figure out its dimensions. The same is # likely true of any window manager with some magic windows glued to the # top or bottom of the screen) # Figure out where to place it on the screen, trying to take into account # we MAY be running under some virtual window manager # (but lets use REALLY-short varnames, 'cause it gets a little involved) # N.B> ALL width/height values are POSITIVE MAGNITUDES only (not coords) lassign "[winfo vrootx $widgets(this)] [winfo vrooty $widgets(this)] [winfo rootx $widgets(this)] [winfo rooty $widgets(this)] $width $height 0 0 [winfo screenwidth $widgets(this)] [winfo screenheight $widgets(this)]" vx vy x y w h X Y W H ########### mpm #TK-BUG? Detected: Oct2020 TK8.6.3(+) Multiple display-monitor hack ### # While the screen DIMENSIONs *may* be correct, they are UN-TETHERED when # related to anything BUT a "main" display SCREEN...(eg. a 2nd monitor) # (ie. where WxH is NOT anchored at [0,0], be that actually or virtually) # The BUG: there exists NO MEANS of obtaining THAT screens ORIGIN coord! # # So, IFF the widget is OUTSIDE the 0-based screen dimension AT THE OUTSET, # then RESET the X,Y,W,H values to its containing Toplevel before going on if {($y+$vy+$h < $Y) || ($y+$vy+$h > $Y+$H) || ($y+$vy < $Y) || ($y+$vy > $Y+$H)} { set TL [winfo toplevel $widgets(this)] lassign "[winfo rootx $TL] [winfo rooty $TL] [winfo width $TL] [winfo height $TL]" X Y W H } # The x coordinate is simply the rootx of our widget, adjusted for # the virtual window. We won't worry about whether the window will # be offscreen to the left or right -- we want the illusion that it # is part of the entry widget, so if part of the entry widget is off- # screen, so will the list. If you want to change the behavior, # simply change the "if{0}" statement... (AND update this comment!) incr x $vx if {0} { # Keep it inboard of the defined limits (when possible) if {($x + $w) > ($X + $W)} { set x [expr {$X + $W - $w}] } if { $x < $X} { set x $X } } # The y coordinate begins as the rooty plus vrooty offset plus # the height of the static part of the widget plus 1 for a # tiny bit of visual separation... set y_below [expr {$y + $vy + [winfo reqheight $widgets(this)] + 1}] # But check if it will FIT (at its present size)... if {($y_below + $h) >= ($Y + $H)} { # No? OK - Fine. So pop it UP above the entry widget instead. set y_above [expr {$y + $vy - $h - 1}] # But (again) check if it fits THERE (at its present size)... if {$y_above < $Y} { # How annoying!! This means it extended beyond our "screen" # Now we'll try to be REALLY clever and either pop it UP or # DOWN, depending on WHICH way gives us the biggest list, # TRIMMING THE LIST to fit and forcing the use of a scrollbar if {($y+$vy) > ($Y + ($H / 2))} { # we are in the LOWER half of the "screen" -- pop it UP. # Y will be its upper-bound; that parts easy. The HEIGHT # becomes its DISTANCE TO the y coordinate of our widget, # minus a pixel for some visual separation. set h [expr {$y + $vy - $Y - 1}] set y $Y } else { # we are in the UPPER half of the "screen" -- pop it DOWN # while trimming its HEIGHT to the lower boundary set h [expr {$y_below - ($Y + $H)}] set y $y_below } HandleScrollbar $widgets(this) crop } else { set y $y_above } } else { set y $y_below } # FINALLY return the resultant geometry return [format "=%dx%d+%d+%d" $w $h $x $y] } # ::combobox::DoInternalWidgetCommand -- # # perform an internal widget command, then mung any error results # to look like it came from our megawidget. A lot of work just to # give the illusion that our megawidget is an atomic widget # # Arguments: # # w widget pathname # subwidget pathname of the subwidget # command subwidget command to be executed # args arguments to the command # # Returns: # # The result of the subwidget command, or an error proc ::combobox::DoInternalWidgetCommand {w subwidget command args} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options set subcommand $command set command [concat $widgets($subwidget) $command $args] if {[catch $command result]} { # replace the subwidget name with the megawidget name regsub $widgets($subwidget) $result $widgets(this) result # replace specific instances of the subwidget command # with our megawidget command switch $subwidget,$subcommand { listbox,index {regsub "index" $result "list index" result} listbox,insert {regsub "insert" $result "list insert" result} listbox,delete {regsub "delete" $result "list delete" result} listbox,get {regsub "get" $result "list get" result} listbox,size {regsub "size" $result "list size" result} listbox,itemconfigure { ;# mpm: added entire switch clause regsub "itemconfigure" $result "list itemconfigure" result} } error $result } else { return $result } } # ::combobox::WidgetProc -- # # This gets uses as the widgetproc for an combobox widget. # Notice where the widget is created and you'll see that the # actual widget proc merely evals this proc with all of the # arguments intact. # # Note that some widget commands are defined "inline" (ie: # within this proc), and some do most of their work in # separate procs. This is merely because sometimes it was # easier to do it one way or the other. # # Arguments: # # w widget pathname # command widget subcommand # args additional arguments; varies with the subcommand # # Results: # # Performs the requested widget command proc ::combobox::WidgetProc {w command args} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options upvar ::combobox::${w}::oldFocus oldFocus upvar ::combobox::${w}::oldGrab oldGrab set command [::combobox::Canonize $w command $command] # this is just shorthand notation... set doWidgetCommand \ [list ::combobox::DoInternalWidgetCommand $widgets(this)] if {$command == "list"} { # ok, the next argument is a list command; we'll # rip it from args and append it to command to # create a unique internal command # # NB: because of the sloppy way we are doing this, # we'll also let the user enter our secret command # directly (eg: list-insert, list-delete , etc), but we # won't document that fact (mpm: bugfix - was missing Canonize) set command "list-[::combobox::Canonize \ $w {list command} [lindex $args 0]]" set args [lrange $args 1 end] } set result "" # many of these commands are just synonyms for specific # commands in one of the subwidgets. We'll get them out # of the way first, then do the custom commands. switch $command { bbox - delete - get - icursor - index - insert - scan - selection - xview { set result [eval $doWidgetCommand entry $command $args] } list-get {set result [eval $doWidgetCommand listbox get $args]} list-index {set result [eval $doWidgetCommand listbox index $args]} list-size {set result [eval $doWidgetCommand listbox size $args]} list-itemconfigure { ;# mpm - added entire switch clause set result [eval $doWidgetCommand listbox itemconfigure $args]} select { if {[llength $args] == 1} { set index [lindex $args 0] set result [Select $widgets(this) $index] } else { error "usage: $w select index" } } subwidget { set knownWidgets [list button entry listbox dropdown vsb] if {[llength $args] == 0} { return $knownWidgets } set name [lindex $args 0] if {[lsearch $knownWidgets $name] != -1} { set result $widgets($name) } else { error "unknown subwidget $name" } } curselection { set result [eval $doWidgetCommand listbox curselection] } list-insert { eval $doWidgetCommand listbox insert $args set result [HandleScrollbar $w "grow"] } list-delete { eval $doWidgetCommand listbox delete $args set result [HandleScrollbar $w "shrink"] } toggle { # ignore this command if the widget is disabled... if {$options(-state) == "disabled"} return # pops down the list if it is not, hides it # if it is... if {[winfo ismapped $widgets(dropdown)]} { set result [$widgets(this) close] } else { set result [$widgets(this) open] } } open { # if this is an editable combobox, the focus should # be set to the entry widget if {$options(-editable)} { focus $widgets(entry) $widgets(entry) select range 0 end $widgets(entry) icursor end } # if we are disabled, we won't allow this to happen if {$options(-state) == "disabled"} { return 0 } # if there is a -opencommand, execute it now if {[string length $options(-opencommand)] > 0} { # hmmm... should I do a catch, or just let the normal # error handling handle any errors? For now, the latter... uplevel \#0 $options(-opencommand) } # compute the geometry of the window to pop up, and set # it, and force the window manager to take notice # (even if it is not presently visible). # # this isn't strictly necessary if the window is already # mapped, but we'll go ahead and set the geometry here # since its harmless and *may* actually reset the geometry # to something better in some weird case. set geometry [::combobox::ComputeGeometry $widgets(this)] wm geometry $widgets(dropdown) $geometry update idletasks # if we are already open, there's nothing else to do if {[winfo ismapped $widgets(dropdown)]} { return 0 } # save the widget that currently has the focus; we'll restore # the focus there when we're done set oldFocus [focus] # ok, tweak the visual appearance of things and # make the list pop up $widgets(button) configure -relief sunken wm deiconify $widgets(dropdown) update idletasks raise $widgets(dropdown) # force focus to the entry widget so we can handle keypress # events for traversal focus -force $widgets(entry) # select something by default, but only if its an # exact match... ::combobox::Find $widgets(this) 1 # save the current grab state for the display containing # this widget. We'll restore it when we close the dropdown # list set status "none" set grab [grab current $widgets(this)] if {$grab != ""} {set status [grab status $grab]} set oldGrab [list $grab $status] unset grab status # *gasp* do a global grab!!! Mom always told me not to # do things like this, but sometimes a man's gotta do # what a man's gotta do. grab -global $widgets(this) # fake the listbox into thinking it has focus. This is # necessary to get scanning initialized properly in the # listbox. event generate $widgets(listbox) return 1 } close { # if we are already closed, don't do anything... if {![winfo ismapped $widgets(dropdown)]} { return 0 } # restore the focus and grab, but ignore any errors... # we're going to be paranoid and release the grab before # trying to set any other grab because we really really # really want to make sure the grab is released. catch {focus $oldFocus} result catch {grab release $widgets(this)} catch { set status [lindex $oldGrab 1] if {$status == "global"} { grab -global [lindex $oldGrab 0] } elseif {$status == "local"} { grab [lindex $oldGrab 0] } unset status } # hides the listbox $widgets(button) configure -relief raised wm withdraw $widgets(dropdown) # select the data in the entry widget. Not sure # why, other than observation seems to suggest that's # what windows widgets do. set editable [::combobox::GetBoolean $options(-editable)] if {$editable} { $widgets(entry) selection range 0 end $widgets(button) configure -relief raised } # magic tcl stuff (see tk.tcl in the distribution # lib directory) ::combobox::tkCancelRepeat return 1 } cget { if {[llength $args] != 1} { error "wrong # args: should be $w cget option" } set opt [::combobox::Canonize $w option [lindex $args 0]] if {$opt == "-value"} { set result [$widgets(entry) get] } else { set result $options($opt) } } configure { set result [eval ::combobox::Configure {$w} $args] } default { error "bad option \"$command\"" } } return $result } # ::combobox::Configure -- # # Implements the "configure" widget subcommand # # Arguments: # # w widget pathname # args zero or more option/value pairs (or a single option) # # Results: # # Performs typcial "configure" type requests on the widget proc ::combobox::Configure {w args} { variable widgetOptions variable defaultEntryCursor upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options if {[llength $args] == 0} { # hmmm. User must be wanting all configuration information # note that if the value of an array element is of length # one it is an alias, which needs to be handled slightly # differently set results {} foreach opt [lsort [array names widgetOptions]] { if {[llength $widgetOptions($opt)] == 1} { set alias $widgetOptions($opt) set optName $widgetOptions($alias) lappend results [list $opt $optName] } else { set optName [lindex $widgetOptions($opt) 0] set optClass [lindex $widgetOptions($opt) 1] set default [option get $w $optName $optClass] if {[info exists options($opt)]} { lappend results [list $opt $optName $optClass \ $default $options($opt)] } else { lappend results [list $opt $optName $optClass \ $default ""] } } } return $results } # one argument means we are looking for configuration # information on a single option if {[llength $args] == 1} { set opt [::combobox::Canonize $w option [lindex $args 0]] set optName [lindex $widgetOptions($opt) 0] set optClass [lindex $widgetOptions($opt) 1] set default [option get $w $optName $optClass] set results [list $opt $optName $optClass \ $default $options($opt)] return $results } # if we have an odd number of values, bail. if {[expr {[llength $args]%2}] == 1} { # hmmm. An odd number of elements in args error "value for \"[lindex $args end]\" missing" } # Great. An even number of options. Let's make sure they # are all valid before we do anything. Note that Canonize # will generate an error if it finds a bogus option; otherwise # it returns the canonical option name foreach {name value} $args { set name [::combobox::Canonize $w option $name] set opts($name) $value } # process all of the configuration options # some (actually, most) options require us to # do something, like change the attributes of # a widget or two. Here's where we do that... # # note that the handling of disabledforeground and # disabledbackground is a little wonky. First, we have # to deal with backwards compatibility (ie: tk 8.3 and below # didn't have such options for the entry widget), and # we have to deal with the fact we might want to disable # the entry widget but use the normal foreground/background # for when the combobox is not disabled, but not editable either. set updateVisual 0 foreach option [array names opts] { set newValue $opts($option) if {[info exists options($option)]} { set oldValue $options($option) } switch -- $option { -buttonbackground { $widgets(button) configure -background $newValue } -background { set updateVisual 1 set options($option) $newValue } -borderwidth { $widgets(frame) configure -borderwidth $newValue set options($option) $newValue } -command { # nothing else to do... set options($option) $newValue } -commandstate { # do some value checking... if {$newValue != "normal" && $newValue != "disabled"} { set options($option) $oldValue set message "bad state value \"$newValue\";" append message " must be normal or disabled" error $message } set options($option) $newValue } -cursor { $widgets(frame) configure -cursor $newValue $widgets(entry) configure -cursor $newValue $widgets(listbox) configure -cursor $newValue set options($option) $newValue } -disabledforeground { set updateVisual 1 set options($option) $newValue } -disabledbackground { set updateVisual 1 set options($option) $newValue } -dropdownwidth { set options($option) $newValue } -editable { set updateVisual 1 if {$newValue} { # it's editable... $widgets(entry) configure -state normal \ -cursor $defaultEntryCursor } else { $widgets(entry) configure -state disabled \ -cursor $options(-cursor) } set options($option) $newValue } -elementborderwidth { $widgets(button) configure -borderwidth $newValue $widgets(vsb) configure -borderwidth $newValue $widgets(dropdown) configure -borderwidth $newValue set options($option) $newValue } -font { $widgets(entry) configure -font $newValue $widgets(listbox) configure -font $newValue set options($option) $newValue } -foreground { set updateVisual 1 set options($option) $newValue } -height { $widgets(listbox) configure -height $newValue HandleScrollbar $w set options($option) $newValue } -highlightbackground { $widgets(frame) configure -highlightbackground $newValue set options($option) $newValue } -highlightcolor { $widgets(frame) configure -highlightcolor $newValue set options($option) $newValue } -highlightthickness { $widgets(frame) configure -highlightthickness $newValue set options($option) $newValue } -image { if {[string length $newValue] > 0} { # puts "old button width: [$widgets(button) cget -width]" $widgets(button) configure \ -image $newValue \ -width [expr {[image width $newValue] + 2}] # puts "new button width: [$widgets(button) cget -width]" } else { $widgets(button) configure -image ::combobox::bimage } set options($option) $newValue } -listvar { if {[catch {$widgets(listbox) cget -listvar}]} { return -code error \ "-listvar not supported with this version of tk" } $widgets(listbox) configure -listvar $newValue set options($option) $newValue } -maxheight { # ComputeGeometry may dork with the actual height # of the listbox, so let's undork it $widgets(listbox) configure -height $options(-height) HandleScrollbar $w set options($option) $newValue } -opencommand { # nothing else to do... set options($option) $newValue } -relief { $widgets(frame) configure -relief $newValue set options($option) $newValue } -selectbackground { $widgets(entry) configure -selectbackground $newValue $widgets(listbox) configure -selectbackground $newValue set options($option) $newValue } -selectborderwidth { $widgets(entry) configure -selectborderwidth $newValue $widgets(listbox) configure -selectborderwidth $newValue set options($option) $newValue } -selectforeground { $widgets(entry) configure -selectforeground $newValue $widgets(listbox) configure -selectforeground $newValue set options($option) $newValue } -state { if {$newValue == "normal"} { set updateVisual 1 # it's enabled set editable [::combobox::GetBoolean \ $options(-editable)] if {$editable} { $widgets(entry) configure -state normal $widgets(entry) configure -takefocus 1 } # note that $widgets(button) is actually a label, # not a button. And being able to disable labels # wasn't possible until tk 8.3. (makes me wonder # why I chose to use a label, but that answer is # lost to antiquity) if {[info patchlevel] >= 8.3} { $widgets(button) configure -state normal } } elseif {$newValue == "disabled"} { set updateVisual 1 # it's disabled $widgets(entry) configure -state disabled $widgets(entry) configure -takefocus 0 # note that $widgets(button) is actually a label, # not a button. And being able to disable labels # wasn't possible until tk 8.3. (makes me wonder # why I chose to use a label, but that answer is # lost to antiquity) if {$::tcl_version >= 8.3} { $widgets(button) configure -state disabled } } else { set options($option) $oldValue set message "bad state value \"$newValue\";" append message " must be normal or disabled" error $message } set options($option) $newValue } -takefocus { $widgets(entry) configure -takefocus $newValue set options($option) $newValue } -textvariable { $widgets(entry) configure -textvariable $newValue set options($option) $newValue } -value { ::combobox::SetValue $widgets(this) $newValue set options($option) $newValue } -width { $widgets(entry) configure -width $newValue $widgets(listbox) configure -width $newValue set options($option) $newValue } -xscrollcommand { $widgets(entry) configure -xscrollcommand $newValue set options($option) $newValue } } if {$updateVisual} {UpdateVisualAttributes $w} } } # ::combobox::UpdateVisualAttributes -- # # sets the visual attributes (foreground, background mostly) # based on the current state of the widget (normal/disabled, # editable/non-editable) # # why a proc for such a simple thing? Well, in addition to the # various states of the widget, we also have to consider the # version of tk being used -- versions from 8.4 and beyond have # the notion of disabled foreground/background options for various # widgets. All of the permutations can get nasty, so we encapsulate # it all in one spot. # # note also that we don't handle all visual attributes here; just # the ones that depend on the state of the widget. The rest are # handled on a case by case basis # # Arguments: # w widget pathname # # Returns: # empty string proc ::combobox::UpdateVisualAttributes {w} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options if {$options(-state) == "normal"} { set foreground $options(-foreground) set background $options(-background) } elseif {$options(-state) == "disabled"} { set foreground $options(-disabledforeground) set background $options(-disabledbackground) } $widgets(entry) configure -foreground $foreground -background $background $widgets(listbox) configure -foreground $foreground -background $background $widgets(button) configure -foreground $foreground $widgets(vsb) configure -background $background -troughcolor $background $widgets(frame) configure -background $background # we need to set the disabled colors in case our widget is disabled. # We could actually check for disabled-ness, but we also need to # check whether we're enabled but not editable, in which case the # entry widget is disabled but we still want the enabled colors. It's # easier just to set everything and be done with it. if {$::tcl_version >= 8.4} { $widgets(entry) configure \ -disabledforeground $foreground \ -disabledbackground $background $widgets(button) configure -disabledforeground $foreground $widgets(listbox) configure -disabledforeground $foreground } } # ::combobox::SetValue -- # # sets the value of the combobox and calls the -command, # if defined # # Arguments: # # w widget pathname # newValue the new value of the combobox # # Returns # # Empty string proc ::combobox::SetValue {w newValue} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options upvar ::combobox::${w}::ignoreTrace ignoreTrace upvar ::combobox::${w}::oldValue oldValue if {[info exists options(-textvariable)] \ && [string length $options(-textvariable)] > 0} { set variable ::$options(-textvariable) set $variable $newValue } else { set oldstate [$widgets(entry) cget -state] $widgets(entry) configure -state normal $widgets(entry) delete 0 end $widgets(entry) insert 0 $newValue $widgets(entry) configure -state $oldstate } # set our internal textvariable; this will cause any public # textvariable (ie: defined by the user) to be updated as # well # set ::combobox::${w}::entryTextVariable $newValue # redefine our concept of the "old value". Do it before running # any associated command so we can be sure it happens even # if the command somehow fails. set oldValue $newValue # call the associated command. The proc will handle whether or # not to actually call it, and with what args CallCommand $w $newValue return "" } # ::combobox::CallCommand -- # # calls the associated command, if any, appending the new # value to the command to be called. # # Arguments: # # w widget pathname # newValue the new value of the combobox # # Returns # # empty string proc ::combobox::CallCommand {w newValue} { upvar ::combobox::${w}::widgets widgets upvar ::combobox::${w}::options options # call the associated command, if defined and -commandstate is # set to "normal" if {$options(-commandstate) == "normal" && \ [string length $options(-command)] > 0} { set args [list $widgets(this) $newValue] uplevel \#0 $options(-command) $args } } # ::combobox::GetBoolean -- # # returns the value of a (presumably) boolean string (ie: it should # do the right thing if the string is "yes", "no", "true", 1, etc # # Arguments: # # value value to be converted # errorValue a default value to be returned in case of an error # # Returns: # # a 1 or zero, or the value of errorValue if the string isn't # a proper boolean value proc ::combobox::GetBoolean {value {errorValue 1}} { if {[catch {expr {([string trim $value])?1:0}} res]} { return $errorValue } else { return $res } } # ::combobox::convert -- # # public routine to convert %x, %y and %W binding substitutions. # Given an x, y and or %W value relative to a given widget, this # routine will convert the values to be relative to the combobox # widget. For example, it could be used in a binding like this: # # bind .combobox {doSomething [::combobox::convert %W -x %x]} # # Note that this procedure is *not* exported, but is intended for # public use. It is not exported because the name could easily # clash with existing commands. # # Arguments: # # w a widget path; typically the actual result of a %W # substitution in a binding. It should be either a # combobox widget or one of its subwidgets # # args should one or more of the following arguments or # pairs of arguments: # # -x will convert the value ; typically will # be the result of a %x substitution # -y will convert the value ; typically will # be the result of a %y substitution # -W (or -w) will return the name of the combobox widget # which is the parent of $w # # Returns: # # a list of the requested values. For example, a single -w will # result in a list of one items, the name of the combobox widget. # Supplying "-x 10 -y 20 -W" (in any order) will return a list of # three values: the converted x and y values, and the name of # the combobox widget. proc ::combobox::convert {w args} { set result {} if {![winfo exists $w]} { error "window \"$w\" doesn't exist" } while {[llength $args] > 0} { set option [lindex $args 0] set args [lrange $args 1 end] switch -exact -- $option { -x { set value [lindex $args 0] set args [lrange $args 1 end] set win $w while {[winfo class $win] != "Combobox"} { incr value [winfo x $win] set win [winfo parent $win] if {$win == "."} break } lappend result $value } -y { set value [lindex $args 0] set args [lrange $args 1 end] set win $w while {[winfo class $win] != "Combobox"} { incr value [winfo y $win] set win [winfo parent $win] if {$win == "."} break } lappend result $value } -w - -W { set win $w while {[winfo class $win] != "Combobox"} { set win [winfo parent $win] if {$win == "."} break; } lappend result $win } } } return $result } # ::combobox::Canonize -- # # takes a (possibly abbreviated) option or command name and either # returns the canonical name or an error # # Arguments: # # w widget pathname # object type of object to canonize; must be one of "command", # "option", "scan command" or "list command" # opt the option (or command) to be canonized # # Returns: # # Returns either the canonical form of an option or command, # or raises an error if the option or command is unknown or # ambiguous. proc ::combobox::Canonize {w object opt} { variable widgetOptions variable columnOptions variable widgetCommands variable listCommands variable scanCommands switch $object { command { if {[lsearch -exact $widgetCommands $opt] >= 0} { return $opt } # command names aren't stored in an array, and there # isn't a way to get all the matches in a list, so # we'll stuff the commands in a temporary array so # we can use [array names] set list $widgetCommands foreach element $list { set tmp($element) "" } set matches [array names tmp ${opt}*] } {list command} { if {[lsearch -exact $listCommands $opt] >= 0} { return $opt } # command names aren't stored in an array, and there # isn't a way to get all the matches in a list, so # we'll stuff the commands in a temporary array so # we can use [array names] set list $listCommands foreach element $list { set tmp($element) "" } set matches [array names tmp ${opt}*] } {scan command} { if {[lsearch -exact $scanCommands $opt] >= 0} { return $opt } # command names aren't stored in an array, and there # isn't a way to get all the matches in a list, so # we'll stuff the commands in a temporary array so # we can use [array names] set list $scanCommands foreach element $list { set tmp($element) "" } set matches [array names tmp ${opt}*] } option { if {[info exists widgetOptions($opt)] \ && [llength $widgetOptions($opt)] == 2} { return $opt } set list [array names widgetOptions] set matches [array names widgetOptions ${opt}*] } } if {[llength $matches] == 0} { set choices [HumanizeList $list] error "unknown $object \"$opt\"; must be one of $choices" } elseif {[llength $matches] == 1} { set opt [lindex $matches 0] # deal with option aliases switch $object { option { set opt [lindex $matches 0] if {[llength $widgetOptions($opt)] == 1} { set opt $widgetOptions($opt) } } } return $opt } else { set choices [HumanizeList $list] error "ambiguous $object \"$opt\"; must be one of $choices" } } # ::combobox::HumanizeList -- # # Returns a human-readable form of a list by separating items # by columns, but separating the last two elements with "or" # (eg: foo, bar or baz) # # Arguments: # # list a valid tcl list # # Results: # # A string which as all of the elements joined with ", " or # the word " or " proc ::combobox::HumanizeList {list} { if {[llength $list] == 1} { return [lindex $list 0] } else { set list [lsort $list] set secondToLast [expr {[llength $list] -2}] set most [lrange $list 0 $secondToLast] set last [lindex $list end] return "[join $most {, }] or $last" } } # This is some backwards-compatibility code to handle TIP 44 # (http://purl.org/tcl/tip/44.html). For all private tk commands # used by this widget, we'll make duplicates of the procs in the # combobox namespace. # # I'm not entirely convinced this is the right thing to do. I probably # shouldn't even be using the private commands. Then again, maybe the # private commands really should be public. Oh well; it works so it # must be OK... foreach command {TabToWindow CancelRepeat ListboxUpDown} { if {[llength [info commands ::combobox::tk$command]] == 1} break; set tmp [info commands tk$command] set proc ::combobox::tk$command if {[llength [info commands tk$command]] == 1} { set command [namespace which [lindex $tmp 0]] proc $proc {args} "uplevel $command \$args" } else { if {[llength [info commands ::tk::$command]] == 1} { proc $proc {args} "uplevel ::tk::$command \$args" } } } # end of combobox.tcl ###################################################################### # icon image data. ###################################################################### image create bitmap delta48 -data { #define delta48_width 48 #define delta48_height 48 static char delta48_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x80, 0x13, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x10, 0x00, 0x00, 0x00, 0x00, 0x40, 0x08, 0x00, 0x00, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x00, 0x00, 0x30, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x04, 0x1b, 0x00, 0x00, 0x00, 0x00, 0x06, 0x1b, 0x00, 0x00, 0x00, 0x00, 0x02, 0x33, 0x00, 0x00, 0x00, 0x00, 0x03, 0x2e, 0x00, 0x00, 0x00, 0x00, 0x11, 0x6c, 0x00, 0x00, 0x00, 0x00, 0x11, 0x68, 0x00, 0x00, 0x00, 0x80, 0x10, 0xc8, 0x00, 0x00, 0x00, 0x80, 0x10, 0xa8, 0x01, 0x00, 0x00, 0x80, 0x08, 0x08, 0x01, 0x00, 0x00, 0x80, 0x08, 0xac, 0x03, 0x00, 0x00, 0x80, 0x09, 0x06, 0x02, 0x00, 0x00, 0xc0, 0x09, 0xaa, 0x06, 0x00, 0x00, 0x40, 0x09, 0x01, 0x04, 0x00, 0x00, 0xe0, 0x93, 0xae, 0x0a, 0x00, 0x00, 0x30, 0x92, 0x06, 0x18, 0x00, 0x00, 0xb0, 0x92, 0xad, 0x1a, 0x00, 0x00, 0x18, 0x53, 0x04, 0x30, 0x00, 0x00, 0xa8, 0x11, 0xac, 0x2a, 0x00, 0x00, 0x0c, 0x12, 0x04, 0x60, 0x00, 0x00, 0xac, 0x12, 0xac, 0x6a, 0x00, 0x00, 0x02, 0x14, 0x04, 0x80, 0x00, 0x00, 0xab, 0x0a, 0xae, 0xaa, 0x01, 0x00, 0x01, 0x28, 0x02, 0x00, 0x01, 0x80, 0xab, 0x3a, 0xaf, 0xaa, 0x03, 0x80, 0x00, 0x70, 0x0c, 0x00, 0x02, 0xc0, 0xaa, 0x5a, 0xa8, 0xaa, 0x06, 0x40, 0x00, 0xa0, 0x08, 0x00, 0x0c, 0xa0, 0xaa, 0xea, 0xac, 0xaa, 0x0a, 0x30, 0x00, 0x80, 0x05, 0x00, 0x18, 0xb0, 0xaa, 0xaa, 0xab, 0xaa, 0x1a, 0x08, 0x00, 0x00, 0x04, 0x00, 0x30, 0xfc, 0xff, 0xff, 0xbe, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0xbd, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x70, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, } } image create photo deltaGif -format gif -data { R0lGODlhMAAwAOf/AAUughEzYAQ5lgg3oh43YBQ4jQ46nyo1eBc9oyw7hA1CrQxDpxlAnyQ9nik/ exxApkE+QiNBlCVAmiBArQxJmhRGqxRItyVEqyhHlCZHpzRKXh5KsCpHrzpIeiBOkypLki9JnhVQ tCNMswlTxD5HmS1MrSRPrz9LhylQnS1OqChPtiBSvz5Nki1Sui9Rvwtfr0hRhSdWw0RSiyZXvlBS X1RPeyBazS5XzGROeSxZxzRco1ZUhVFWki9dxDBexR1j1Slhzk5bj1BamkRdrlZbi1ZcgGtXfyFn 02FgUi5mzVNgmlVhkERjuSVr0U9kkFNkmF1ijEVmtkxktT9ovWZigzNszDVtuR9x3VJnoF1nhSlx 0D1sxxJ442dmjDJyxG9ncnBliFVqsEdtw2lmmTFy2Xpjj6FiDIRkZkByx6VlAjB40atkB19vo2tt k6hnBoJsXkR4x0p3wEx2xTN9z6ppCmVxrYZrfK9oDlh1unJxklR4si2B2WB0vKVsJ61sDoFwij2A 2oxxa5VucT+CyDiE0DWGy1GAt7JwFEmDuEeDxDWJ24t2hXt4rLVzGDqKz1KDzEiHwnF9ukCMxZx5 WEGL10WLzLl2GzyPzlyGxFiHy5d7dEqNwZp8art4J4Z/nEyN1WCJu1qLxJKAj0iSzFWO0MB8I5SC hFKRzLp+McF9LFCTx2SOzF6RzpeGjr+CLlyUyWWTypOJoZWMp8aHNKKOi7SPZ8uMOKqRfamRg8aP R86PQraUd7qUitKTRs+WRtCXSL6ad7aciLqaoLGfodSbUsCehrKfrr6ej7uikdCgYcahftifVcmi c8Skc8ehlsmjecCli9uhWMqmid2kYdqnYsGpqsWsjuGoZcGul8ypqt6rZdKsidisd96sbdSuhNyu c9evf9SwkuOxcdiyjs21rde2hOW0eue0dN62hum2b+G3gei2fOO4fOO5g+u4eNS9m9/BoPPAhvDB me/Bn+/CpvHFiPTGkPXFtvnJmv/Ko/7KsPvNqv7Lt/7Opf/PwP/siyH+EUNyZWF0ZWQgd2l0aCBH SU1QACH5BAEKAP8ALAAAAAAwADAAAAj+AP8JHEiwoEGDbA4qXMiwYSQxWHA0nEjRIJMtaDA9MVKx 48QoWyitWiXDo0mFTOQAYgXrEYyTMAnKIaUI1ikvO2LGjIKJEilWcIb80XmSEZ5XlE7BCaOpD1GP U9Bk+pSUT7Ffh55WrBOHpaJPidgES+YqjdaJYUKxIrXn1KhNbZgRa3S2oR5Wrx6RcQvq2Ddqs+jU VdgG1KlTigCNQhTEExi5ncwMRnhK1SkulEZJGjRIx65uugRPHvhHj9tRVxxdIqQmCYoz36KlMjv6 HxVDqkYRSs36SI4Igcx1w1r7HxRIo0bNOTJHC5AbMSJwMncOsJvaTiSNqtTkR5XnOWL+fAC2bp24 uaPfLJF0qRCQJEDCx2ghg1n56oEnT1IiiTUQGzbEIKALRnBTHjviLNPJYHTUEkQhWiRhQw7QxdCD EMewU94652jTi2haNcJMF1bEN4KAM/QgBTbtbHhfNGVplcYs3bSiQ3gnztBCCnagg46LHA6X1VON ECMONEIIaEELM5RQAy+05OENkPhdpxMdtmhzTjuiZBCDAi20EAENX3xQwDNAmodeTGukEs057Lwz DAgrKKCCChmYkIQKEqBJJTW23BHTIb90c446svDhQwsGbKDCBpBuEIEyaZoXTSm0eTQjNeeUJ4oJ M6xgwJ2PQoqCn1R66MdJRYrT6Tr+yGBw5wMcRHrBBi80UymH07gCIkV0zMLphuBQkYEKD1xQ6wUX VICBfZV2+AtdFaVhyTLiAAnNCSpcYACzFVzAAAHQRgtYpg35oYuWQLZziwfeMtssBUgYuKuallCU hpuvAonOIgwMUMHAGWhgzb33aWPLrwoRauiu27BgwAMVPAAABLfgMg7C51xqpUJrCNtvmuGwMIEB FQMQgAMHBMOxh0Mq1CrC5eSxwcQKPGBCCB1IgzCH1MR4EJbsIizNEgxM/MDSWWz8czdrFpRGKdj+ XN42UDDwwMQMmKKO1fgx/A8dvRRt9TZjPLBAA0WAY3V5CVqCrhulvPn2gdaEIQCKCbjczaE2uqw6 UJHnxFPP4Ygnrng99lQDAg/wLC454u70ShsduriDTz+cd+75553vY0wK1ewD+umc4xNPNHRhmQ4+ +vAj++y01077PWUQkY0/tvfOjz75xDMXKtfEg4888ySv/PLMM+/MDljEIgw59DTPvDzy2HNOLnUZ I0gHBSQQS3Hkl29+bQEBADs= } image create photo findImg -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAjUAAMIHEiwoEF3 AOQpXMiQIQB3ARC6a6fO3buHAiVWfAcPYwB1AN6pa/fQnUkAIy+qEwiy3bp07DqaPPmS3TqS Kz/SA8ATQDyB8XoCoJczI4B2F+VBjCjvocyBCNOVS9cxAE+rUqliRHhznbunEY96dbl15kyC Zs8OrDgzJ1uTRVnSYzcO5M8AQeu6I0oQ5DukAOAJlglPJVR5gBMifNjUqTyoAM6NK1f1auTJ YDuuOxdTKM/NneGFHVkRLEKKE0GeFGzRdODWMhd7Xipb6FKDuAsGBAA7 } image create photo ctrCDRImg -format gif -data { R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiUAAMIHBjAHYCD ANwRHHjOncOHBgkRSgjRYUOEGAEYMpQRoUMA/8SJFGdwY0JyKFFSBGCuZcuSHN25bLmyo0aO Nj+GJAkg0caNiU6q/DjToE9DQWW6rNkxUdCcBneONHhy5FCDM106zErzo82vB3XuTEm27Equ aJd6BQsVpFSRZcmeTYuWKduM7hpW3Lv33MK/gAUGBAA7 } image create photo firstCDRImg -format gif -data { R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiUAAMIdFevoMGD Bd0JXBig3j9ChAxJnDixHkOBDilqlGjxIkGEIBVevHjOnbtzI1MKLAkAwEmVJN0BIKTIJUqY AVgS+neo5kuVOv9J7Gkzpc5BFIn+XHg06SGlN1fKbDlTYiKqRRmWNFnV0FWTS7XqtGoz6six XrMClRkxbdizbMm+jQngUKK7ao1OxTo3JliTZgUGBAA7 } image create photo prevCDRImg -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAiGAAMIHCjwnDt3 5wgqLHjQHQBChgwlAtAw4cIABh9GnIjwIsOH/yIeUkTR4sWMECWW9DgQJcmOJx0SGhRR5KGR Kxei3JjT406VMH06BECUaFCWGXsilfkP51GCKGnWdGryY9GUE4s+xfiT47mqCrsq1SmT51ao ZYGCDevwUKK3Y8k2PLg2IAA7 } image create photo nextCDRImg -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAiGAAMIHHjOncGD 5wYqVFgQACFDhhIBcJdwIUN3DgsdUjSxokWBDR9G7PixIYCTIiWeJGmx4T9ChA6x/BggJESJ FGnWtDmSoseLGSFC3DizJMaiNE2uRLrQ5U2mQFNCJYhRak6dPHH+vGjQ4VOETasWEmrokFmO V6OOLYt2a1iHbXWGTbswIAA7 } image create photo lastCDRImg -format gif -data { R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiTAAMIHHjOncGD 5wYqVFgQgMOH7hIuZOgOwD9ChA4BiDiRokVDhhJtlNgxQENCIEVyLGmyIsqQI1meO5lyJEmK BgG8VGnwZsuHOmtCvHmyEEiQh5IqiumRkNGjh5auXFgUqVSfTQtFZSrT5VWWHrmCFVhwakl3 9dKqXZvW3cR6F18enVvv7b+5eEHWXYiWrV+3AgMCADs= } image create photo rediffImg -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQCrPQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAicAAMIHEiwoMF0 7AD0euVKl8OHrhjqAgDvnDsAGDOmG2jR3TmDIAVaxFiRoMJXKF/1ypgR5UqPIWOCTIfQnc2b ABpS/Bgg3cmUQIOqBHBxIUpYADYKLEqUp8ynUKMatFgy5LmrWEdOrDoQIcuvrnSWPJfQqFCg YhPCAtqrrduUL8/9fIWUJs2LQ2EGmFt34MWmBNPdvKlUquEAAQEAOw== } image create photo ignCDRImg -format gif -data { R0lGODlhFgAWAKIAANnZ2d0AAJ6enmJiYgAAAAC5AACWMQBQACH5BAEAAAAALAAAAAAWABYA AANwCLrc/jBKF8JcgtU6xSBDtlmRR2QCMZZfVhjGBj6mUrzxBoAZ9tmwXKWg4ClqAFzssHkV Q8gkLHAAMHHEnSD62lyDhiLqBxAOwc9ebRRQhnchhoeNTlNW5QXB2Bi1MHx9OgApH38RHA09 F4yNjo8MCQA7 } image create photo bkmSetImg -format gif -data { R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1Pjisd/UjtHJ a8O4SL2qJcWqAK+SAJN6AGJiAEpKADIyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiZAAMIHEhQoLqD CAsqFAigIQB3Dd0tNKjOXSxXrmABWBABgLqCByECuAir5EYJHimKvOgqFqxXrzZ2lBhgJUaY LV/GOpkSIqybOF3ClPlQIEShMF/lfLVzAcqPRhsKXRqTY1GCFaUy1ckTKkiRGhtapTkxa82u ExUSJZs2qtOUbQ2ujTsQ4luvbdXNpRtA712+UeEC7ou3YEAAADt= } image create photo bkmRlsImg -format gif -data { R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1Pjisd/UjtHJ a8O4SL2qJcWqAK+SAJN6AGJiAEpKADIyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiwAAMIHEhQoLqD CAsCWKhwIbyFANwNXBiD4UF3sVw9rLhQXQCKNTguzLgxZMePMWqo5OgqVkmVNwAIXHhDpUl3 7gCkhMkwJ02bHHfWiCkzQM5YP1cKJepRoM+kNoculEhQXc6cNW3GzNm0oFWdUSviLDgRbFST RRsuzYpWrVaoHMsujYgVKMOPUYkCWPCQbY2iP/UuiACgr9S0NDvulQBAXd+7ZYv6bPowLdmB By8LDAgAOw== } image create photo mrgC1Img -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAiIAAMIHEiwYMFz 7gAQ+meoIaGHECEeAuDuoDt35wxqFIgQAMWMGzkmVHRooseTKD1WPAgy5MCOhAZRvEizJsaR hxrq3LkzEcWXIz+eG0qUqMujSJMixJg0AEyhRYuKVDjIUMqrMxUy5MnVkM+bAEgaOpSorNmz X6eSnGmzZkunCT825fh2btKAADt= } image create photo mrgC2Img -format gif -data { R0lGODdhFAAUAPf/AAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1P/isf/Ujv/G a/+4SP+qJf+qANySALl6AJZiAHNKAFAyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAQAiNAAMIHEiwYEF3 AP79GzSIkMOHhAwZKkQIgLtzBguec3cxo8eNACxiHIgwpMmTIQ8dUiTSo8aRBDdynEkTIcWW ARBGlMizJ8+VFgOcG0q0KEKWHV0qXcp0qUyYA4tKBVkxaU6UWAFMrIoR4SCfYCXe5AjgUKKz aNMeMgT0osyaNMsihfqxpNWmQ5s2DQgAOw== } image create photo mrgC12Img -format gif -data { R0lGODlhFAAUAPMHAAAAAAB6uQCS3CWq/0i4/47U/7Hi/////729vQAAAAAAAAAAAAAAAAAAAAAA AAAAACH5BAEAAAgALAAAAAAUABQAAAT+ECGEECgAIYQQggghhBBCCIFiAEQIIYQQQgghhCACxRAA AAAAAAABAAghUA4hpBRYSimllAEQAuVAQgghhBBCCCECAoRAGIQQQgghkBBCiAAIIRAGgUMIIYQQ QggBEEQIgTAGAAAAACAAAACEEEIgDAARQgghhBBCCCGIEAIBIIQQQghBhBBCCCGEEEIIIgQKQAgh hBBCECGEEEIImAIQggghAAAAAAAAAATEFIAQQmCUUmAppZRCCDkFIAQREIQQQgghhBBIyCkAISAI IYRAQgghhJARAEIACiGEEEIIIQYZMACEEAAAAAAAgACAMQJACCGEEEQIIYQQAiMAhCAPQgghhBBC CCEEQQAIIYQiADs= } image create photo mrgC21Img -format gif -data { R0lGODlhFAAUAPMHAAAAAAB6uQCS3CWq/0i4/47U/7Hi/////729vQAAAAAAAAAAAAAAAAAAAAAA AAAAACH5BAEAAAgALAAAAAAUABQAAAT+ECGEEEIIIYRAgQAhhBBCCCGEEEQIIWAKQAghBCAAAAAA AACAmAIBQgiBUUoppRRYCiHkFIAQAoJAQgghhBBCCDkFAoSAIIQQQgghkBBCRgAIASGEgEIIIYQY ZASAEEQAAAAAAAAAMOAIACGEEEIIIQQRQgiMABBCCCGIEEIIIYQQCABBhBBCCCEECkAIIoQQQggh hBBCEBQDEEIIIYQQggghhEAxBAAAAAQAAAAAQgiUQyAhpZRSSillAAQRKIcQQgghhBBICBEAIRAG IYRAQgghhBAiAEIIgjDIEEIIIYQQUAiAEEIgjAEAgAAAAAAAACGEEARhAIQQQgghhCAPQgghhEAA CCEEEUIIIYQiADs= } image create photo splitCDRImg -format gif -data { R0lGODlhFgAWALMAANnZ2ba2tkpKSp6enmJiYgAAAAC5AACWMQBQAP////////////////// /////////yH5BAEAAAAALAAAAAAWABYAAASKEMhJaRAD41G7DEQhipjXBYWhqoVgWmBxzEjB vUAQG/NRuy9diNercXTIJGHYOxR+gcFyOhURfYUQYTAYeUdXI4Cbk63O4Wyl22z3bB22uw2v oHyIvL5pUFO6X158cGQ6XIeHIoNaR0lJXDI9fT84hpFFdUFRl1hAlTGYN5+cTp44Ul8lOBMZ rRsRADs= } image create photo cmbinCDRImg -format gif -data { R0lGODlhFgAWAKIAANnZ2ba2tkpKSgAAAJ6engC5AACWMQBQACH5BAEAAAAALAAAAAAWABYA AAOACLrcEGKQ4OqCowxBbcOFYUgeA4riUCqneGwm8QUZ+spXhCtE7cK5wUgw6YV+u0ckNGg2 C8ehaSmCWqM3hhHF7ZK0wq54lFQODq6DuvvqXHpoZ5Or4XwiL2KgR9+4WT1JfCh1fw9lATR9 dit7YVVAjRFcLytvYVmWLJN+mpcTAAkAOw== } image create photo fldrImg -format gif -data { R0lGODlhFAAWAKIAANnZ2QAAAP/MmZlmMzMzM////////////yH5BAEAAAAALAAAAAAUABYA AANUCLrc/tCFSWdUQeitQ8xcWFnYEG6miAlD67Yn64Hx2RJTXQ84raO83C8U9A1vwiGqpwQy m5oilCVlWU3YKwsHCLy+YAK3Ky6bzzjCYsSuqC/w+CMBADs= } image create photo txtfImg -format gif -data { R0lGODlhFAAWAKIAANnZ2TMzM////wAAAJmZmf///////////yH5BAEAAAAALAAAAAAUABYA AANYGLq88BAEQaudIb5pO88R11UiuI3XBXFD61JDEM8nCrtujbcW4RODmq3yC0puuxcFKBwS jaykUsA8OntQpPTZvFZF2un3iu1ul1kyuuv8Bn7wuE8WkdqNCQA7 } image create photo ancfImg -format gif -data { R0lGODlhFAAUAJEAANnZ2QAAAD8/P////yH5BAEAAAAALAAAAAAUABQAAAJKRI6ZwB0N4Xsy WkpZttp57igdaCgYiVQGuAiAcEaHtsUNjNUjXfYMPFqUZp8MMaTaXDLAFUcYRB2dyovrZSMl r9yX1yVoDk3kRwEAOw== } image create photo bkmImg -format gif -data { R0lGODlhLgAWAJEAANnZ2czMzD8/P////yH5BAEAAAAALAAAAAAuABYAAAJyjI+py20CI3S0 JgFyFrZXrHHeyECbhKbqipYAqMXyTNPiYtb6Pt9KzgvqWgcMTIiMwUS5YzK5fISe1FdIuqk+ QZPAEgAOi8fkMtmIQJnX7HIX14633z+53f0qsfZ89ctHEuglBijo4VRo+KGi2Oj4eFAAADs= } image create photo nullImg image create bitmap resize -data { #define resize_width 14 #define resize_height 11 static char resize_bits[] = { 0x20, 0x01, 0x30, 0x03, 0x38, 0x07, 0x3c, 0x0f, 0x3e, 0x1f, 0x3f, 0x3f, 0x3e, 0x1f, 0x3c, 0x0f, 0x38, 0x07, 0x30, 0x03, 0x20, 0x01 } } # Despite the common naming the U/D arrows are LARGER than the L/R ones # (the former is used on a Dialog, the latter inside the toolbar) image create bitmap arroWu -data { #define arroWu_width 29 #define arroWu_height 15 static unsigned char arroWu_bits[] = { 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00, 0x00,0x40,0x00,0x00, 0x00,0xe0,0x00,0x00, 0x00,0xf0,0x01,0x00, 0x00,0xf8,0x03,0x00, 0x00,0xfc,0x07,0x00, 0x00,0xfe,0x0f,0x00, 0x00,0xff,0x1f,0x00, 0x80,0xff,0x3f,0x00, 0xc0,0xff,0x7f,0x00, 0xe0,0xff,0xff,0x00, 0xf0,0xff,0xff,0x01, 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00 } } image create bitmap arroWd -data { #define arroWd_width 29 #define arroWd_height 15 static unsigned char arroWd_bits[] = { 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00, 0xf0,0xff,0xff,0x01, 0xe0,0xff,0xff,0x00, 0xc0,0xff,0x7f,0x00, 0x80,0xff,0x3f,0x00, 0x00,0xff,0x1f,0x00, 0x00,0xfe,0x0f,0x00, 0x00,0xfc,0x07,0x00, 0x00,0xf8,0x03,0x00, 0x00,0xf0,0x01,0x00, 0x00,0xe0,0x00,0x00, 0x00,0x40,0x00,0x00, 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00 } } image create bitmap arroWl -data { #define arroWl_width 10 #define arroWl_height 21 static unsigned char arroWl_bits[] = { 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x01, 0x80,0x01,0xc0,0x01, 0xe0,0x01,0xf0,0x01, 0xf8,0x01,0xfc,0x01, 0xfe,0x01,0xfc,0x01, 0xf8,0x01,0xf0,0x01, 0xe0,0x01,0xc0,0x01, 0x80,0x01,0x00,0x01, 0x00,0x00,0x00,0x00, 0x00,0x00 } } image create bitmap arroWr -data { #define arroWr_width 10 #define arroWr_height 21 static unsigned char arroWr_bits[] = { 0x00,0x00,0x00,0x00, 0x00,0x00,0x02,0x00, 0x06,0x00,0x0e,0x00, 0x1e,0x00,0x3e,0x00, 0x7e,0x00,0xfe,0x00, 0xfe,0x01,0xfe,0x00, 0x7e,0x00,0x3e,0x00, 0x1e,0x00,0x0e,0x00, 0x06,0x00,0x02,0x00, 0x00,0x00,0x00,0x00, 0x00,0x00 } } ############################################################################### # run the main proc main tkrev_9.6.1/tkdiff/README.txt0000664000175000017500000000676315030665276016247 0ustar dorothyrdorothyrWhat this is: TkDiff is a Tcl/Tk front-end to diff for Unix/Linux, Windows, and MacOS. TkDiff knows how to work with several revision control systems: CVS, Subversion, Git, SCCS, RCS, PVCS, BitKeeper, Perforce, Accurev, Mercurial and ClearCase. It's only tested on the free and open source ones. ================================================================================ Requirements: As a 'pure' Tcl implementation, the runtime requirements are limited to an appropriate level of Tcl/Tk support: Versions *Prior* to V4.3 of TkDiff, needs at least V8.0 of Tcl/Tk and Wish Versions *At/After* V4.3 of TkDiff, needs at least V8.5 or Tcl/Tk and Wish Exceeding these requirements (more recent Tcl/Tk releases) is DESIGNED to be generally harmless, as it is INTENDED to transparently adapt ================================================================================ Platforms: On Linux or Unix, simply invoke it from the command line. tkdiff --help will list the options. On MacOS, an old version of wish (tk8.5) is installed with the OS, but it's been deprecated for years and it works poorly if at all. The Homebrew tcl-tk package is an excellent replacement. Then, you can invoke tkdiff from the terminal just as on Unix/Linux, or you can double-click on it in the Finder, and a terminal will open and run it. On Windows, you must find diff.exe somewhere. You must install Wish on your computer. You can use ActiveTcl from www.activestate.com or get it from the tcl/tk project on Sourceforge. To run on Windows, it's easiest to rename tkdiff to tkdiff.tcl. Then when you double-click on it, it will open in Wish. You can of course make a desktop shortcut for it. ================================================================================ Additional Assistance: TkDiff has an EXTENSIVE builtin Help description of nearly every aspect of its operation, default settings, expected behaviors, interaction scenarios and even optional User re-configurations that are permitted. As such, there is no acompanying "manual page" in the distribution as it would be singularly HUGE. ================================================================================ License: This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ================================================================================ Credits: TkDiff is Copyright (C) 1994-2006 by John M. Klassa, among others: Copyright (C) 1998 by Bryan Oakley Copyright (C) 1999-2001 by AccuRev Inc. Copyright (C) 2004 by Tom Dunne Copyright (C) 2004-2025 by Dorothy Robinson ("dorothyr") Copyright (C) 2017-2025 by Michael-M ("vampm") Many of the toolbar icons were created by Dean S. Jones and used with his permission. These icons have the following Copyright: Copyright(C) 1998 by Dean S. Jones dean@gallant.com http://www.gallant.com/icons.htm http://www.javalobby.org/jfa/projects/icons/ Others not coverred by the above are the work of Michael-M tkrev_9.6.1/tkdiff/Delta.ico0000664000175000017500000030253611633012153016254 0ustar dorothyrdorothyr hV 00 %f@@ (B; (6}(  @m[7 oS Tѫ﹣śߣaٱriok`y"y c2w|||P4@|||y< ciIV{||k`@|A)||{`ng%{r|E$E!N1z||v/ ` f%GzgYF!I%I z|{Si?uj}xK!K,J*||q${ d@hPT#S0|zEd!Dwew?e(X-ZA{htdcj~Mz5p2R*s9 cbωDˉ>iD\l]o[SʋWЈC-`sRЌM{m7oG wGˋVWTmsWvS_Z( @ Yi wT a@#Rq|sssssssssssssssuVWB.gc΅sssssssss^s xkJ=}0 c/${ulS8 ee ^ gD'||||||||zh${ cI fa0l{||||||?>>@~x|||||||{sD j be kSv{|||||H'>A>JUF}||||||yau c-bG&}gz|||||9?BS c_d||||||{o8 fZ gEt{|||QD:D DEl{w|||||||wVn ` e)tby||~niO";F$E"Bg6t|||||{k+ e[ fy8o{|H%L'?I%G$F#Ex||||{tLl ` doZw|ljR*I$CL&J%F#Ry||||zf#z d? dY.k}aAJ FN)L(N(A}|||{rA i_ b kMuN8K O%N*xF5YE?||||x]s a' d?!ygR,Q#R$S,K;||{o4dw _ hTbSe/W!U$W-V-vo|||vSn _  c%D~gA{5g'Y#V,U-W*s|}|zj*cSTomJ̍=x4]$\-X-W+I1x{tIjab`nGmMˏF͈=a&k1[-X,J(uyd!y c7jn_gWǑMˑFo)Ά8t3_.H(nq> gg{|onÍSɒQz,΋=̊;x5Y*n}\q c#}cZɐWՈ=҇;Em[gUs3co oWʐ[͉P|7͒LmQm`n^qłSʑ_؈;ŋN{fh(~cOmMzSՌG̎Ot]WkcjNʊWӍGǃPeHstm'wRڈD˔`~FYX`>gnBюSʋ`SLݯ mNEjC~W\TZ|%v\cWÁg|(0` %_w[K-Z %{Y 3'U;k=y={=x=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=w=IpjuB/47!Cw=w=w=w=w=w=w=w=w=w=w=z={=q=_;0~a񓙿~KF[5{yqAh6pW^N>Ms bi8uGSq cG`WoMsEL6|^'~ b a  _ f%}[s{||||||||||||||}_=7A(}||||||||||||||wg;k a# c7 i@ix{||||{|{{|{{||^K?A;uK9~||{||{||{||{{zpUtcd b c!zTqy||||{||{||{|YI>?<?Az||{||{||{||{ub5 h b c! j5fv{|||{|{{|{}X>>=>>>@~`B||{||{||{||ynKr c_i copQoz|||{|{{|{iVH%= @B?LOvH'|{||{||{||{u`* df a e0_t{||{||{||G%><D>y+L,u>&v4||{||{||{{wiEn aCba aOoGky{|{|{{|{A9=CC u)4.)v||{||{||{zrY"{ e a Zb$|Xtz|{|{{|jr>6 CCDER?"~||{||{||{{wf9 g `1 a1k:hw{{|||~ID!9D#E"D!FEMQ=t{||{||{|{zpPt dqcectVqz{|{|H.N"D ;G$G#E"D!AY3p{||{||{|{vc2 e e ` h3bu{|{[RH#M'ACI$H%G$F#E!Au||{||{|{xkHpaGg[ dYqMny{|H'N(O*;F"J%I%H$F#I"Wv{||{||{zs^&~ g `  b e/_u{|uL*T+O*6L&M&L&I%I$H#Lz{||{||{xjDl bGa9nBjxs[\2R)8K$O(L'K'K&I$<~||{||{zqU z d_ a e!zXr{F(P&?Q)Q+F&N.e6P*<{|||{|{we7 h c) c7 j:gwz}G%R*ER+S,=#[MEcY[H)4|{||{|yoOs du b a dssQpTBR,U*IU*U-K*wKKde||||{ua-f c ` e2h}\4Y,U*PT)V,T,O2xe{}|||{ykGn`Q ` bQrl_Wk5a.[*SV*W-W-X,cA|{||{sZ%} e d _ h_YBĀ8o2g-ZZ)V,V,S-\+T=~||{xi? j c3^eAQy]Iĉ<ͅ8x3]Z)W,W,X-W,Q&xNSz||ypUw b a >mYkcQċC̍<ͅ9`$c+_/Z-X-W,S+J2v{{ve5 j `bjlaaowaNƌFˑĚ>i*`(k1`.X,X,T*H't{znPq ck!pg^g=^TKːH̒Dz4f&|5o2c/X-V,D(kvzt_/ f bhu_``ϴPɓN˓Iσ?o%Έ9̓7u3c/Z-A$ijwkEn bEg{|m}wRɑSɒȎGo"ω<̐=̈́7v4f0O%g`zqZ#{ e c[jXǏWȑTɐQv ҈;̑Cŋ>~>ʃDV*xk< i a--jjYɐYɑTׇ<}4͓HEWN{_\vUvb`pxatPʐ\ɒX΄Mp.ʏLϓJcya3 g`p~fOɊXʑ^ΊQ1̑LʑNPiaqLpd_o`uJʑ_ʒ_ڇ<ӋCMo\_, f d-fEnDʅYԎK։<ȌSqVCm b;v5wrrS͔\׋>̓UuFhLkxk` pX fCĄZ։EяMʏ\wA\`uDžnjNjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjǍɏ߁_jR=A$G?b]zsӌnjnjnjnjnjnjnjnjnjnjnjnjnjnjnjNjNj~kNl:lUd<\6|V#y bctEsr:_Z^- i b drKuY(F,c. h b1 b1b%|XubU=bbh@jb^ ^ `[l5\q}j8+ yhJy d ^ X etFftz||||||||||||||||||||G;5E8t~||||||||||||||||||{xnZ- jaM Y cUf,[ox{||||||||||||||||||I=EA3jZS||||||||||||||||||ztfGpcd baoDdsz{||||||||||||||||C&@?;6C?|~||||||||||||||||{wnV+ d bSb c- i'~Qjv{|||||||||||||||G+< ?><A>DnV7||||||||||||||||xqa<pew b f bn9ary||||||||||||||A>= =?>><AoK|||||||||||||||{vkQ z f a1f%cwPjv{||||||||||||Q6H"> =BA<DP!O]A||||||||||||||{yq`9 h c{ib au i7\px{|||||||||||vXFC&; C?A6xDAI4~\]|||||||||||||zuhLx cb- _buFfsz|||||||||||bW7<9BF=z*# D5!g=?`8m~||||||||||||{wnY/ h `Ma cS j*Wmw{||||||||||cK88 =CE C 2% ahm||||||||||||zsdEqe cZ an>ctz|||||||||?"<5 CBEDGN( ^c[|||||||||||||{xmS(c `KT a9 f"{Pkv{||||||||?.A@6E"D"D DG \PAp{|||||||||||||yqa9oacd eu i8`qy{|||||v^WZI&=:D#G$D"D"C<921k||||||||||||{vjOw f e% e'avNiv{|||||pg<M M(:=G$G$G#F#E"E"=R3m||||||||||||yq]7 g byh_I j0Ymw{|||G+H#N&M'6F#H$J%G$G$F#D"E {>r|||||||||||zseFvc `Z drDftz|||~VEBP(M(I'3K(J&I&H$G$F#H"O#Cv||||||||||{xnY* j_MdCe)Xmw{||P1M(O)R,F$5L*K%J%J&H%G$A![%gr||||||||||ysdDode c boBbrz|}B-W-U,P*=8R+N'M&L&I&K%F#J$<}|||||||||{wmS) e cM` e#|Pjv{hRjDZ.T,>9O)O)N(K'J&I%H$I$8|||||||||yq`:nao`U cs m7]py~ukM(T(BAP)P)M)I'Q,Z-N)J&:|||||||||{uiNwh `' a%awHhv{hi? P(CGU-T-G'9"O6h?\4P'6{|||||||{ypZ2 h`{ dd cY i,Ynw}G2K%U-ELT.U-G(j:"UWYilzF2&H%-}|||||||ztfDs ed a enBdtopG*S,W,JMW-V-P,B)jR\|YYRK||||||{wnW( g cC aCd'TqWHT-Y,U,ONV-V-S,R+G>wk||||||zscAma a _ aqm;mqT8k2Y,Y-RTS,V-W-S-V.NJ|||||||{viP$}d `+ \ a# f${b\`8n2b/].SVV-V-X-W-Y,b.~||||||yp_6m bu \dgpyOCv8́6g0c._WZ,V,W,T-S-^,Q'ko||||{uiMue _ a'haZN}:͌;y5w3c(Y[-W,W-W-W.U,Y*G,~p~|||{xp[4 f ao_)m?YuTO~>̐>͈9̀6h-XW.W,Y,Z,X-X-X)E n@Fv|||zsdDs`aMn}\h}]WFˎB̎=̈:q3Yn2d0].Y,W-W-T,S+{L4t||{wmV%} k `=ain bapYRD̐F̒F̍>u4[ b+l1a/[,W,X-X+P&I*s||zscBmc!p bjbc\km|UUJʎG̎F̓FΌ>a$g*u3k1a.Y-W,Z-P)A'ksz{vkQ&~ d d9\gSlh]7|XXӨvOǎL˒K̒B̍Bf*k&Ά76r3k2\.W,R+@'f\nxxp^6l_c ^gxc!yaijRPʔM̔JʒLw2r%φ9͌:~5u3g0a/T+<"eVhvugKtf _g{{ ykeWRʑRʑNʓLь8h Ї;̐>͏;~6v4n2_.F"cO`ppY/ h ds _?b[纅SʓUȑSȑUΎCg҄;̐@̐@ˌ;ρ7{9n2R%meveAp c a3aqsTȐXȑTȐT͏J|ׅ6̓E̒EAj>[CJ)|tV%}d b5j~[vdōYʑ[ɐWɒTׁ9r,͒GΖI}DQC{q|blyb?l ab z!oi˼~Qʑ]ʒWǒ\πJh'ˏLˎIЕJYuhN!zc`bjofEʍ[ʐ]ʓ[Ӏ?f!ΑJɏOЕLЛZl]x]3 kc_9dGP˓aʐ_ː^׎;ԋ=ɑRčOJkPniqcKsd` qdkBȌ\ˑ_ʓ_ٌA|3͔P{HdPuZ1 e dWf{GdDoEtI͐bҔPz0ϘMƇPlMfArbc  wW?r\߹fI|Vϗbً;ҌEʎXl?^:{;kd/5qkclJƐ`ՎH׏=̓YɊXi;a=lu8nYqY-eB{T͏^܃5ϑSˑ_ȇQn9X5hqͩM‚pqeAϖeۄ?֎B˔e˓YɊFf5|I> %iNsRؓ[}5͕_˔e˓[tA{?)yZ4_9vVx;ҌK̒f͑fQy>!pqd5Y9n=ڍ>̌\̐gƍbM<\jͯ!9b@k>kC~TÍbeT{LXfCU+_5pTuXxPuWzGOtOpM ;pasd@qSLO|\{A~upf`Z( {#Vo-Nk/QN@7^DEoH U~Y ae mg {mK}\QxC[{ϝVoNkTNKa5u% . 2 1t' zDCni%V9\;m?k?j?s?u?u?s?s?q?n?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?tCYmabm_kxJ99,1.&s! D?ny㰡Wl}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?l}?n?q?s?s?u?u?s?j?k?m?\;FLbĕh̕nΕx˕}˕ҕەÕ͔塀iv}U[QAA(<@&G)G,F1K:ji휠Õەҕ}˕x˕nΕh̕bĕL5}=Ver}xn^GTu92BI C2y=?czt}reV=n t8SjyywJXw3"AC ]'ɧĬyjS8 t dj!|?\q[my7,y.Q-W6=8pGCr]C)u g dA b bi ir)HauxiH9 I8quaH)r i bi bb c9a eq4PgvwvP'U5abvgP4q eac9b  Nzb bwcey;Wiwub>K<|1}wiW;yec bwb Nz bAa`m(GYhu~ZOJ<4 KD~uhYG(m`a bA ^ ^O _ ft4I[iq{z^F6 -0 fc{qi[I4t f _ ^O ^ ^cdIio y8N`iqwz|}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}yM&;,|$ + me}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}|zwqi`N8 yoidIc ^ ^ ^d iq)AXdmswz||||||||||||||||||||||||||||||||||||||||||_<@8 60.K=;7j/%PAH||||||||||||||||||||||||||||||||||||||{yvqi_O3v ke`oH HdC de k$}CYfntx{|||||||||||||||||||||||||||||||||||||||PBI< @XBE W+=Q "$||||||||||||||||||||||||||||||||||||||{xtnfYC$} ke ddCd ccces3O^iqvy{|||||||||||||||||||||||||||||||||||||`WH%F ?;=?91<9y;!pcTv|||||||||||||||||||||||||||||||||||||{yvqi^O3sec ccd b9 bak$|BTbmswz{|||||||||||||||||||||||||||||||||||UOF'DA@<6=7+ >FGj=#ts|||||||||||||||||||||||||||||||||||{zwsmbTB$|ka b b9bbW ` fq4IZipuyz{|||||||||||||||||||||||||||||||||}QK9; A =@@=<<=BGF3V]~||||||||||||||||||||||||||||||||{zyupiZI4q f `bWbb bce h m#|9N`ipvxz|||||||||||||||||||||||||||||||}}~ia3< < =D@=;=AD>BGAvJ*jnc||||||||||||||||||||||||||||||||zxvpi`N9#| m hce bb f f/e hr*AXdlswz|||||||||||||||||||||||||||||||xi]L04== <B?==>@B=>BGuCd]?||||||||||||||||||||||||||||||||zwsldXA*r he f/ fff`kb kx3O_ipvy{||||||||||||||||||||||||||||~{uE;:?>===>>@?>=<;=Gy@ iT/|||||||||||||||||||||||||||||||{yvpi_O3x kb`kfff bA dho#{BWfntxz||||||||||||||||||||||||||||XH=H D;<=><?A@<=B><=DvD eW)|||||||||||||||||||||||||||||||zxtnfWB#{oh d bAff eUd gq4M_ipvy{||||||||||||||||||||||||||~e]K.HE!A=; >BBB@=<>CL!LIL lALJ#z||||||||||||||||||||||||||||||{yvpi_M4q gd eUfff! ab i$}AVclsxz{|||||||||||||||||||||||||eTL,I#U2>:@=@CCDA:@EJT(TQV"s@L<a`~||||||||||||||||||||||||||||{zxslcVA$} ib af!fcbq b fq2K[hpvy{|||||||||||||||||||||||||XIL(ZG74A CC @8EG5 tGvW`*K,GM \"D2=.||||||||||||||||||||||||||||{yvph[K2q f bbqcbb' au d k$};O_jpuy{||||||||||||||||||||||||BAE$F/67 ACEE@@;-q/T.Q,c6j=t@>1}* t3+|||||||||||||||||||||||||||{yupj_O;$} k d aub'b _7 bfs,BVdlrwz||||||||||||||||||||||||1 7>?!6 8 ?BEGE?7,p" @ :,O:"\;-r3/o.k/s;A|||||||||||||||||||||||||||zwrldVB,sf b _7a `]_jw3N_jquy{|||||||||||||||||||||||~' - :G"5 4 <@BDH$D!=5n% <50S?4dAKjFXTA,RC$zTn||||||||||||||||||||||||||{yuqj_N3wj_ `]aa c3 c ip"|AVclswz{||||||||||||||||||||||96:>47 AD!DDF#E"@6r(= MI@kwx|||||||||||||||||||||||||{zwslcVA"|p i c c3a e e]e ip3JZgouy{||||||||||||||||||||||}|; 9:9 5:DCCDF!E!B?-G WSOv|||||||||||||||||||||||||{yuogZJ3p ie e] e[\_bf$}D"F$E$D"D!D#E"E DE Wlc= B:KUAfu|||||||||||||||||||||||||||zwrmeU@$}p h a _1d eQ f ip2K_ipvy{|||||||||||||~tpXEnVD"M*B94@C#C#H&G$E#B"D#E!DB=7;a6-1 .6Z||||||||||||||||||||||||||{yvpi_K2p i f eQdf f ee i$|?Vclswz{|||||||||||}zZW}B"WO H$L)A84 @D#F$H%H$F#D#E#E"E D @<?r77;E"H%H$G$G$G$H$G#F#F#E"E"E#C 7t.C8 _|||||||||||||||||||||||||zwtmaQ?"{ h_ ah3h `C`fs,DWemswz|||||||||}UHDBH&P"P'N*M&96CG#H$H$J%I%G$G$G$G$G$F#D#B"C C@U8f||||||||||||||||||||||||zwsmeWD,sf` `Ch ^ `Cdlx5K]houx{|||||||adD'B I#O)N(M(M(M'64H%I%H$H$M'J&G$G$G$G$G$F#E#E"D!L"Ne2mz|||||||||||||||||||||||{xuoh]K5xld `C ^NuZ!` fo%~@Vemswz{||||||tjps@/>C N&V*L'K'L(L(33L)K'I%I%M)K'G$G$G$G$G$F#H#K#G"R$U r( qt||||||||||||||||||||||{zwsmeV@%~o f`Z!Nu^ b] h lr0K_hpvy{||||||lUC = L%P(O)Q*N*I(D$3 6L)L(L'L'F$G%I%K%I%G$G$G$G#G"G#\&f!q)pt||||||||||||||||||||||{yvph_K0r l h b]^ee'fg i"|>Wclswy{|||||dHED$P)P*M)P+T-O*= 2 8L*L)L'L&G$H%K&K&I%H%G$G$D#A!J$i&{!gBj|||||||||||||||||||||{ywslcW>"| igfe'ebYbds0M\gpuxz|||||T@E N'R,R+O)L*X/V,61 :N,M)K&J$L'M'L&I&I&I&H%G$C"=M%o&υ _[ f|||||||||||||||||||||zxupg\M0sdbbYc= cbj!zARamswz|||||hm<18O*U-W-T+M(Q-K'1 2 >S-S+P(L&M&M&M&J&I&J&N'I%F#D"I$O$N 6z}|||||||||||||||||||||zwsmaRA!zjb cc=c cM b gq0EWfnsxz|||^_J8M,^1Z-W,T,R*Q,H$1 3?Q*R+Q)N'N'N'N'L&J&J&K%J&H%G#K%G$> 0{||||||||||||||||||||zxsnfWE0q g b cMc b bOdk z6L^houy{||^^aJeAj?d3Z.S-U-S,I#2 4?O(P*P*O(O(N(M(L&K&I&H$J&I&G#M%G$<4}|||||||||||||||||||{yuoh^L6 zkd bO bZZ` en'?Wdmswz||han`m^iYtFg5U+T-V-M%35?O(P*P*O(O(L(J(J&K'L'L&I%H$H$M&D#97|~}||||||||||||||||zwsmdW?'n e`ZZUU `a e lu/M\hpuy{|^ES.T*S)X*Q"4 :DO(P*P*O(P)M)J(K(N*Q+T)P)L(I&L'H&@!5~}|}||||||||||||||||{yuph\M/u l e `aUU b1 fi k y@Rakrwz|½M>@#N(Q&V)O"5>HR*R+Q+P*O+K)H'H(O-X1d3`2X.M)K'J'E$.zy||||||||||||||||||zwrkaR@ y ki f b1 faM_cq0EXgouy{|}I47A$Q#O*F%9BM$X-U.T.S.M,F'@$>&K/a:Fz?l6W-K%J%E#y#ws|||||||||||||||||{yuogXE0qc_aM f ` b3 bc kz7L_lswz{~xJ2@F(Q(R,M%A DK#U.T.U.U-L)@"6v2#oB4nP>qV?zS8U6[7]/O#=5~}||||||||||||||||{zwsl_L7z kc b b3 `ddWc hp(?Vfotxz|}\XD)D"N*T,T-N#A GM#T.T.U.V-M*?"5[6$ND>SXYjqsB?DN5-I*[/F-:|||||||||||||||{zxtofV?(p hcdWdda e hu1J^houx|F)9E!V)Y/U.K!<JS#T.T.U.U-O.B';"NE'HNKks?Eg,40K-5{6 ~|||||||||||||||{xuoh^J1u h eda b) e g j!z=Ucltw~f`E)E+M,U,X-V-P%BJR"X.V-V-W-S.K+B(s;)`IJkh|vtzrROq4&{)H>|||||||||||||||zwtlcU=!z j g e b)_ dS efq-J\hpuv|THE)N.T.X-X-W,R%EIP"Y.W-V-V-R-P+L*A*uD@kVk{}afYZ~}||||||||||||||{yuph\J-qf e dS_  b+ bd kx>SbkuifM:J+T-Y-[,W-W+T$HIO!W-V-V-U-P,S+T+M+B5pFTu^|||||||||||||{zwrkbS>x kd b b+ a `K_ do0FXh~ZQO1\0Y.Y-Y-U,T,S$PORW-V-W-W-U-U-U,S,L1H>aJTpgy|||||||||||||{yuogXF0o d_ `K a \ ` _mb h!z7MawalOBY2q4_/Y,Y,Y-V,S$RSS!S+U-V-W-W-W-U-R-U.Q2|E7qVqt}||||||||||||||{yvph_M7!z hb _m ` \  d dacp(Ca{uBEJ8a5|6`/Y,Z,\.Y-T$P UU%Q+U-V-W-X-W-U-R-Z-Z,N+QV}~~|||||||||||||{zwrkaU@(pca d d d b[ c hu;r@6N7b6t4\.Z-^.Z-Y-V"NUY$V.W.W.W.Y.Y-X-W/X-_,k-P4}t||||||||||||||{yupi]L1u h c b[ d a/ c} in/osI/a:r:{5m2i1i1e0_.X!RUW"V-W,W-V.X-W-W-X-U-X-b,k-mFgqu}||||||||||||zwrlcT>yn i c} a/ \ b= hh&{omV[M-m:~;͂6{5q3h1f/e/`"VVW Y-X,V,U.W-W-V-V,S-T-X,r+a*U;2{|||||||||||{yuoh\I/oh h b= \]ad!x~vyvPUK0o6Ł8Ά7΂7m2X-X+i0n&ZXZ!`-X,V,W-W,W-U-Q.R.S.S.\+Z%N8)]g|||||||||{zwrkdU=y jda]` bYbmKkkJ/r7Ĉ;͍<͆9x5n2t3s3l-\XZ^-Y-W-W,W-W-W-U.W.V.R-X,Z+W(F$KB~ev|||||||||{yvofZI/n eb bY`]b+ b}k=|loH1r:‰=͑=͌;΃8|65x4l0['Z[]/[.Y-W,W-W-W-Y-Y.W.T,W-Z,Z*N#@)nCF|z}|||||||{{yvqj_O:!ze b a}b+]c-+p{I~mp]eH6p<>̑=͒>͌;̈́75z4n0Z$[\\0[/Y-X,X,X,X,\,Y-W.W-Y.Y,W'P%:o-#bSxp|||||||{yvrkcUA*o_ ayb-\ 9sIDzhm^hO;w@A͐?̐?͋;Ά7·8΂7w3d-XST.T-V,X,[-Y-X-\-Y.W-W,Y-Y+W&P)<|2kPbr{||||||{yupi\J2vi a aE^ Hq/Isgg^jZB|DȄD̏>͎<͋;͆8͉;̀9b-XW_0m3f1X-].[-X-[-Y.W.W,X.W,T*S.L$F"lLLqz|||||{zwrlcS=yo h a `#Vjx#Vjxg`z{^jaG~GŒHˍH̐?̒?̐@ͅ8̎>̆=]*Y]!h0ф7w5[/_/].Y,Y-X-W.W-W.U.S.V0Z+Y)lH̃<\+Z Z[(k0n2h0_/].]-Y,W,W-W.W.W,V)R,T#UnG;p~x||||{yvrkcU< zfccnndlkdlkg_\pnXbXA}DǏF̑G̒F̑F̏E͎@̏?͇;p1a"Z\(h/m2m2g0c/_.X,X-Y-Z-Y,Z-[-P,J GpD7oyw||||{yuofZJ-pdc c]-x-xeneeneM^ZnkUbVD|HŏI˒H̐E̎E̍ȆE͑B΍>σ8g&[ ^(l0r3r3m2i0c/Z-Y.Z-Z,Y,[-]/R-G!?uA2nlq{||{zwrk_O<x ic de3Y[YY[YjWotVdTLvLKɉHˎG̏G̐G̕H̖I͔EΏ=j*Y!^#u/|4w5m2k1i0`/\.X.S-W-Y,X,Y/O)C$B.jU_dwx{{zwrldUB,oc cc1e]eU]eUocckx\]SRqPMNjKʏKˑKˑI̔Ȇ@͏?͍Bn/]#^!y/υ6͇8~6w4q3n2j2e0^.X-V,Y+Y.M)A$C,jOUcnwzzyuog\I3via ^7 ^[iR[iRqrZOxdZ~UYjR}NčNɓO˔N˓K̔ȆA̍ǍFo3`$ct-Ђ5͌9Ί8΀6v4u4s4m2a/Z.X-X,W-L*@&?'jJNbjwzywrkbS<#|n f`3zE\EE\E k{aCtiazX`bTwPQȖQʗO˗L̖I˔LˑMˎJn7c$ki(u2Έ8͎:΅8z5v4u4n2\._/].X-V-K->*7!iEK`hvyxune[H,p k f _ELYLl~o1wms}`taYqOQƏOʑOˑM͒H̔L˖OʔLЍ>ـ/p!؇5ю=͍=͑=͎;͈8΂6|5w4r3p3l2e0].R'E 6jDIbgtwvsj_P:y hcb} _'DDDk{vnm{f`]mPQƎQʐQʑPːM˔M˖MʔMϖAև0j{0҈;͑?͑?͑=͏;΋9΀6y5x5v4q3k1a/Z*O#6hBE`apuupeVC+qdb bW _e| xqU{n_ajPRǐU˓UʒSȐSʓN˔KʑNΓBԂ-a]"t3Β@̐?̑?͒>͐;̈́8{5w4v4r3j1b/a0[-~9f?C^[zlrrl^K5v jd hi1e|%mbbӝeQPȒW͕VʒSȐSɒSɓTȏT˖MӇ5fd w3ΐC̏@̑@̒@̏>͍;Έ8Ѐ6{5r3g1`/h.j*~@ jDOf`srmfS=%}l e b c1 e Oej˕`VuPōW˓WɒUȒTȒTȒUǑWɔSӇ8l hy1ΑȆȂB̑C͑@ʑ>Ɍ;́6Љ=Ӌ@ֈA:r1`)@#sdrttg]G-p h d `Q]UUOiwˉ[_fQWɑYɒXȒUȑTȑTǒWȑTӉ͕F̕H̕H̒FFkAT9YEbYplXn7PG8}yrh[J*pd caIK&~ob b{c'vGfKeFgCk@f̍iқhזS4ۈ5ՑG̖g̖f˔b˒[˔OɊEx<_2D,pDCyݥSctbcBvU͉e֕eݑC3ۂ;͗a̖e̕e˔b˕YˑQɃGa4@$o@7x|S'xbaC^;rVӊlܝZ}6u1ϖX͔a̔f̖g˕d͓^͈Rd9@m>.x|W]7uX1Z0^5mIѕ|}Gw.ѓK͓]̓g˓iːfϔeЍ[`5=h=&vzY[65]8{iJcA;d@tTvCx6}4ҎR͔c̑h̏gϓiѓe}OI%l6&hwl}[ +lV^?׹Z3l>x=x+֎Jϓ]ˌd̎fΓjϖkʏaV8u7.Yfgwu68>qwmK>!P;gX<`=t<ܘ:֖IЎTɅ\ˍdΓh˒fY^HIEwMYoeÿ+S`G[`Ah@u;yIuKpG}Sˋ`ʔg_lUSMuDJ^sוq#3aCi`>ż]7c@d@d;rHȁVȌ`bz\^Rv@B~Ri^W,OZ.[/^4e=pGuK{PÍb^lRzACxKbyRvW,Z.G{Zspy~wqXf{O^vUsaBqcBhCvQpSG@WhɅeup;tle[UPigs7-amy`^[Wtg[}%tkrev_9.6.1/INSTALL0000664000175000017500000000353515034253755014324 0ustar dorothyrdorothyrTkRev requires Tcl/Tk 8.5. Tkrev and tkdiff expect to find a program called "wish" in the path. This can be a symbolic link to wish8.x or whatever is appropriate. You also need a unix-like diff program, and whatever revision control systems you want to use. TkRev supports CVS, RCS, Subversion, and Git. To install TkRev, run "wish doinstall.tcl". The installer provides an entry containing the default path for installation, and it shows where it will put the various files, On Unix/Linux, the default location is /usr/local, and on Windows it's C:. If you want to put TkRev somewhere else, type a new directory in the entry and hit return. On MacOS, /opt/local may be a good choice. doinstall.tcl can be run without the gui, with an optional argument specifying the destination. Usage: [sudo] wish doinstall.tcl or: [sudo] tcl doinstall.tcl [-nox] [destination] --- IMPORTANT: Configuration Files --- Look at /lib/tkrev/tkrev_def.tcl and see if there's anything you want to change. You may need to change the variables which specify how to invoke various programs and the location of the the temporary directory. You can also choose a default editor, specify colors for important tags, and set many other preferences. tkrev_def.tcl will look for a file called site_def in the same directory it is in. That's a good place to put site-specific preferences such as tag colours, without having them overwritten the next time you update tkrev. Also, you can put personal preferences in the .tkrev file in your home directory. User interface preferences should usually go there. This is the order of precedence: ~/.tkrev /lib/tkrev/site_def /lib/tkrev/tkrev_def.tcl Some important preferences: cvscfg(editor) - Set this to your preferred text editor cvscfg(shell) - What terminal do you want when you ask for a shell? tkrev_9.6.1/teststuff/0000775000175000017500000000000015034253754015313 5ustar dorothyrdorothyrtkrev_9.6.1/teststuff/mktest-clean0000775000175000017500000000261114226152260017620 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} set WD [pwd] set CvsRoot [file join $WD "CVS_REPOSITORY"] if {[ file isdirectory $CvsRoot ]} { file delete -force $CvsRoot } if {[ file isdirectory CVSROOT ]} { file delete -force CVSROOT } set oldirs [glob -nocomplain -- cvs_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } set SvnRoot [file join $WD "SVN_REPOSITORY"] if {[ file isdirectory $SvnRoot ]} { file delete -force $SvnRoot } set oldirs [glob -nocomplain -- svn_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } set SvnRoot [file join $WD "SVN_NONCONFORM"] if {[ file isdirectory $SvnRoot ]} { file delete -force $SvnRoot } set oldirs [glob -nocomplain -- svnnc_*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } set RcsRoot [file join $WD "RCS_REPOSITORY"] if {[ file isdirectory $RcsRoot ]} { file delete -force $RcsRoot } set oldirs [glob -nocomplain -- rcs_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } set GitRoot [file join $WD "GIT_REPOSITORY.git"] if {[ file isdirectory $GitRoot ]} { file delete -force $GitRoot } set oldirs [glob -nocomplain -- git_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } set oldirs [glob -nocomplain -- git_rcs_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } tkrev_9.6.1/teststuff/compare_sortit0000775000175000017500000000036113772424677020306 0ustar dorothyrdorothyr#!/bin/csh # This is for comparing the "sort_it_all_out" lines in two debug # trace logs. echo "comparing tkrev trace log files $1 and $2" awk -F':' '/sort_it/ {print $7}' $1 > T1 awk -F':' '/sort_it/ {print $7}' $2 > T2 tkdiff T1 T2 & tkrev_9.6.1/teststuff/mktest-svnnc.tcl0000775000175000017500000002443014226152260020451 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc cleanup_old {root} { if {[ file isdirectory $root ]} { puts "Deleting $root" file delete -force $root } set oldirs [glob -nocomplain -- svnnc*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } puts "===============================" } proc repository {Root topdir} { global taghead puts "===============================" puts "MAKING REPOSITORY $Root" # Create the repository file mkdir $Root set exec_cmd "svnadmin create $Root" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out puts "COULD NOT CREATE REPOSITORY $Root" exit 1 } puts "CREATED $Root" file mkdir [file join $topdir $taghead(trunk)] file mkdir [file join $topdir $taghead(branch)] file mkdir [file join $topdir $taghead(tag)] puts "===============================" puts "IMPORTING FILETREE" set exec_cmd "svn import $topdir file:///$Root -m \"Imported\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "IMPORT FINISHED" } proc checkout_branch {Root tag} { global taghead puts "===============================" puts "CHECKING OUT $tag" # Check out if {$tag eq $taghead(trunk)} { set exec_cmd "svn co file:///$Root/$taghead(trunk) svnnc_$tag" } else { set exec_cmd "svn co file:///$Root/$taghead(branch)/$tag svnnc_$tag" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKOUT FINISHED" } proc newbranch {Root oldtag newtag} { global taghead if {$oldtag eq $taghead(trunk)} { set exec_cmd "svn copy file:///$Root/$oldtag file:///$Root/$taghead(branch)/$newtag -m \"Dogs $newtag\"" } else { set exec_cmd "svn copy file:///$Root/$taghead(branch)/$oldtag file:///$Root/$taghead(branch)/$newtag -m \"Dogs $newtag\"" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKING OUT BRANCH" set exec_cmd "svn co file:///$Root/$taghead(branch)/$newtag svnnc_$newtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] } proc tag {Root tag} { global taghead # Need to update . or the tag may be in the wrong place set exec_cmd "svn update \".\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "Tag: $tag" set exec_cmd "svn copy \".\" file:///$Root/$taghead(tag)/$tag -m \"Tag $tag\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc merge {fromtag totag} { global taghead global WD cd svnnc_$totag set exec_cmd "svn update" set ret [catch {eval "exec $exec_cmd"} out] puts $out # This puts mergeinfo only into . # --- Recording mergeinfo for merge between repository URLs into '.' set exec_cmd "svn merge --reintegrate ^/$taghead(branch)/$fromtag" set ret [catch {eval "exec $exec_cmd"} out] puts $out commit "Merge branch A to trunk" cd $WD } proc writefile {filename string} { puts " append \"$string\" to $filename" set fp [open "$filename" a] puts $fp $string close $fp } proc addfile {filename branch} { puts "Add $filename on $branch" set exec_cmd "svn add $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename branch} { puts "Delete $filename on $branch" file delete $filename set exec_cmd "svn delete $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc commit {comment} { set exec_cmd "svn commit -m \"$comment\"" # This is so the timestamp is different from the last commit after 1000 puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc mkfiles {topdir} { global WD global taghead puts "MAKING FILETREE" # Make some files to put in the repository set trunkhead [file join $topdir $taghead(trunk)] file mkdir $trunkhead cd $trunkhead # Make some text files foreach n {1 2 3} { writefile "File$n.txt" "Initial" } writefile "FTags.txt" "Initial" foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D foreach n {1 2 " 3"} { set subf [file join $D "F$n.txt"] writefile $subf "Initial" } } cd $WD } proc modfiles {string} { global tcl_platform set tmpfile "list.tmp" file delete -force $tmpfile if {$tcl_platform(platform) eq "windows"} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -o -name .svn -prune -a -type f > $tmpfile"} out] } if {$ret} { puts "Find failed" puts $out exit 1 } set fl [open $tmpfile r] while { [gets $fl item] >= 0} { writefile $item "$string" } close $fl file delete -force $tmpfile } proc getrev {filename} { # Find out current revision set exec_cmd "svn log -q $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out foreach logline [split $out "\n"] { if {[string match "r*" $logline]} { set latest [lindex $logline 0] break } } return $latest } proc conflict {filename} { # Create a conflict set latest [getrev $filename] # Save a copy file copy $filename Ftmp.txt # Make a change writefile $filename "Conflict A" set exec_cmd "svn commit -m \"change1\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out latest revision set exec_cmd "svn update -r $latest $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Make a different change (we hope) file delete -force -- $filename file rename Ftmp.txt $filename writefile $filename "Conflict B" # Check out head, which now conflicts with our change set exec_cmd "svn update --non-interactive -r HEAD $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } ############################################## set branching_desired 1 set leave_a_mess 1 for {set i 1} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] switch -regexp $arg { {^--*nobranch} { set branching_desired 0 } {^--*nomess} { set leave_a_mess 0 } } } if [file isdirectory .svn] { puts "Please don't do that here. There's already a .svn directory." exit 1 } set WD [pwd] set SVNROOT [file join $WD "SVN_NONCONFORM"] set taghead(trunk) "elephants" set taghead(branch) "dogs" set taghead(tag) "ducklings" cleanup_old $SVNROOT mkfiles "svnnc" repository $SVNROOT "svnnc" checkout_branch "$SVNROOT" "$taghead(trunk)" puts "===============================" puts "First revision on $taghead(trunk)" cd svnnc_$taghead(trunk) set exec_cmd "svn propset -R svn:ignore .DS_Store ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } modfiles "Main 1" writefile Ftrunk.txt "Main 1" addfile Ftrunk.txt $taghead(trunk) commit "First revision on $taghead(trunk)" tag $SVNROOT "ducklingA" tag $SVNROOT "ducklingC" cd $WD if {$branching_desired} { puts "===============================" puts "MAKING BRANCH A" newbranch $SVNROOT $taghead(trunk) dogsA cd $WD/svnnc_dogsA writefile FdogsA.txt "DogsA 1" addfile FdogsA.txt dogsA commit "Add file FdogsA.txt on branch A" cd $WD puts "===============================" puts "First revision on Branch A" cd $WD/svnnc_dogsA modfiles "DogsA 1" commit "First revision on branch A" cd $WD puts "===============================" puts "Second revision on Branch A" cd $WD/svnnc_dogsA modfiles "DogsA 2" commit "Second revision on branch A" tag $SVNROOT "ducklingAA" cd $WD # Branch C puts "===============================" puts "MAKING BRANCH C FROM SAME ROOT" newbranch $SVNROOT $taghead(trunk) dogsC cd $WD/svnnc_dogsC modfiles "DogsC 1" writefile FdogsC.txt "DogsC 1" addfile FdogsC.txt dogsC commit "Add file FC on Branch C" cd $WD puts "===============================" puts "Merging Branch A to trunk" merge dogsA $taghead(trunk) cd $WD } # Make more modifications on trunk puts "===============================" puts "Second revision on $taghead(trunk)" cd $WD/svnnc_$taghead(trunk) modfiles "Main 2" commit "Second revision on $taghead(trunk)" foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} { set exec_cmd "svn copy --parents -m\"multitags\" FTags.txt file://$SVNROOT/$taghead(tag)/$t/FTags.txt" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { exit 1 } } cd $WD puts "===============================" puts "Third revision on $taghead(trunk)" cd $WD/svnnc_$taghead(trunk) modfiles "Main 3" commit "Third revision on $taghead(trunk)" tag $SVNROOT "ducklingB" cd $WD if {$branching_desired} { # Branch off of the branch puts "===============================" puts "MAKING BRANCH AA" newbranch $SVNROOT dogsA dogsAA cd $WD/svnnc_dogsAA modfiles "DogsAA 1" writefile FdogsAA.txt "DogsAA 1" addfile FdogsAA.txt dogsAA delfile Ftrunk.txt dogsAA commit "Changes on Dogs AA" cd $WD # Make another revision on branchA after # branchAA has branched off puts "===============================" puts "Third revision on Branch A" cd $WD/svnnc_dogsA modfiles "DogsA 3" commit "Third revision on Dogs A" cd $WD # Branch B puts "===============================" puts "MAKING BRANCH B" newbranch $SVNROOT $taghead(trunk) dogsB cd $WD/svnnc_dogsB # Empty branch. Don't check out or update. set exec_cmd "svn mkdir -m\"empty_branch\" file://$SVNROOT/$taghead(branch)/branchD" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { exit 1 } modfiles "DogsB 1" writefile FdogsB.txt "DogsB 1" addfile FdogsB.txt dogsB commit "Add file FB on Dogs B" cd $WD } if {$leave_a_mess} { # Leave the trunk with uncommitted changes puts "===============================" puts "Making Uncommitted changes on trunk" cd $WD/svnnc_$taghead(trunk) # Local only writefile FileLocal.txt "Pending" # Newly added writefile FileAdd.txt "Pending" addfile FileAdd.txt trunk # Missing file delete -- File3.txt trunk # Modify writefile File2.txt "Pending" writefile "Dir1/F 3.txt" "Pending" writefile "Dir1/F2.txt" "Pending" writefile "Dir 2/F1.txt" "Pending" # Conflict conflict Ftrunk.txt cd $WD } # Remove the source file delete -force -- svnnc tkrev_9.6.1/teststuff/modules_file0000664000175000017500000000063213466737214017713 0ustar dorothyrdorothyr#D chocolate Top Chocolate #D chocolate/truffle Cocoa Level 2 #D chocolate/truffle/cocoa3 Cocoa Level 3 #D sniffer Chocolate Sniffer sniffer chocolate/truffle/cocoa3/sniffer #D snuff Chocolate Snuffler snuff chocolate/truffle/cocoa3/snuffler #D biter Chocolate Biter biter chocolate/truffle/cocoa3/biter deep -a chocolate/truffle/cocoa3/sniffer chocolate/truffle/cocoa3/snuffler chocolate/truffle/cocoa3/biter tkrev_9.6.1/teststuff/mktest-git.tcl0000775000175000017500000003244715034044006020110 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc cleanup_old {root} { if {[ file isdirectory $root ]} { puts "Deleting $root" file delete -force $root } set oldirs [glob -nocomplain -- git_test**] foreach od $oldirs { puts "Deleting $od" file delete -force $od } } proc clone {Root Clone} { puts "===============================" puts "CLONING" set exec_cmd "git clone $Root $Clone" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] # For some reason catch returns 1 even though it succeeded puts $out if {! [file exists $Clone/.git] && ! [file exists $Clone/config]} { puts "COULD NOT CLONE REPOSITORY $Root to $Clone" exit 1 } } proc worktree {Root Branch} { puts "===============================" puts "MAKING WORKTREE" cd $Root set exec_cmd "git worktree add --track -b branch$Branch ../git_test_branch$Branch" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out cd .. } proc repository {Root} { puts "===============================" puts "MAKING REPOSITORY $Root" # Create the repository #file mkdir $Root set exec_cmd "git init --bare $Root" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { puts "COULD NOT CREATE REPOSITORY $Root" exit 1 } puts "CREATED $Root" } proc populate {clone} { global WD mkfiles $clone # Git needs to know our email or else it won't commit cd $clone set exec_cmd "whoami" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} myname] if {$ret} { puts $myname } set exec_cmd "hostname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} host] if {$ret} { puts $host } set mymail "$myname@$host" set exec_cmd "git config user.name $myname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } set exec_cmd "git config user.email $mymail" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } puts "===============================" puts "IMPORTING FILETREE" set exec_cmd "git add --verbose ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # See what we did set exec_cmd "git status" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "IMPORT FINISHED" cd $WD } proc newbranch {oldtag newtag} { global WD puts "===============================" puts "Creating new $newtag" puts "In [pwd]" cd git_test_$oldtag puts "In [pwd]" set exec_cmd "git branch --track $newtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out exit } set exec_cmd "git checkout $newtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out cd $WD puts "\nIn [pwd]" puts "Cloning $oldtag to a new directory for $newtag" set exec_cmd "git clone git_test_$oldtag git_test_$newtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "Restoring git_test_$oldtag to $oldtag" cd git_test_$oldtag puts "In [pwd]" set exec_cmd "git checkout $oldtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out cd $WD } proc merge {fromtag totag} { global WD cd git_test_$totag set exec_cmd "git merge --no-ff $fromtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out cd $WD } proc tag {tag msg} { if {$msg eq ""} { set exec_cmd "git tag $tag" } else { set exec_cmd "git tag -a $tag -m \"$msg\"" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out exit 1 } } proc writefile {filename string {encoding {}} } { puts " append \"$string\" to $filename" set fp [open "$filename" a] if {$encoding != ""} { chan configure $fp -encoding $encoding } puts $fp $string chan close $fp } proc addfile {filename branch} { puts "Add $filename on $branch" set exec_cmd "git add --verbose $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc stage {} { puts "Stage [pwd]" set exec_cmd "git add --verbose *" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename branch} { puts "Delete $filename on $branch" file delete $filename set exec_cmd "git rm -r $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc movefile {oldname newname} { # rename a file puts "Rename $oldname to $newname" set exec_cmd "git mv $oldname $newname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc push {origin} { puts "===============================" set exec_cmd "git push $origin" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { if {[string match {fatal*} $out]} { exit 1 } } } proc fetch {{origin {}}} { puts "Fetching from $origin" set exec_cmd "git fetch " if {$origin != ""} { append exec_cmd " $origin" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] } proc commit {comment} { # It seems to need the email all over again in a cloned directory set exec_cmd "whoami" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} myname] if {$ret} { puts $myname } set exec_cmd "hostname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} host] if {$ret} { puts $host } set mymail "$myname@$host" set exec_cmd "git config user.name $myname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } set exec_cmd "git config user.email $mymail" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } # Finally, do it set exec_cmd "git commit -m \"$comment\"" # This is so the timestamp is different from the last commit after 1000 puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc mkfiles {topdir} { global WD puts "MAKING FILETREE" # Make some files to put in the repository file mkdir "$topdir" cd $topdir # Make some files each containing a random word foreach n {1 2 3 4} { writefile "File$n.txt" "Initial" } writefile "File Spc.txt" "Initial" writefile "FTags.txt" "Initial" writefile "F-utf-8.txt" "\u20AC20" "utf-8" writefile "F-iso8859-1.txt" "Copyright \xA9 2025" "iso8859-1" foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D foreach n {1 2 " 3" 4} { set subf [file join $D "F$n.txt"] writefile $subf "Initial" } } cd $WD } proc modfiles {string} { global tcl_platform set tmpfile "list.tmp" file delete -force $tmpfile if {$tcl_platform(platform) eq "windows"} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -a -type f > $tmpfile"} out] } if {$ret} { puts "Find failed" puts $out exit 1 } set fl [open $tmpfile r] while { [gets $fl item] >= 0} { writefile $item $string } close $fl file delete -force $tmpfile } proc conflict {filename} { # Create a conflict. In Git, this is done with a temporary branch. # Check out a new branch set exec_cmd "git checkout -b clash" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out writefile $filename "Conflict A" set exec_cmd "git commit -m \"change on clash\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out head, which now conflicts with our change set exec_cmd "git checkout master" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Make a different change to same line writefile $filename "Conflict B" set exec_cmd "git commit -m \"change on master\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out set exec_cmd "git merge clash" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } ############################################## set branching_desired 1 set leave_a_mess 1 for {set i 1} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] switch -regexp $arg { {^--*nobranch} { set branching_desired 0 } {^--*nomess} { set leave_a_mess 0 } } } if [file exists .git] { puts "Please don't do that here. There's already a .git directory." exit 1 } set WD [pwd] set Root [file join $WD "GIT_REPOSITORY.git"] set Master "git_test_master" cleanup_old $Root # Create the bare "server" repo repository $Root # Clone it to one we can work in clone $Root $Master # Import some files populate $Master cd $Master commit "Commit the imported files" tag "init" "the starting point" push "" cd $WD # Make some changes puts "===============================" puts "First revision on trunk" cd $Master writefile .gitignore ".DS_Store" addfile .gitignnore trunk modfiles "Main 1" writefile Ftrunk.txt "Main 1" addfile Ftrunk.txt master stage commit "First revision on trunk" tag "tagA" "" tag "tagC" "" push "" cd $WD if {$branching_desired} { puts "===============================" puts "MAKING BRANCH A" newbranch master branchA cd $WD/git_test_branchA writefile FbranchA.txt "BranchA 1" addfile FbranchA.txt branchA stage commit "Add file FbranchA.txt on branch A" puts "===============================" puts "First revision on Branch A" modfiles "BranchA 1" stage commit "First revision on branch A" puts "===============================" puts "Second revision on Branch A" modfiles "BranchA 2" stage commit "Second revision on branch A" push "" cd $WD # Branch C puts "===============================" puts "MAKING BRANCH C FROM SAME ROOT" worktree git_test_master C cd $WD/git_test_branchC modfiles "BranchC 1" writefile FbranchC.txt "BranchC 1" addfile FbranchC.txt branchC stage commit "First changes on Branch C" # Make two identical branches (OK in Git) set exec_cmd "git branch -c branchC branchD" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] cd $WD puts "===============================" puts "Merging BranchA to trunk" merge branchA master cd $WD } # Make more modifications on trunk puts "===============================" puts "Second revision on trunk" cd $WD/$Master fetch {--all} modfiles "Main 2" stage commit "Second revision on trunk" foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} { tag "tag_$t" FTags.txt } puts "===============================" puts "Third revision on trunk" modfiles "Main 3" stage commit "Third revision on trunk" tag "tagB" "" tag "one" "Dir1/F1.txt" push ". HEAD" cd $WD if {$branching_desired} { # Branch off of the branch puts "===============================" puts "MAKING BRANCH AA" cd $WD/git_test_branchA tag "tagAA" "" cd $WD worktree git_test_branchA AA cd $WD/git_test_branchAA modfiles "BranchAA 1" writefile FbranchAA.txt "BranchAA 1" addfile FbranchAA.txt branchAA delfile Ftrunk.txt branchAA stage commit "First changes on Branch AA" puts "===============================" puts "Revision on Branch AA" modfiles "BranchAA 2" stage commit "Second changes on Branch AA" cd $WD # Branch Y puts "===============================" puts "MAKING BRANCH Y" worktree git_test_branchAA Y cd $WD/git_test_branchY modfiles "BranchY 1" stage commit "First changes on Branch Y" cd $WD # Make another revision on branchA after # branchAA has branched off puts "===============================" puts "Third revision on Branch A" cd $WD/git_test_branchA modfiles "BranchA 3" stage commit "Third revision on Branch A" cd $WD # Branch B puts "===============================" puts "MAKING BRANCH B" worktree git_test_master B cd $WD/git_test_branchB modfiles "BranchB 1" writefile FbranchB.txt "BranchB 1" addfile FbranchB.txt branchB stage commit "First changes on Branch B" puts "===============================" puts "Revision on Branch B" modfiles "BranchB 2" stage commit "Second changes on Branch B" cd $WD # Update the clones #foreach branch {branchA branchAA branchB branchC master} { #cd $WD/git_test_$branch #push {--all} #fetch {--all} #cd $WD #} } if {$leave_a_mess} { # Leave the trunk with uncommitted changes puts "===============================" puts "Making Uncommitted changes on trunk" cd $WD/$Master # Local only writefile FileLocal.txt "Pending" # Conflict. Have to do this before the add and delete, # or the merge will fail before you get to the conflicted file #conflict Ftrunk.txt # Newly added writefile FileAdd.txt "Pending" addfile FileAdd.txt trunk # Rename a file. git "R " status # git status reports this wrong! as "R Dir1/F4.txt -> FileMoved.txt" #movefile ./File4.txt ./FileMoved.txt # Plain, empty directory file mkdir Dir3 file mkdir "Dir1/New dir" # Missing file delete -- File3.txt trunk # Modify writefile File2.txt "Pending" writefile "F-utf-8.txt" "\xA53378" "utf-8" writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1" writefile "Dir1/F 3.txt" "Pending" delfile "Dir1/F2.txt" trunk writefile "Dir 2/F1.txt" "Pending" movefile "Dir1/F4.txt" "Dir1/FMoved.txt" # Change a file that's been moved. Only git detects this writefile "Dir1/FMoved.txt" "Post-move change" cd $WD } tkrev_9.6.1/teststuff/mktest-all0000775000175000017500000000054515034044006017306 0ustar dorothyrdorothyr#!/bin/tcsh # make tests for all VCSs foreach vcs (rcs cvs svn git) ./mktest-$vcs.tcl #./mktest-$vcs.tcl --nobranch #./mktest-$vcs.tcl --nomess end # make a mixed-up one rm -rf git_rcs_test cp -r git_test_master git_rcs_test cp -r rcs_test/RCS git_rcs_test cp -r rcs_test/Dir1/RCS git_rcs_test/Dir1 cp -r 'rcs_test/Dir 2/RCS' 'git_rcs_test/Dir 2' tkrev_9.6.1/teststuff/mktest-cvs.tcl0000775000175000017500000002661415030665276020135 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc cleanup_old {root} { if {[ file isdirectory $root ]} { puts "Deleting $root" file delete -force $root } set oldirs [glob -nocomplain -- cvs_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } puts "===============================" } proc repository {Root topdir} { global env global WD puts "===============================" puts "MAKING REPOSITORY $env(CVSROOT)" # Create the repository file mkdir $Root set exec_cmd "cvs -d $env(CVSROOT) init" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out puts "COULD NOT CREATE REPOSITORY $env(CVSROOT)" exit 1 } puts "CREATED $env(CVSROOT)" puts "===============================" puts "IMPORTING FILETREE" cd $topdir # Import it set exec_cmd "cvs -d $env(CVSROOT) import -m \"Imported\" $topdir BEGIN baseline-1_1_1" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "IMPORT FINISHED" cd $WD } # Make something that uses the CVSROOT/modules functionality proc module_file {} { global env global WD puts "===============================" puts "EDITING MODULE FILE" set exec_cmd "cvs -d $env(CVSROOT) co CVSROOT/modules" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out puts "COULD NOT CHECK OUT CVSROOT/modules" exit 1 } cd CVSROOT set mf [open "modules" a] puts $mf "" puts $mf "#D\tcvs_test" puts $mf "#M\tcvs_test\tImported" puts $mf "cvs_test\tcvs_test" close $mf set exec_cmd "cvs ci -m\"Add\\\ a\\\ module\\\ and\\\ a\\\ #D\\\ line\" modules" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out puts "COULD NOT CHECK IN CVSROOT/modules" cd $WD exit 1 } cd $WD } proc checkout_branch {proj tag} { global env puts "===============================" puts "CHECKING OUT $tag" # Check out if {$tag eq "trunk"} { set exec_cmd "cvs -d $env(CVSROOT) co -d cvs_test_$tag $proj" } else { set exec_cmd "cvs -d $env(CVSROOT) co -d cvs_test_$tag -r $tag $proj" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKOUT FINISHED" } proc newbranch {proj oldtag newtag} { global env set exec_cmd "cvs -d $env(CVSROOT) rtag -r $oldtag -b $newtag $proj" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKING OUT BRANCH" set exec_cmd "cvs -d $env(CVSROOT) co -r $newtag -d ${proj}_$newtag cvs_test" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] } proc empty_branch {proj oldtag newtag} { global env set exec_cmd "cvs -d $env(CVSROOT) rtag -r $oldtag -b $newtag $proj" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc tag {tag obj} { set exec_cmd "cvs tag -F $tag $obj" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc merge {fromtag totag} { global WD cd cvs_test_$totag # This will fail if there are conflicts set exec_cmd "cvs update -d -j$fromtag ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out commit "Merge $fromtag to $totag" set date [clock format [clock seconds] -format "%H-%M-%S"] # First, the "from" file that's not in this branch (needs -r) set exec_cmd "cvs tag -F -r$fromtag mergeto_${totag}_$date ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Now, the version that's in the current branch set exec_cmd "cvs tag -F mergefrom_${fromtag}_$date ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Clean up the merge files file delete [glob -nocomplain -- .#* */.#*] cd $WD } proc writefile {filename string {encoding {}} } { puts " append \"$string\" to $filename" set fp [open "$filename" a] if {$encoding != ""} { chan configure $fp -encoding $encoding } puts $fp $string chan close $fp } proc addfile {filename branch} { puts "Add $filename on $branch" set exec_cmd "cvs add $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename branch} { puts "Delete $filename on $branch" file delete $filename set exec_cmd "cvs delete $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc movefile {oldname newname} { # remove and add. CVS has no move command file rename $oldname $newname set exec_cmd "cvs delete $oldname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out set exec_cmd "cvs add $newname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc commit {comment} { set exec_cmd "cvs commit -m \"$comment\"" # This is so the timestamp is different from the last commit after 1000 puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc mkfiles {topdir} { global WD puts "MAKING FILETREE" # Make some files to put in the repository file mkdir "$topdir" cd $topdir # Make some text files foreach n {1 2 3 4} { writefile "File$n.txt" "Initial" } writefile "File Spc.txt" "Initial" writefile "FTags.txt" "Initial" writefile "F-utf-8.txt" "\u20AC20" "utf-8" writefile "F-iso8859-1.txt" "Copyright \xA9 2025" "iso8859-1" foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D foreach n {1 2 " 3" 4} { set subf [file join $D "F$n.txt"] writefile $subf "Initial" } } cd $WD } proc modfiles {string} { global tcl_platform set tmpfile "list.tmp" file delete -force $tmpfile if {$tcl_platform(platform) eq "windows"} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -o -name CVS -prune -a -type f > $tmpfile"} out] } if {$ret} { puts "Find failed" puts $out exit 1 } set fl [open $tmpfile r] while { [gets $fl item] >= 0} { writefile $item $string } close $fl file delete -force $tmpfile } proc getrev {filename} { # Find out current revision set exec_cmd "cvs log -b $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out foreach logline [split $out "\n"] { if {[string match "revision *" $logline]} { set latest [lindex $logline 1] break } } return $latest } proc conflict {filename} { # Create a conflict set latest [getrev $filename] # Save a copy file copy $filename Ftmp.txt # Make a change writefile $filename "conflict A" set exec_cmd "cvs commit -m \"change1\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out latest revision set exec_cmd "cvs update -r $latest $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Make a different change (we hope) file delete -force -- $filename file rename Ftmp.txt $filename writefile $filename "conflict B" # Check out head, which now conflicts with our change set exec_cmd "cvs update -r HEAD $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } ############################################## set branching_desired 1 set leave_a_mess 1 for {set i 1} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] switch -regexp $arg { {^--*nobranch} { set branching_desired 0 } {^--*nomess} { set leave_a_mess 0 } } } if [file isdirectory CVS] { puts "Please don't do that here. There's already a CVS directory." exit 1 } set WD [pwd] set Root [file join $WD "CVS_REPOSITORY"] set env(CVSROOT) ":local:$Root" cleanup_old $Root mkfiles "cvs_test" repository $Root "cvs_test" module_file checkout_branch "cvs_test" "trunk" puts "===============================" puts "First revision on trunk" cd cvs_test_trunk writefile .cvsignore ".DS_Store" addfile .cvsignore trunk modfiles "Main 1" writefile Ftrunk.txt "Main 1" addfile Ftrunk.txt trunk commit "First revision on trunk" tag "tagA" "." tag "tagC" "." cd $WD if {$branching_desired} { puts "===============================" puts "MAKING BRANCH A" newbranch cvs_test HEAD branchA cd $WD/cvs_test_branchA writefile FbranchA.txt "BranchA 1" addfile FbranchA.txt branchA commit "Add file FbranchA.txt on branch A" cd $WD puts "===============================" puts "First revision on Branch A" cd $WD/cvs_test_branchA modfiles "BranchA 1" commit "First revision on branch A" cd $WD puts "===============================" puts "Second revision on Branch A" cd $WD/cvs_test_branchA modfiles "BranchA 2" commit "Second revision on branch A" cd $WD # Branch C puts "===============================" puts "MAKING BRANCH C FROM SAME ROOT" newbranch cvs_test HEAD branchC cd $WD/cvs_test_branchC modfiles "BranchC 1" writefile FbranchC.txt "BranchC 1" addfile FbranchC.txt branchC commit "Add file FC on Branch C" cd $WD puts "===============================" puts "Merging BranchA to trunk" merge branchA trunk cd $WD } # Make more modifications on trunk puts "===============================" puts "Second revision on trunk" cd $WD/cvs_test_trunk modfiles "Main 2" writefile "F-utf-8.txt" "\xFEi\u014B" "utf-8" writefile "F-iso8859-1.txt" "caf\u00E9" "iso8859-1" commit "Second revision on trunk" foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} { tag "tag_$t" FTags.txt } cd $WD puts "===============================" puts "Third revision on trunk" cd $WD/cvs_test_trunk modfiles "Main 3" commit "Third revision on trunk" tag "tagB" "." tag "one" "Dir1/F1.txt" cd $WD if {$branching_desired} { # Branch off of the branch puts "===============================" puts "MAKING BRANCH AA" newbranch cvs_test branchA branchAA cd $WD/cvs_test_branchAA modfiles "BranchAA 1" writefile FbranchAA.txt "BranchAA 1" addfile FbranchAA.txt branchAA delfile Ftrunk.txt branchAA commit "Changes on Branch AA" cd $WD # Make another revision on branchA after # branchAA has branched off puts "===============================" puts "Third revision on Branch A" cd $WD/cvs_test_branchA modfiles "BranchA 3" commit "Third revision on Branch A" cd $WD # Branch B puts "===============================" puts "MAKING BRANCH B" newbranch cvs_test HEAD branchB cd $WD/cvs_test_branchB # Empty branch. Don't check out or update empty_branch cvs_test HEAD branchD modfiles "BranchB 1" writefile FbranchB.txt "BranchB 1" addfile FbranchB.txt branchB commit "Add file FB on Branch B" cd $WD } if {$leave_a_mess} { # Leave the trunk with uncommitted changes puts "===============================" puts "Making Uncommitted changes on trunk" cd $WD/cvs_test_trunk # Local only writefile FileLocal.txt "Pending" # Conflict conflict Ftrunk.txt # Newly added writefile FileAdd.txt "Pending" addfile FileAdd.txt trunk movefile File4.txt FileMoved.txt # Plain, empty directory file mkdir Dir3 file mkdir "Dir1/New dir" # Missing file delete -- File3.txt trunk # Modify writefile File2.txt "Pending" writefile "F-utf-8.txt" "\xA53378" "utf-8" writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1" writefile "Dir1/F 3.txt" "Pending" delfile "Dir1/F2.txt" "Pending" writefile "Dir 2/F1.txt" "Pending" movefile "Dir1/F4.txt" "Dir1/FMoved.txt" cd $WD } # Remove the source file delete -force -- cvs_test tkrev_9.6.1/teststuff/mktestdir.tcl0000775000175000017500000000270214722656237020037 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc writefile {filename string} { puts " append \"$string\" to $filename" set fp [open "$filename" a] puts $fp $string close $fp } proc addfile {filename branch} { puts "Add $filename on $branch" set exec_cmd "cvs add $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename branch} { puts "Delete $filename on $branch" file delete $filename set exec_cmd "cvs delete $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc mkfiles {topdir} { global WD puts "MAKING FILETREE" # Make some files to put in the repository file mkdir "$topdir" cd $topdir # Make some text files foreach n {1 2 3} { writefile "File$n.txt" "Initial" } writefile "FTags.txt" "Initial" foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D foreach n {1 2 " 3"} { set subf [file join $D "F$n.txt"] writefile $subf "Initial" } } cd $WD } ############################################## if [file isdirectory CVS] { puts "Please don't do that here. There's already a CVS directory." exit 1 } if [file isdirectory .svn] { puts "Please don't do that here. There's already a .svn directory." exit 1 } if [file isdirectory .git] { puts "Please don't do that here. There's already a .git directory." exit 1 } set WD [pwd] mkfiles "import_test" tkrev_9.6.1/teststuff/mktest-svn.tcl0000775000175000017500000002740315030665276020145 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc cleanup_old {root} { if {[ file isdirectory $root ]} { puts "Deleting $root" file delete -force $root } set oldirs [glob -nocomplain -- svn_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } puts "===============================" } proc repository {Root topdir} { global taghead puts "===============================" puts "MAKING REPOSITORY $Root" # Create the repository file mkdir $Root set exec_cmd "svnadmin create $Root" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out puts "COULD NOT CREATE REPOSITORY $Root" exit 1 } puts "CREATED $Root" file mkdir [file join $topdir $taghead(trunk)] file mkdir [file join $topdir $taghead(branch)] file mkdir [file join $topdir $taghead(tag)] puts "===============================" puts "IMPORTING FILETREE" set exec_cmd "svn import $topdir file:///$Root -m \"Imported\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "IMPORT FINISHED" } proc checkout_branch {Root tag} { global taghead puts "===============================" puts "CHECKING OUT $tag" # Check out if {$tag eq $taghead(trunk)} { set exec_cmd "svn co file:///$Root/$taghead(trunk) svn_test_$tag" } else { set exec_cmd "svn co file:///$Root/$taghead(branch)/$tag svn_test_$tag" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKOUT FINISHED" } proc newbranch {Root oldtag newtag} { global taghead if {$oldtag eq $taghead(trunk)} { set exec_cmd "svn copy file:///$Root/$oldtag file:///$Root/$taghead(branch)/$newtag -m \"Branch $newtag\"" } else { set exec_cmd "svn copy file:///$Root/$taghead(branch)/$oldtag file:///$Root/$taghead(branch)/$newtag -m \"Branch $newtag\"" } puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "CHECKING OUT BRANCH" set exec_cmd "svn co file:///$Root/$taghead(branch)/$newtag svn_test_$newtag" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] } proc tag {Root tag fname {upd {0}} } { global taghead # This tests a peculiarity of SVN, that a tag makes a new revision if {$upd} { set exec_cmd "svn update \"$fname\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } set exec_cmd "svn copy --parents -m\"file_tag\" $fname file://$Root/$taghead(tag)/$tag/$fname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { exit 1 } } proc tagall {Root tag} { global taghead # Need to update . or the tag may be in the wrong place set exec_cmd "svn update \".\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out puts "Tag: $tag" set exec_cmd "svn copy \".\" file:///$Root/$taghead(tag)/$tag -m \"Tag $tag\"" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc merge {fromtag totag} { global WD cd svn_test_$totag set exec_cmd "svn update" set ret [catch {eval "exec $exec_cmd"} out] puts $out # This puts mergeinfo only into . # --- Recording mergeinfo for merge between repository URLs into '.' set exec_cmd "svn merge --reintegrate ^/branches/$fromtag" set ret [catch {eval "exec $exec_cmd"} out] puts $out commit "Merge branch A to trunk" cd $WD } proc writefile {filename string {encoding {}} } { puts " append \"$string\" to $filename" set fp [open "$filename" a] if {$encoding != ""} { chan configure $fp -encoding $encoding } puts $fp $string chan close $fp } proc addfile {filename branch} { puts "Add $filename on $branch" set exec_cmd "svn add $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename branch} { puts "Delete $filename on $branch" file delete $filename set exec_cmd "svn delete $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc movefile {oldname newname} { # move, mv, rename puts "svn mv, move, rename $oldname $newname" set exec_cmd "svn rename $oldname $newname" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc commit {comment} { set exec_cmd "svn commit -m \"$comment\"" # This is so the timestamp is different from the last commit after 1000 puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc mkfiles {topdir} { global WD global taghead puts "MAKING FILETREE" # Make some files to put in the repository set trunkhead [file join $topdir $taghead(trunk)] file mkdir $trunkhead cd $trunkhead # Make some text files foreach n {1 2 3 4} { writefile "File$n.txt" "Initial" } writefile "File Spc.txt" "Initial" writefile "FTags.txt" "Initial" writefile "UpdTags.txt" "Initial" writefile "F-utf-8.txt" "\u20AC20" "utf-8" writefile "F-iso8859-1.txt" "Copyright \xA9 2025" "iso8859-1" foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D foreach n {1 2 " 3" 4} { set subf [file join $D "F$n.txt"] writefile $subf "Initial" } } cd $WD } proc modfiles {string} { global tcl_platform set tmpfile "list.tmp" file delete -force $tmpfile if {$tcl_platform(platform) eq "windows"} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -o -name .svn -prune -a -type f > $tmpfile"} out] } if {$ret} { puts "Find failed" puts $out exit 1 } set fl [open $tmpfile r] while { [gets $fl item] >= 0} { writefile $item "$string" } close $fl file delete -force $tmpfile } proc getrev {filename} { # Find out current revision set exec_cmd "svn log -q $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out foreach logline [split $out "\n"] { if {[string match "r*" $logline]} { set latest [lindex $logline 0] break } } return $latest } proc conflict {filename} { # Create a conflict set latest [getrev $filename] # Save a copy file copy $filename Ftmp.txt # Make a change writefile $filename "Conflict A" set exec_cmd "svn commit -m \"change1\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out latest revision set exec_cmd "svn update -r $latest $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Make a different change (we hope) file delete -force -- $filename file rename Ftmp.txt $filename writefile $filename "Conflict B" # Check out head, which now conflicts with our change set exec_cmd "svn update --non-interactive -r HEAD $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } ############################################## set branching_desired 1 set leave_a_mess 1 for {set i 1} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] switch -regexp $arg { {^--*nobranch} { set branching_desired 0 } {^--*nomess} { set leave_a_mess 0 } } } if [file isdirectory .svn] { puts "Please don't do that here. There's already a .svn directory." exit 1 } set WD [pwd] set SVNROOT [file join $WD "SVN_REPOSITORY"] set taghead(trunk) "trunk" set taghead(branch) "branches" set taghead(tag) "tags" cleanup_old $SVNROOT mkfiles "svn_test" repository $SVNROOT "svn_test" checkout_branch "$SVNROOT" "$taghead(trunk)" puts "===============================" puts "First revision on $taghead(trunk)" cd svn_test_$taghead(trunk) set exec_cmd "svn propset -R svn:ignore .DS_Store ." puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] if {$ret} { puts $out } modfiles "Main 1" writefile Ftrunk.txt "Main 1" addfile Ftrunk.txt $taghead(trunk) commit "First revision on $taghead(trunk)" tagall $SVNROOT "tagA" tagall $SVNROOT "tagC" cd $WD if {$branching_desired} { puts "===============================" puts "MAKING BRANCH A" newbranch $SVNROOT $taghead(trunk) branchA cd $WD/svn_test_branchA writefile FbranchA.txt "BranchA 1" addfile FbranchA.txt branchA commit "Add file FbranchA.txt on branch A" cd $WD puts "===============================" puts "First revision on Branch A" cd $WD/svn_test_branchA modfiles "BranchA 1" commit "First revision on branch A" cd $WD puts "===============================" puts "Second revision on Branch A" cd $WD/svn_test_branchA modfiles "BranchA 2" commit "Second revision on branch A" tagall $SVNROOT "tagAA" cd $WD # Branch C puts "===============================" puts "MAKING BRANCH C FROM SAME ROOT" newbranch $SVNROOT $taghead(trunk) branchC cd $WD/svn_test_branchC modfiles "BranchC 1" writefile FbranchC.txt "BranchC 1" addfile FbranchC.txt branchC commit "Add file FC on Branch C" cd $WD puts "===============================" puts "Merging BranchA to trunk" merge branchA trunk cd $WD } # Make more modifications on trunk puts "===============================" puts "Second revision on $taghead(trunk)" cd $WD/svn_test_trunk modfiles "Main 2" writefile "F-utf-8.txt" "\xFEi\u014B" "utf-8" writefile "F-iso8859-1.txt" "caf\u00E9" "iso8859-1" commit "Second revision on $taghead(trunk)" # series of tags with no update foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} { tag $SVNROOT $t FTags.txt 0 } cd $WD puts "===============================" puts "Third revision on $taghead(trunk)" cd $WD/svn_test_trunk modfiles "Main 3" commit "Third revision on $taghead(trunk)" tagall $SVNROOT "tagB" tag $SVNROOT "one" "Dir1/F1.txt" cd $WD if {$branching_desired} { # Branch off of the branch puts "===============================" puts "MAKING BRANCH AA" newbranch $SVNROOT branchA branchAA cd $WD/svn_test_branchAA modfiles "BranchAA 1" writefile FbranchAA.txt "BranchAA 1" addfile FbranchAA.txt branchAA delfile Ftrunk.txt branchAA # series of tags with update foreach t {first second third} { tag $SVNROOT $t UpdTags.txt 1 } commit "Changes on Branch AA" cd $WD # Make another revision on branchA after # branchAA has branched off puts "===============================" puts "Third revision on Branch A" cd $WD/svn_test_branchA modfiles "BranchA 3" commit "Third revision on Branch A" cd $WD # Branch B puts "===============================" puts "MAKING BRANCH B" newbranch $SVNROOT $taghead(trunk) branchB cd $WD/svn_test_branchB # Empty branch. Don't check out or update. set exec_cmd "svn mkdir -m\"empty_branch\" file://$SVNROOT/$taghead(branch)/branchD" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out if {$ret} { exit 1 } modfiles "BranchB 1" writefile FbranchB.txt "BranchB 1" addfile FbranchB.txt branchB commit "Add file FB on Branch B" cd $WD } if {$leave_a_mess} { # Leave the trunk with uncommitted changes puts "===============================" puts "Making Uncommitted changes on trunk" cd $WD/svn_test_trunk # Local only writefile FileLocal.txt "Pending" # Conflict conflict Ftrunk.txt # Newly added writefile FileAdd.txt "Pending" addfile FileAdd.txt trunk # Rename a file. "moved to" and "moved from" movefile File4.txt FileMoved.txt # Plain, empty directory file mkdir Dir3 file mkdir "Dir1/New dir" # Missing file delete -- File3.txt trunk # Modify writefile File2.txt "Pending" writefile "F-utf-8.txt" "\xA53378" "utf-8" writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1" writefile "Dir1/F 3.txt" "Pending" delfile "Dir1/F2.txt" trunk writefile "Dir 2/F1.txt" "Pending" movefile "Dir1/F4.txt" "Dir1/FMoved.txt" # Change a file that's been moved. writefile "Dir1/FMoved.txt" "Post-move change" cd $WD } # Remove the source file delete -force -- svn_test tkrev_9.6.1/teststuff/mktest-rcs.tcl0000775000175000017500000002033315030415106020102 0ustar dorothyrdorothyr#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" -- ${1+"$@"} proc cleanup_old {} { set oldirs [glob -nocomplain -- rcs_test*] foreach od $oldirs { puts "Deleting $od" file delete -force $od } puts "===============================" } proc checkin_files {topdir} { global WD puts "===============================" file mkdir RCS puts "IMPORTING FILES $topdir" # Check in files foreach n {1 2 3 4} { set filename File$n.txt set rcsfile RCS/$filename,v # Escape the spaces in filenames regsub -all { } $filename {\ } filename regsub -all { } $rcsfile {\ } rcsfile set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename $rcsfile" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } foreach filename { FTags.txt "File Spc.txt" } { set rcsfile RCS/$filename,v # Escape the spaces in filenames regsub -all { } $filename {\ } filename regsub -all { } $rcsfile {\ } rcsfile set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename $rcsfile" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } foreach D {Dir1 "Dir 2"} { puts $D cd $D file mkdir RCS foreach n {1 2 " 3"} { set rcsfile RCS/F$n.txt,v # Escape the spaces in filenames regsub -all { } F$n.txt {\ } F$n.txt regsub -all { } $rcsfile {\ } rcsfile set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" F$n.txt $rcsfile" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } cd $topdir } } proc checkout_files {topdir} { global WD cd $topdir puts "===============================" puts "CHECKING OUT" set globpat "RCS/*,v" regsub -all { } $globpat {\ } globpat set exec_cmd "co -f -l [glob $globpat]" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out foreach D {Dir1 "Dir 2"} { cd $D set globpat "RCS/*,v" regsub -all { } $globpat {\ } globpat set exec_cmd "co -f -l [glob $globpat]" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out cd $topdir } puts "CHECKOUT FINISHED" } proc tag {tag revision obj} { set exec_cmd "rcs -n$tag:$revision $obj" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc writefile {filename string} { puts " append \"$string\" to $filename" set fp [open "$filename" a] puts $fp $string close $fp } proc write_funny_files {} { puts "Creating utf-8 file" set fid1 [open "code-utf-8.txt" w] chan configure $fid1 -encoding utf-8 puts $fid1 "€20" chan close $fid1 puts "Creating iso8859-1 file" set fid2 [open "code-iso8859-1.txt" w] chan configure $fid2 -encoding iso8859-1 puts $fid1 "Copyright © 2025" chan close $fid2 } proc addfile {filename} { puts "Add $filename" set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out set exec_cmd "co -l $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc delfile {filename} { puts "Delete $filename" file delete $filename file delete RCS/$filename,v } proc lock {filename} { puts "Lock $filename" set exec_cmd "rcs -l $filename" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc getrev {filename} { # Find out current revision set exec_cmd "rcs log -b $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] #puts $out foreach logline [split $out "\n"] { if {[string match "revision *" $logline]} { set latest [lindex $logline 1] break } } puts "latest rev is $latest" return $latest } proc conflict {filename} { # Create a conflict set latest [getrev $filename] # Save a copy file copy $filename Ftmp.txt # Make a change set exec_cmd "rcs -l $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] file attributes $filename -permissions u+w writefile $filename "Conflict A" set exec_cmd "ci -m\"change1\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out previous revision set exec_cmd "co -l -r$latest $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Make a different change (we hope) file delete -force -- $filename file rename Ftmp.txt $filename file attributes $filename -permissions u+w writefile $filename "Conflict B" # When we check in a conflicting version, it creates # a branch set exec_cmd "ci -m\"change2\\\ conflicting\" $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out # Check out the branch set exec_cmd "co -r1.2.1 $filename" puts "$exec_cmd" set ret [catch {eval "exec $exec_cmd"} out] puts $out } proc commit {comment} { puts "COMMIT" puts [pwd] set tmpfile "list.tmp" file delete -force $tmpfile puts "Finding RCS files" if {[ info exists env(SystemDrive) ]} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -o -name RCS -prune -a -type f > $tmpfile"} out] } if {$ret} { puts $out puts "Find failed" exit 1 } puts "CHECKING IN FILES" regsub -all { } $comment {_} comment set fl [open $tmpfile r] while { [gets $fl item] >= 0} { regsub -all { } $item {\ } filename regsub -all { } $comment {\\\ } comment #set exec_cmd "ci -u -t-small_text_file -m\"$comment\" $filename" puts " $filename" set exec_cmd "ci -u -m\"$comment\" \"$filename\"" puts $exec_cmd set ret [catch {eval "exec $exec_cmd"} out] puts $out } close $fl file delete -force $tmpfile } proc mkfiles {topdir} { global WD puts "MAKING FILETREE" file mkdir "$topdir" cd $topdir # Make some files each containing a random word foreach n {1 2 3 4} { writefile File$n.txt "Initial" } writefile "File Spc.txt" "Initial" writefile FTags.txt "Initial" write_funny_files foreach D {Dir1 "Dir 2"} { puts $D file mkdir $D cd $D foreach n {1 2 " 3"} { writefile F$n.txt "Initial" } cd $topdir } # Plain, empty directory file mkdir Dir3 file mkdir "Dir1/New dir" } proc modfiles {string} { global tcl_platform puts "MODIFYING FILES" set tmpfile "list.tmp" file delete -force $tmpfile puts "Finding RCS files" if {$tcl_platform(platform) eq "windows"} { puts "Must be a PC" set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out] } else { set ret [catch {eval "exec find . -name F*.txt -o -name RCS -prune -a -type f > $tmpfile"} out] } if {$ret} { puts $out puts "Find failed" exit 1 } set fl [open $tmpfile r] while { [gets $fl item] >= 0} { # Why didn't co -l make it writeable? file attributes $item -permissions u+w writefile $item "$string" } close $fl file delete -force $tmpfile } ############################################## if [file isdirectory RCS] { puts "Please don't do that here. There's already an RCS directory." exit 1 } set WD [pwd] set testdir "$WD/rcs_test" cleanup_old mkfiles $testdir checkin_files $testdir checkout_files $testdir puts "===============================" puts "First revision" puts "** modfiles" modfiles "Main 1" puts "** commit" commit "First Revision" puts "** writefile" writefile Fnew.txt "Main 1" puts "** addfile" addfile Fnew.txt puts "===============================" puts "Second revision" checkout_files $testdir modfiles "Main 2" commit "Second revision" foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} { tag "tag_$t" 1.2 FTags.txt } tag "one" 1.2 "Dir1/F1.txt" puts "===============================" puts "Making Uncommitted changes" #Local only writefile FileLocal.txt "Pending" # Deleted delfile File3.txt # Modify file attributes File2.txt -permissions u+w writefile File2.txt "Pending" file attributes F-utf-8.txt -permissions u+w writefile "F-utf-8.txt" "\xA53378" "utf-8" file attributes F-iso8859-1.txt -permissions u+w writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1" lock File2.txt # Conflict puts "** conflict" conflict Fnew.txt cd $WD tkrev_9.6.1/teststuff/vendorcode.sh0000664000175000017500000000505215026070375017776 0ustar dorothyrdorothyr#!/bin/sh # File: vendorcode.sh # By: Eugene Lee, 1995 # Modified: EAL 10/21/03 Changed directory Vendor to 3rdParty # EAL 1/28/04 Code in V1,V2,V3 in directory 3rdParty moved to its # own directories under directory Examples echo "This script will create source code in directories Examples/Local-1.0", echo "Examples/3rdPartyV1, Examples/3rdPartyV2, & Examples/3rdPartyV3 to be" echo "used to demonstrate merging of vendor code into a local version of" echo "the code as described in file vendor5readme.txt" echo "" echo "Continue? (y/n):" read answer case "$answer" in y) ;; Y) ;; *) exit esac if test -d Examples then echo directory Examples exists already else mkdir Examples echo created directory Examples fi cd Examples if test -d Local-1.0 then echo directory Local-1.0 already exists cd Local-1.0 rm -f * else mkdir Local-1.0 echo created directory Local-1.0 cd Local-1.0 fi # Create files for module Local-1.0 cat > main < get < main < get < main < get < sort < main < getsort < and released as public domain. In 1998 Dorothy Robinson took over maintainership. TKCVS was re-licensed under the GPL v2 (or later) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, see . TkCVS was renamed to TKRev in 2020 (version 9.4). List of copyright holders for tkrev (excluding contrib and tkdiff subdirectories) Copyright (C) 1992-1998 Del del@babel.com.au Copyright (C) 1998-2025 Dorothy Robinson Copyright (C) 1999 Christoph Jaeschke Copyright (C) 1999 Jo Wahle Copyright (C) 1999-2000 Marcel Koelewijn Copyright (C) 2002 Mike Jagdis Copyright (C) 2025 by Michael-M ("vampm") The tkdiff subdirectory contains a copy of tkdiff https://sourceforge.net/p/tkdiff - See its README.txt for copyright/license information. Other contributors: Release 4 Carl Staelin staelin@info.hpl.hp.com Uwe Graichen graichen@bln.sel.alcatel.de Matthias Schade mascha@mt.e-technik.uni-kassel.de Steven Jowers jowers@pat.mdc.com Release 5 Jeremy Harker harkerj@ttc.com Eugene Lee, Aerospace Corporation. gene@mars.aero.org Release 6.1 M.E. Smith Christoph Jaeschke Jo Wahle Stephen Kick Release 6.3 (2000) Andrew Johnson Marcel Koelewijn Release 7.1 2002 Mike Jagdis 2002 Laurent Duperval 2002 John Lash 2002 John Cerney Release 8.2 (2011) 2010 Steve Schwarm Release 9.6 2025 Michael Moran vampm@comcast.net tkrev_9.6.1/doinstall.tcl0000755000175000017500000001305514725662635015776 0ustar dorothyrdorothyr#!/bin/sh #-*-tcl-*- # the next line restarts using wish \ if [ -z "$DISPLAY" -o "X$1" = "X-nox" ]; then \ exec tclsh "$0" -- ${1+"$@"}; else exec wish "$0" -- ${1+"$@"}; fi # # Usage: doinstall.tcl [-nox] [destination] # # For a non-interactive installation which doesn't require an X server, do ## doinstall.tcl -nox /usr/local # proc set_paths {INSTALLROOT} { global tcl_platform global LIBDIR BINDIR MANDIR if {$tcl_platform(platform) == "windows"} { set BINDIR [file join $INSTALLROOT bin] set LIBDIR [file join $INSTALLROOT lib] set MANDIR "" } else { set BINDIR [file join $INSTALLROOT bin] set LIBDIR [file join $INSTALLROOT lib] set MANDIR [file join $INSTALLROOT share man man1] } } proc show_paths {INSTALLROOT} { global tcl_platform global TKREV TKDIFF global LIBDIR BINDIR MANDIR set_paths $INSTALLROOT set msg(1) [file join $BINDIR $TKREV] set msg(2) [file join $BINDIR $TKDIFF] set msg(3) [file join $LIBDIR tkrev *.tcl] set msg(4) [file join $LIBDIR tkrev bitmaps *.png,xbm] if {$tcl_platform(platform) == "unix"} { set msg(5) [file join $MANDIR tkrev.1] } foreach m [lsort [array names msg]] { if {[winfo exists .messages.$m]} { destroy .messages.$m } global var$m set var$m $msg($m) label .messages.$m -text $msg($m) -justify left -textvariable var$m pack .messages.$m -side top -anchor w } } proc doinstall { INSTALLROOT } { global tcl_platform global TKREV TKDIFF global LIBDIR BINDIR MANDIR global X set_paths $INSTALLROOT # Some directories we have to create. set TCDIR [file join $LIBDIR tkrev] set GFDIR [file join $LIBDIR tkrev bitmaps] file mkdir $INSTALLROOT foreach dir [concat \"$BINDIR\" \"$GFDIR\" \"$TCDIR\"] { file mkdir $dir } set destfile [file join $BINDIR $TKREV] puts "Installing $TKREV in $BINDIR" file copy -force [file join tkrev tkrev.tcl] [file join $BINDIR $TKREV] puts "Installing $TKDIFF in $BINDIR" file copy -force [file join tkdiff tkdiff] [file join $BINDIR $TKDIFF] if {$tcl_platform(platform) == "unix"} { file attributes $destfile -permissions 0755 file attributes [file join $BINDIR $TKDIFF] -permissions 0755 file mkdir $MANDIR puts "Installing manpage tkrev.1 in $MANDIR" file copy -force [file join tkrev tkrev.1] $MANDIR } puts "Installing tcl files in $TCDIR" cd tkrev foreach tclfile [glob *.tcl tclIndex] { if {$tclfile != "tkrev.tcl"} { puts " $tclfile" file copy -force $tclfile $TCDIR } } puts "Installing icons in $GFDIR" cd bitmaps foreach pixfile [glob *.png *.xbm] { puts " $pixfile" file copy -force $pixfile $GFDIR } cd [file join .. ..] puts "Finished!" if {$X} { destroy .bottom.do destroy .bottom.not button .bottom.done -text "Finished!" -command {destroy .} pack .bottom.done } } ################################################################################ set usage "Usage: doinstall.tcl \[-nox\] \[destination\]" set X 1 # Check Tcl/TK version if {$tcl_version < 8.5} { tk_dialog .wrongversion "Tcl/Tk too old" \ "TkRev requires Tcl/Tk 8.5 or better!" \ error 0 {Bye Bye} exit 1 } # See if the user changed them with command-line args set ArgInstallRoot "" for {set i 0} {$i < [llength $argv]} {incr i} { set arg [lindex $argv $i] switch -exact -- $arg { -- { continue } -nox { set X 0 } --help { puts "$usage"; exit } -h { puts "$usage"; exit } -finaldir { puts "The -finaldir option is obsolete." puts "TkRev now figures out where it is at run-time," puts "so substituting paths is unnecessary." exit 1 } default { set ArgInstallRoot $arg } } } # Do this after checking tcl version, because 7.x doesn't have it. if {[string match "*tclsh" [info nameofexecutable]]} { set X 0 } else { if {$X && [catch {frame .title} err]} { puts "\nTk can't draw the UI." puts "Something seems to be wrong with your X11 environment." set X 0 puts "You may use the -nox argument to do a command-line install:" puts "$usage" exit } } # Some rational and reasonable defaults. if {$tcl_platform(platform) == "windows"} { set INSTALLROOT "C:\\" set TKREV "tkrev.tcl" set TKDIFF "tkdiff.tcl" } else { set INSTALLROOT [file join /usr local] set TKREV "tkrev" set TKDIFF "tkdiff" } if {$ArgInstallRoot != ""} { set INSTALLROOT $ArgInstallRoot } if {$X} { # GUI installation label .title.lbl -text "TkRev Installer" -font {Helvetica -14 bold} pack .title -side top pack .title.lbl -side top frame .entry label .entry.instlbl -text "Installation Root" entry .entry.instent -textvariable INSTALLROOT bind .entry.instent {show_paths $INSTALLROOT} bind .entry.instent {show_paths $INSTALLROOT} pack .entry -side top -pady 10 pack .entry.instlbl -side left pack .entry.instent -side left frame .messages -relief groove -bd 2 pack .messages -side top -expand y -fill x label .messages.adv -text "These files will be installed:" pack .messages.adv -side top show_paths $INSTALLROOT frame .bottom button .bottom.do -text "Install" -command {doinstall $INSTALLROOT} button .bottom.not -text "Cancel" -command {destroy .} pack .bottom -side top pack .bottom.do -side left pack .bottom.not -side left } else { # Command-line installation if {$ArgInstallRoot != ""} { set INSTALLROOT $ArgInstallRoot } else { puts "Install where? \[/usr/local\]" gets stdin IN puts "you entered $IN" } #puts "Will install in $INSTALLROOT" doinstall $INSTALLROOT } tkrev_9.6.1/contrib/0000775000175000017500000000000015034253754014724 5ustar dorothyrdorothyrtkrev_9.6.1/contrib/cvsdiff0000775000175000017500000000540315026070375016275 0ustar dorothyrdorothyr#!/bin/sh # Uses gvim to compare CVS versions. # Written by Phil Brooks and Brent Geske at Mentor Graphics 2007 # To use with TkCVS, "set cvscfg(tkdiff) cvsdiff" # Rudimentary arg check: if [ ! $# -gt 0 ] then echo "Usage: $0 [-r revA] [-r revB] file [files ...]" exit 127 fi unset REV unset REVB CVS="" if [ -d CVS ] then CVS="cvs update -p" fi if [ -d .svn ] then CVS="svn cat" fi if [ "$CVS" = "" ] then echo "No CVS or .svn directory. Exiting." exit 1 fi if [ "$1" = "-r" ] then REV=$2 shift; shift else REV="HEAD" fi if [ "$1" = "-r" ] then REVB=$2 shift; shift fi # Presumed env vars: if [ "$VDIFF" = "" ] then VDIFF="gvim -d -f" fi if [ "$OS" = "Windows_NT" ] then TMP="${SYSTEMDRIVE}/TEMP" else TMP="/tmp" fi ME=`basename $0` SCRIPTFILE="${TMP}/${ME}.script.$$" # Get files echo "" > $SCRIPTFILE # loop once to generate diff commands for each file (also spit out some useful info) for f in $* do FILEPATH="$f" FILEBASE="`basename ${FILEPATH}`" TMPPATH="${TMP}/${REV}-${FILEBASE}" TMPPATHB="${TMP}/${REVB}-${FILEBASE}" if [ ! -r "${FILEPATH}" ] then echo "$0: Local File '${FILEPATH}' not found." continue fi if [ "$REVB" != "" ] ; then echo -n "${REV} vs. ${REVB} ${FILEBASE}..." else echo -n "${REV} vs. LOCAL ${FILEBASE}..." fi $CVS -r${REV} $FILEPATH > $TMPPATH 2> /dev/null if [ "$REVB" != "" ] ; then $CVS -r${REVB} $FILEPATH > $TMPPATHB 2> /dev/null fi if [ -s "$TMPPATH" ] then if [ "$REVB" != "" ] ; then if [ -s "$TMPPATHB" ]; then echo "$VDIFF $TMPPATH $TMPPATHB >/dev/null &" >> $SCRIPTFILE echo -n " : diffcount =" diff $TMPPATH $TMPPATHB | grep '^[0-9]' | wc -l else echo " :" echo "$0: CVS revision ${REV} for '${FILEPATH}' not found." fi else echo "$VDIFF $TMPPATH $FILEPATH >/dev/null &" >> $SCRIPTFILE echo -n " : diffcount =" diff $TMPPATH $FILEPATH | grep '^[0-9]' | wc -l fi else echo " :" echo "$0: CVS revision ${REV} for '${FILEPATH}' not found." fi done echo "# wait for all diffs to finish, then cleanup temporaries" >> $SCRIPTFILE echo "wait" >> $SCRIPTFILE # loop again for cleanup for f in $* do FILEPATH="$f" FILEBASE="`basename ${FILEPATH}`" TMPPATH="${TMP}/${REV}-${FILEBASE}" TMPPATHB="${TMP}/${REVB}-${FILEBASE}" # loop for these: echo "rm -f '$TMPPATH' '$TMPPATHB'" >> $SCRIPTFILE done # One last step of non-looped cleanup stuff: # Can the script remove itself? YES. echo "rm -f '$SCRIPTFILE'" >> $SCRIPTFILE # Display files . $SCRIPTFILE & tkrev_9.6.1/Local.csh0000775000175000017500000000032013772424677015026 0ustar dorothyrdorothyr# Do these steps (csh) # Or just source this file # To make the dev directory locally runnable # from this directory (the one containing Local.txt) setenv TCLROOT `pwd` alias tkrev $TCLROOT/tkrev/tkrev.tcl tkrev_9.6.1/Local.bat0000775000175000017500000000011713772424677015023 0ustar dorothyrdorothyrSET TCLROOT=%cd% @doskey tkrev=C:\Tcl\bin\wish85 %TCLROOT%\tkrev\tkrev.tcl tkrev_9.6.1/Local.sh0000775000175000017500000000042013772424677014664 0ustar dorothyrdorothyr# Do these steps (sh) # Or just source this file # To make the dev directory locally runnable # from this directory (the one containing Local.txt) TCLROOT=`pwd` export TCLROOT alias tkrev=$TCLROOT/tkrev/tkrev.tcl # Windows #alias tkrev="wish85 $TCLROOT/tkrev/tkrev.tcl"