version.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# Copyright (c) 2000, 2001, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator 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, or (at your option)
# any later version.
# 
# Source-Navigator 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 Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# version.tcl - Procedures for version control system integration.
# Copyright (C) 1998 Cygnus Solutions.

proc sn_add_version_control_system {ident args} {
    global sn_options
    global sn_verctl_options

    foreach variable {checkout-with-lock use-relative-path}  {
        set sn_verctl_options(${ident},${variable}) 0
    }

    # some defaults
    set sn_verctl_options(${ident},diff-command) "diff"
    set sn_verctl_options(${ident},diff-ignore-whitespace) "-w"
    set sn_verctl_options(${ident},diff-ignore-case) "-i"

    foreach variable {history-replacements symbolic-tag-replacements} {
        set sn_verctl_options(${ident},${variable}) ""
    }

    set title [string toupper ${ident}]

    for {set i 0} {${i} < [llength ${args}]} {incr i} {
        set arg [lindex ${args} ${i}]
        incr i
        set val [lindex ${args} ${i}]

        switch -- ${arg} {
            "-checkin" {
                    set sn_verctl_options(${ident},checkin) ${val}
                }
            "-checkin-comment-via" {
                    set sn_verctl_options(${ident},checkin-comment-via) ${val}
                }
            "-checkin-exclusive" {
                    set sn_verctl_options(${ident},checkin-exclusive) ${val}
                }
            "-checkout" {
                    set sn_verctl_options(${ident},checkout) ${val}
                }
            "-checkout-exclusive" {
                    set sn_verctl_options(${ident},checkout-exclusive) ${val}
                }
            "-checkout-individual" {
                    set sn_verctl_options(${ident},checkout-individual) ${val}
                }
            "-checkout-individual-to-stdout" {
                    set\
                      sn_verctl_options(${ident},checkout-individual-to-stdout) ${val}
                }
            "-checkout-with-lock" {
                    if {${val} == "yes"} {
                        set sn_verctl_options(${ident},checkout-with-lock) 1
                    }
                }
            "-default" {
                    if {${val} == "yes"} {
                        set sn_options(both,rcs-type) ${ident}
                    }
                }
            "-delete-revision" {
                    set sn_verctl_options(${ident},delete-revision) ${val}
                }
            "-diff-command" {
                    set sn_verctl_options(${ident},diff-command) ${val}
                }
            "-diff-ignore-case" {
                    set sn_verctl_options(${ident},diff-ignore-case) ${val}
                }
            "-diff-ignore-whitespace" {
                    set sn_verctl_options(${ident},diff-ignore-whitespace)\
                      ${val}
                }
            "-discard" {
                    set sn_verctl_options(${ident},discard) ${val}
                }
            "-history" {
                    set sn_verctl_options(${ident},history) ${val}
                }
            "-history-pattern" {
                    set sn_verctl_options(${ident},history-pattern) ${val}
                }
            "-history-individual" {
                    set sn_verctl_options(${ident},history-individual) ${val}
                }
            "-history-individual-pattern" {
                    set sn_verctl_options(${ident},history-individual-pattern)\
                      ${val}
                }
            "-history-replacements" {
                    set sn_verctl_options(${ident},history-replacements) ${val}
                }
            "-ignore-dirs" {
                    foreach directory ${val} {
                        lappend sn_options(def,ignored-directories) ${directory}
                    }
                }
            "-lock" {
                    set sn_verctl_options(${ident},lock) ${val}
                }
            "-lock-individual" {
                    set sn_verctl_options(${ident},lock-individual) ${val}
                }
            "-revision-number-pattern" {
                    set sn_verctl_options(${ident},revision-number-pattern)\
                      ${val}
                }
            "-symbolic-tags-pattern" {
                    set sn_verctl_options(${ident},symbolic-tags-pattern) ${val}
                }
            "-symbolic-tags-replacements" {
                    set sn_verctl_options(${ident},symbolic-tags-replacements)\
                      ${val}
                }
            "-title" {
                    set title ${val}
                }
            "-unlock" {
                    set sn_verctl_options(${ident},unlock) ${val}
                }
            "-unlock-individual" {
                    set sn_verctl_options(${ident},unlock-individual) ${val}
                }
	    "-use-relative-path" {
             	    set sn_verctl_options(${ident},use-relative-path) $val
	        }
            default {
                    puts stderr "sn_add_version_control_system: unknown\
                      argument <${arg}>"
                }
        }
    }

    lappend sn_options(sys,supported-vcsystems) [list ${title} ${ident}]
}

proc sn_rcs_extract_text {patterns text} {
    set result ""
    foreach pair ${patterns} {
        if {[llength ${pair}] > 1} {
            set start 0
            if {[lindex ${pair} 0] != "start"} {
                foreach line ${text} {
                    if {[regexp -- [lindex ${pair} 0] ${line} ignore] > 0} {
                        break
                    }
                    incr start
                }
            }

            if {[lindex ${pair} 1] == "end"} {
                set end [expr [llength ${text}]]
            } else {
                set end [expr ${start}]
                foreach line [lrange ${text} ${start} end] {
                    if {[regexp -- [lindex ${pair} 1] ${line} ignore] > 0} {
                        break
                    }
                    incr end
                }
            }
            foreach line [lrange ${text} [expr ${start} + 1] [expr ${end}\
              - 1]] {
                lappend result ${line}
            }
        } else {
            set pattern ${pair}
            foreach line ${text} {
                if {[regexp -- ${pattern} ${line} ignore match] > 0} {
                    lappend result ${match}
                    break
                }
            }
        }
    }
    return ${result}
}

proc sn_revision_ctrl {} {
    global tkeWinNumber
    set new 1

    #only one project window can be opened
    set obj ".sn-rcs"
    if {[winfo exists ${obj}]} {
        ${obj} raise
    } else {
        RevisionCtrl& ${obj}
    }
}


proc sn_rcs_history {file revision syms history} {
    global sn_options
    global sn_verctl_options


    upvar ${syms} symbols
    upvar ${history} output

    set rcstype $sn_options(both,rcs-type)
    set file [RevisionCtrl&::source_file_names ${file}]


    if {![info exists sn_verctl_options(${rcstype},history-individual)] ||\
      ![info exists sn_verctl_options(${rcstype},history)]} {
        set output ""
        set symbols ""
        return {}
    }

    set relative_file [sn_rcs_process_filenames $sn_verctl_options($rcstype,use-relative-path) $file]

    if {${revision} != ""} {
        # seek history for a particular revision
        set cmd\
          "$sn_verctl_options(${rcstype},history-individual)${revision} ${relative_file}"
    } else {
        # seek history for all revisions
        set cmd "$sn_verctl_options(${rcstype},history) $relative_file"
    }

    # Change directory to file's directory. 
    if {$sn_verctl_options($rcstype,use-relative-path)} {
	set currentworkdir [pwd]
	cd [sn_rcs_get_common_path $file]
    }

    set output [sn_rcs_exec ${cmd} 0]

    # Move back to working directory.
    if {$sn_verctl_options($rcstype,use-relative-path)} {
	cd $currentworkdir
    }

    if {[info exists sn_verctl_options(${rcstype},symbolic-tags-pattern)]} {
        set patterns $sn_verctl_options(${rcstype},symbolic-tags-pattern)
        set symbols [sn_rcs_extract_text ${patterns} ${output}]
    } else {
        set symbols ""
    }

    if {[info exists\
      sn_verctl_options(${rcstype},symbolic-tags-replacements)]} {
        set replacements\
          $sn_verctl_options(${rcstype},symbolic-tags-replacements)
        sn_search_replace ${replacements} ${symbols} symbols
    }

    catch {unset patterns}

    if {${revision} != ""} {
        if {[info exists\
          sn_verctl_options(${rcstype},history-individual-pattern)]} {
            set patterns\
              $sn_verctl_options(${rcstype},history-individual-pattern)
        }
    } else {
        if {[info exists sn_verctl_options(${rcstype},history-pattern)]} {
            set patterns $sn_verctl_options(${rcstype},history-pattern)
        }
    }

    if {[info exists patterns]} {
        set output [sn_rcs_extract_text ${patterns} ${output}]
    }
    # else no modification to output.

    if {[info exists sn_verctl_options(${rcstype},history-replacements)]} {
        set replacements $sn_verctl_options(${rcstype},history-replacements)
        sn_search_replace ${replacements} ${output} output
    }

    # retrieve the list of available revision numbers

    if {[info exists sn_verctl_options(${rcstype},revision-number-pattern)]} {
        set pattern $sn_verctl_options(${rcstype},revision-number-pattern)
        return [sn_lgrep ${pattern} ${output}]
    } else {
        return {}
    }
}

# Obtains revision information about $file.

proc sn_rcs_get_revisions {file log_rev symbols vers {log ""} {bsy 1}} {
    global sn_options
    upvar ${symbols} sy
    upvar ${vers} versions


    if {${log} != ""} {
        upvar ${log} lg
    }

    # get log information

    set versions [sn_rcs_history ${file} ${log_rev} sy lg]

    set versions [string trim ${versions}]

    if {[string compare ${versions} ""] == 0} {
        return 0
    }
    return 1
}

# returns revisions of $file 
proc sn_rcs_get_version_nums {file revisions} {
    global sn_options
    global sn_verctl_options
    upvar ${revisions} revs

    set file [lindex ${file} 0]
    set rcstype $sn_options(both,rcs-type)
    set relative_file [sn_rcs_process_filenames $sn_verctl_options($rcstype,use-relative-path) $file]

    if {![info exists sn_verctl_options(${rcstype},history)]} {
        sn_log "Can't get version numbers, no $rcstype history command."
        return {}
    }

    # Change directory to file's directory.
    if {$sn_verctl_options($rcstype,use-relative-path)} {
	set currentworkdir [pwd]
	cd [sn_rcs_get_common_path $file]
    }

    if {[catch {sn_rcs_exec "$sn_verctl_options(${rcstype},history) ${relative_file}"\
      0} output]} {
        return 0
    }

    # Move back to working directory.
    if {$sn_verctl_options($rcstype,use-relative-path)} {
	cd $currentworkdir