version.tcl

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

    pack ${w}.ctrl -side left -fill both

    set revisions ""
    catch {sn_rcs_get_version_nums ${files} revisions}
    set ${w}.ctrl.vers [lindex ${revisions} 0]

    Selector& ${w}.syms -contents ${revisions} -height 5 -width 10 -sort ""

    ${w}.syms treebind <ButtonRelease-1> "set ${w}.ctrl.vers \[${w}.syms marked\]"
    ${w}.syms treebind <Double-1> "${lock} invoke"
    pack ${w}.syms -side left -fill both -expand y

    ${w} move_to_mouse

    ${w} on_close "${cancel} invoke"

    upvar #0 ${w}-select_status status
    set status ""

    tkwait variable ${w}-select_status
    itcl::delete object ${w}

    if {${status} != "cancel"} {
        upvar #0 ${w}.ctrl.vers rev

        switch ${cmd} {
            "del" {
                    set cmdline $sn_verctl_options(${rcstype},delete-revision)

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

                    set result [expr ![catch {sn_rcs_exec\
                      "${cmdline}${rev} ${relative_files}"}]]

		    # Move back to working directory.
		    if {$sn_verctl_options($rcstype,use-relative-path)} {
		        cd $currentworkdir
		    }
                }
            "lock" {
                    if {[info exists\
                      sn_verctl_options(${rcstype},lock-individual)]} {
                        set cmdline\
                          $sn_verctl_options(${rcstype},lock-individual)

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

                        set result [expr ![catch {sn_rcs_exec\
                          "${cmdline}${rev} ${relative_files}"}]]

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

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

                        set result [expr ![catch {sn_rcs_exec\
                          "${cmdline} ${relative_files}"}]]

			# Move back to working directory.
			if {$sn_verctl_options($rcstype,use-relative-path)} {
			    cd $currentworkdir
			}
                    }
                }
            "unlock" {
                    if {[info exists\
                      sn_verctl_options(${rcstype},unlock-individual)]} {
                        set cmdline\
                          $sn_verctl_options(${rcstype},unlock-individual)

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

                        set result [expr ![catch {sn_rcs_exec\
                          "${cmdline}${rev} ${relative_files}"}]]

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

                    } else {
                        set cmdline $sn_verctl_options(${rcstype},unlock)

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

                        set result [expr ![catch {sn_rcs_exec\
                          "${cmdline} ${files}"}]]

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

        RevisionCtrl&::refresh ${marked_files}
    } else {
        set status 0
    }

    set sta ${status}
    unset status

    return ${sta}
}

proc sn_rcs_diff {basewindow files} {
    global sn_options
    global sn_verctl_options
    global env

    set rcstype $sn_options(both,rcs-type)

    # Clean any namespace off of basewindow.
    set basewindow [namespace tail $basewindow]

    # Block UI while we get the diff info.
    tixBusy $basewindow on

    # Create a window, dependend on the main window.
    set w ${basewindow}-rcs_diff_dialog
    if {[winfo exists ${w}]} {
        raise ${w}
        return
    }

# FIXME: This needs to be refactored into a widget
# that extends the Dialog class!
    sourcenav::Window ${w}
    ${w} withdraw
    ${w} transient ${basewindow}

    set ti [string trimright [get_indep String ChooseDiff] "."]
    ${w} title [list ${ti} ${files}]

    set diff ${w}.ctrl.button_0
    set cancel ${w}.ctrl.button_1

    frame ${w}.ctrl
    sn_motif_buttons ${w}.ctrl bottom 0 [get_indep String ok]\
      [get_indep String cancel]

    set cmd $sn_verctl_options(${rcstype},checkout-individual-to-stdout)

    ${diff} config -command " set ${w}-select_status [list ${cmd}] "
    ${cancel} config -command " set ${w}-select_status cancel "

    frame ${w}.ctrl.vers
    global ${w}.ignoreWhitespace ${w}.ignoreCase
    # ignore whitespace by default
    set ${w}.ignoreWhitespace 1
    set ${w}.ignoreCase 0

    global ${w}.ctrl.vers
    entry ${w}.ctrl.vers.e -textvariable ${w}.ctrl.vers
    label ${w}.ctrl.vers.l -text [get_indep String ChooseRevision]

    pack ${w}.ctrl.vers.l -side left
    pack ${w}.ctrl.vers.e -side left -fill x -expand y -padx 5
    pack ${w}.ctrl.vers -pady 2
    frame ${w}.ctrl.opt
    checkbutton ${w}.ctrl.opt.ws -text [get_indep String IgnoreWS]\
      -variable ${w}.ignoreWhitespace -anchor w
    pack ${w}.ctrl.opt.ws -fill x -expand y
    checkbutton ${w}.ctrl.opt.ca -text [get_indep String IgnoreCase]\
      -variable ${w}.ignoreCase -anchor w
    pack ${w}.ctrl.opt.ca -fill x -expand y
    pack ${w}.ctrl.opt -fill x -expand y
    pack ${w}.ctrl -side left -fill both

    set versions ""

    sn_rcs_get_version_nums ${files} versions

    set ${w}.ctrl.vers [lindex ${versions} 0]
    Selector& ${w}.syms -contents ${versions} -height 5 -width 10 -sort ""

    ${w}.syms treebind <ButtonRelease-1> "set ${w}.ctrl.vers \[${w}.syms marked\]"
    ${w}.syms treebind <Double-1> "${diff} invoke"
    pack ${w}.syms -side left -fill both -expand y

    ${w} on_close "${cancel} invoke"

    # Release the UI block
    tixBusy $basewindow off

    ${w} centerOnScreen
    ${w} deiconify
    # Do we need tk do a ${w} take_focus ??
    ${w} grab set

    upvar #0 ${w}-select_status status
    set status ""

    vwait ${w}-select_status

    itcl::delete object ${w}

    if {${status} == "cancel"} {
        return
    }

    set home $env(HOME)
    if {[string compare ${home} "/"] != 0} {
        append home "/"
    }

    foreach f ${files} {
        set t_m_p [sn_tmpFileName]
        set err [sn_tmpFileName]
	set relative_f [sn_rcs_process_filenames $sn_verctl_options($rcstype,use-relative-path) $f]

        upvar #0 ${w}.ctrl.vers rev

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

        set cmd "${status}${rev} ${relative_f} > ${t_m_p} 2> ${err}"

        if {[catch [eval exec -- ${cmd}] msg]} {
	    # Move back to working directory.
	    if {$sn_verctl_options($rcstype,use-relative-path)} {
		cd $currentworkdir
	    }
	    if {![catch {set fd [open ${err}]}]} {
                fconfigure ${fd} -encoding $sn_options(def,system-encoding) -blocking 0
                set ermsg [read -nonewline ${fd}]
                close ${fd}
                append msg "\n" ${ermsg}
            }
            sn_error_dialog ${msg}

            file delete -- ${t_m_p} ${err}
            continue
        }

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

        set fd [open ${err} "r"]
        fconfigure ${fd} -encoding $sn_options(def,system-encoding) -blocking 0
        set stderr_msg [split [read -nonewline ${fd}] "\n"]
        close ${fd}

        set stderr_msg [lindex ${stderr_msg} 0]

        if {![file exists ${t_m_p}] || [file size ${t_m_p}] == 0} {
            file delete -- ${t_m_p}
            sn_error_dialog [get_indep String ChooseNothingCheckedOut]
            continue
        }

        set diffopt ""
        if [set ${w}.ignoreWhitespace] {
            set diffopt $sn_verctl_options(${rcstype},diff-ignore-whitespace)
        }
        if [set ${w}.ignoreCase] {
            set diffopt\
              "${diffopt} $sn_verctl_options(${rcstype},diff-ignore-case)"
        }

        #make sure we stay in project directory (different interpeters).
        catch {cd $sn_options(sys,project-dir)}

        RCSTopdiff& [sourcenav::Window::next_window_name] ${f} ${t_m_p}\
          ${stderr_msg} [sn_title DIFF] ${diffopt}
    }
}

proc sn_rcs_get_common_path {files} {
    if {$files == ""} {
	return
    }

    set dirname [file dirname [lindex $files 0]]

    foreach file $files {
	set filedir [file dirname $file]

	while {[string first $dirname $filedir] == -1} {
	    # TODO: check for error conditions.
	    set dirname [file dirname $dirname]
	    if {$dirname == "/"} {
		sn_error_dialog [get_indep String RCSRelativePathWarning]
	    }
	}
    }

    return $dirname
}

proc sn_rcs_process_filenames {userelativepath {files ""}} {
    if {$files == ""} {
	return
    }
    
    if {$userelativepath == 0} {
	return $files
    }

    set dirname [file dirname [lindex $files 0]]

    foreach file $files {
	set filedir [file dirname $file]
	while {[string first $dirname $filedir] == -1} {
	    # TODO: check for error conditions.
	    set dirname [file dirname $dirname]
 	    if {$dirname == "/"} {
		sn_error_dialog [get_indep String RCSRelativePathWarning]
	    }
	}
    }

    set filenames ""

    foreach $file $files {
	lappend filenames [file join [lrange [file split $file] [llength [file split $dirname]] end]]
    }

    return $filenames
}