# Program: xf
# Description: version control for procedures
#
# $Header: xfversion.tcl[2.3] Wed Mar 10 12:08:34 1993 garfield@garfield frozen $

##########
# Procedure: XFVersionDoLoad
# Description: actually load the procedure
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc XFVersionDoLoad {} {
  global xfConf
  global xfPath
  global xfVersion

  set xfCounter [.xfVersionLoad.current.current get]
  if {"$xfCounter" == ""} {
    return
  }
  if {$xfConf(versionCommand)} {
    set xfFileName $xfCounter
    if {[string last "\[" $xfCounter] >= 0 &&
        [string last "\]" $xfCounter] >= 0} {
      set xfFileName [string range $xfCounter 0 \
        [expr [string last "\[" $xfCounter]-1]]
      set xfFileVersion [string range $xfCounter \
        [expr [string last "\[" $xfCounter]+1] \
          [expr [string last "\]" $xfCounter]-1]]
    } {
      set xfFileVersion ""
    }
    if {"$xfFileVersion" != ""} {
      set xfCommand $xfVersion(retrv)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
      regsub -all {\$xfFileVersion} $xfCommand $xfFileVersion xfCommand
    } {
      set xfCommand $xfVersion(retrvDefault)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
    }
    if {"$xfCommand" != ""} {
      set xfSavePath [pwd]
      cd $xfPath(procedures)
      if {[catch "exec $xfCommand" xfResult]} {
        XFProcError "$xfResult"
      }
      if {[catch "source $xfFileName" xfResult]} {
        XFProcError "$xfResult"
      }
      set xfCommand $xfVersion(rm)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
      if {"$xfCommand" != ""} {
        if {[catch "exec $xfCommand" xfResult]} {
          XFProcError "$xfResult"
        }
      }
      cd $xfSavePath
    }
  } {
    if {[file exists $xfPath(procedures)/$xfCounter] &&
        [file readable $xfPath(procedures)/$xfCounter]} {
      if {[catch "source $xfPath(procedures)/$xfCounter" xfResult]} {
        XFProcError "$xfResult"
      }
    }
  }
}

##########
# Procedure: XFVersionDoSave
# Description: actually save the procedure
# Arguments: xfName - the name of the procedure
# Returns: none
# Sideeffects: none
##########
proc XFVersionDoSave {xfName} {
  global xfConf
  global xfPath
  global xfVersion

  foreach xfProcName [info procs $xfName] {
    if {[catch "open $xfPath(procedures)/$xfProcName w" xfOutFile] != 0} {
      XFProcError "$xfOutFile"
    } {
      # get arg list for prcedure
      set xfBodyList [string trimright [info body $xfProcName]]
      set xfArgList [info args $xfProcName]
      set xfArguments ""
      foreach xfArg $xfArgList {
        if {[info default $xfProcName $xfArg xfDefault] == 1} {
          set xfArguments "$xfArguments \{$xfArg \"$xfDefault\"\}"
        } {
          set xfArguments "$xfArguments $xfArg"
        }
      }
      # get procedure body
      puts $xfOutFile "\nproc $xfProcName {$xfArguments} {"
      if {[string index $xfBodyList 0] == "\n"} {
        puts $xfOutFile [string range $xfBodyList 1 end]
      } {
        puts $xfOutFile $xfBodyList
      }
      puts $xfOutFile "}"
      close $xfOutFile

      if {$xfConf(versionCommand)} {
        if {"[.xfVersionSave.descr.descr get]" != ""} {
          set xfCommand $xfVersion(saveMessage)
          regsub -all {\$xfFileName} $xfCommand $xfProcName xfCommand
          regsub -all {\$xfMessage} $xfCommand \
            [.xfVersionSave.descr.descr get] xfCommand
        } {
          set xfCommand $xfVersion(save)
          regsub -all {\$xfFileName} $xfCommand $xfProcName xfCommand
        }
        if {"$xfCommand" != ""} {
          set xfSavePath [pwd]
          cd $xfPath(procedures)
          if {[catch "exec $xfCommand" xfResult]} {
            if {"[string trim $xfResult]" != ""} {
              XFProcError "aa$xfResult"
            }
          }
          set xfCommand $xfVersion(rm)
          regsub -all {\$xfFileName} $xfCommand $xfProcName xfCommand
          if {"$xfCommand" != ""} {
            if {[catch "exec $xfCommand" xfResult]} {
              XFProcError "bb$xfResult"
            }
          }
          cd $xfSavePath
        }
        catch "exec rm $xfPath(procedures)/$xfProcName"
      }
    }
  }
}

##########
# Procedure: XFVersionInfo
# Description: show the version informations for current file
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc XFVersionInfo {} {
  global xfConf
  global xfPath
  global xfTextBox
  global xfVersion

  set xfCounter [.xfVersionLoad.current.current get]
  if {"$xfCounter" == ""} {
    return
  }
  if {$xfConf(versionCommand)} {
    set xfFileName $xfCounter
    if {[string last "\[" $xfCounter] >= 0 &&
        [string last "\]" $xfCounter] >= 0} {
      set xfFileName [string range $xfCounter 0 \
        [expr [string last "\[" $xfCounter]-1]]
      set xfFileVersion [string range $xfCounter \
        [expr [string last "\[" $xfCounter]+1] \
          [expr [string last "\]" $xfCounter]-1]]
    } {
      set xfFileVersion ""
    }
    if {"$xfFileVersion" != ""} {
      set xfCommand $xfVersion(listLong)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
      regsub -all {\$xfFileVersion} $xfCommand $xfFileVersion xfCommand
    } {
      set xfCommand $xfVersion(listLongDefault)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
    }
    if {"$xfCommand" != ""} {
      set xfSavePath [pwd]
      cd $xfPath(procedures)
      if {[catch "exec $xfCommand" xfResult]} {
        XFProcError "$xfResult"
      } {
        set xfTextBox(toplevelName) .xfTextVersionList
        XFProcText $xfResult 400x300 "XF info for: $xfCounter" {}
        set xfTextBox(toplevelName) .xfTextBox
      }
      cd $xfSavePath
    }
  }
}

##########
# Procedure: XFVersionLoad
# Description: load one version of a procedure
# Arguments: xfType - the type of window that activated this dialog
#                     procs or commands
#            xfLeader - the leading window
# Returns: none
# Sideeffects: none
##########
proc XFVersionLoad {xfType {xfLeader ""}} {
  global xfBind

  # build widget structure
  XFTmpltToplevel .xfVersionLoad 350x300 {Procedure loading} $xfLeader

  XFTmpltFrame .xfVersionLoad.frame1 0

  button .xfVersionLoad.frame1.ok \
    -text {OK} \
    -command "destroy .xfVersionLoad"

  button .xfVersionLoad.frame1.rescan \
    -text {Rescan} \
    -command "XFVersionScan"

  XFTmpltFrame .xfVersionLoad.frame2 0

  button .xfVersionLoad.frame2.load \
    -text {Load} \
    -command "
      XFVersionDoLoad
      if {\"$xfType\" == \"procs\"} {
        XFMiscSetInfo procs .xfInfoProc.procs.procs 0
      } {
        XFMiscSetInfo commands .xfInfoCmd.commands.commands 0
      }"

  button .xfVersionLoad.frame2.show \
    -text {Show} \
    -command "XFVersionShow"

  button .xfVersionLoad.frame2.info \
    -text {Info} \
    -command "XFVersionInfo"

  XFTmpltListbox .xfVersionLoad procs

  XFTmpltLabledEntry .xfVersionLoad current {Current procedure:}

  XFVersionScan

  # bindings
  bind .xfVersionLoad.procs.procs $xfBind(select1) "
    XFBindSelectOneIntoEntry %W %y .xfVersionLoad.current.current
    XFVersionDoLoad
    destroy .xfVersionLoad
    if {\"$xfType\" == \"procs\"} {
      XFMiscSetInfo procs .xfInfoProc.procs.procs 0
    } {
      XFMiscSetInfo commands .xfInfoCmd.commands.commands 0
    }"
  bind .xfVersionLoad.procs.procs <ButtonPress-1> {
    XFBindSelectOneIntoEntry %W %y .xfVersionLoad.current.current}
  bind .xfVersionLoad.procs.procs <Button1-Motion> {
    XFBindSelectOneIntoEntry %W %y .xfVersionLoad.current.current}
  bind .xfVersionLoad.procs.procs <Shift-ButtonPress-1> {
    XFBindSelectOneIntoEntry %W %y .xfVersionLoad.current.current}
  bind .xfVersionLoad.procs.procs <Shift-Button1-Motion> {
    XFBindSelectOneIntoEntry %W %y .xfVersionLoad.current.current}

  # packing
  pack append .xfVersionLoad.frame1 \
              .xfVersionLoad.frame1.ok {left fill expand} \
              .xfVersionLoad.frame1.rescan {left fill expand}
  pack append .xfVersionLoad.frame2 \
              .xfVersionLoad.frame2.load {left fill expand} \
              .xfVersionLoad.frame2.show {left fill expand} \
              .xfVersionLoad.frame2.info {left fill expand}
  pack append .xfVersionLoad \
              .xfVersionLoad.frame1 {bottom fill} \
              .xfVersionLoad.frame2 {bottom fill} \
              .xfVersionLoad.current {bottom fill} \
              .xfVersionLoad.procs {left fill expand}
}

##########
# Procedure: XFVersionSave
# Description: save the selected version
# Arguments: xfName - the name of the procedure
#            xfLeader - the leading window
# Returns: none
# Sideeffects: none
##########
proc XFVersionSave {xfName {xfLeader ""}} {

  # build widget structure
  XFTmpltToplevel .xfVersionSave 350x100 {Procedure saving} $xfLeader

  label .xfVersionSave.message1 \
    -anchor c \
    -relief raised \
    -text "Save the procedure: $xfName"

  XFTmpltFrame .xfVersionSave.frame1 0

  XFTmpltFrame .xfVersionSave.frame2

  button .xfVersionSave.frame1.ok \
    -text {OK} \
    -command "
      XFVersionDoSave $xfName
      destroy .xfVersionSave"

  button .xfVersionSave.frame1.cancel \
    -text {Cancel} \
    -command "destroy .xfVersionSave"

  XFTmpltLabledEntry .xfVersionSave descr {Description:} {}

  # bindings
  bind .xfVersionSave.descr.descr <Return> "
    XFVersionDoSave $xfName
    destroy .xfVersionSave"

  # packing
  pack append .xfVersionSave.frame1 \
              .xfVersionSave.frame1.ok {left fill expand} \
              .xfVersionSave.frame1.cancel {left fill expand}
  pack append .xfVersionSave \
              .xfVersionSave.message1 {top fillx} \
              .xfVersionSave.descr {top fillx} \
              .xfVersionSave.frame1 {bottom fill} \
              .xfVersionSave.frame2 {bottom fill expand}
}

##########
# Procedure: XFVersionScan
# Description: show the version file list
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc XFVersionScan {} {
  global xfConf
  global xfPath
  global xfVersion

  set xfElementList ""
  XFMiscClearList .xfVersionLoad.procs.procs
  if {$xfConf(versionCommand)} {
    set xfSavePath [pwd]
    cd $xfPath(procedures)
    catch "exec $xfVersion(list)" xfResult
    cd $xfSavePath
    set xfElementList [lsort $xfResult]
  } {
    set xfSavePath [pwd]
    cd $xfPath(procedures)
    catch "exec ls" xfResult
    cd $xfSavePath
    set xfElementList [lsort $xfResult]
  }

  foreach xfCounter $xfElementList {
    if {"$xfCounter" != "AtFS" && "$xfCounter" != "RCS" &&
        "$xfCounter" != "Makefile" && "$xfCounter" != "Shapefile" &&
        "$xfCounter" != "Version" && "$xfCounter" != "Dependencies"} {
      .xfVersionLoad.procs.procs insert end $xfCounter
    }
  }
}

##########
# Procedure: XFVersionShow
# Description: show the contents of the current version
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc XFVersionShow {} {
  global xfConf
  global xfPath
  global xfTextBox
  global xfVersion

  set xfCounter [.xfVersionLoad.current.current get]
  if {"$xfCounter" == ""} {
    return
  }
  if {$xfConf(versionCommand)} {
    set xfFileName $xfCounter
    if {[string last "\[" $xfCounter] >= 0 &&
        [string last "\]" $xfCounter] >= 0} {
      set xfFileName [string range $xfCounter 0 \
        [expr [string last "\[" $xfCounter]-1]]
      set xfFileVersion [string range $xfCounter \
        [expr [string last "\[" $xfCounter]+1] \
          [expr [string last "\]" $xfCounter]-1]]
    } {
      set xfFileVersion ""
    }
    if {"$xfFileVersion" != ""} {
      set xfCommand $xfVersion(show)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
      regsub -all {\$xfFileVersion} $xfCommand $xfFileVersion xfCommand
    } {
      set xfCommand $xfVersion(showDefault)
      regsub -all {\$xfFileName} $xfCommand $xfFileName xfCommand
    }
    if {"$xfCommand" != ""} {
      set xfSavePath [pwd]
      cd $xfPath(procedures)
      if {[catch "exec $xfCommand" xfResult]} {
        XFProcError "$xfResult"
      } {
        set xfTextBox(toplevelName) .xfTextVersionShow
        XFProcText $xfResult 400x300 "XF contents of: $xfCounter" {}
        set xfTextBox(toplevelName) .xfTextBox
      }
      cd $xfSavePath
    }
  } {
    set xfTextBox(toplevelName) .xfTextVersionShow
    XFProcTextFile $xfPath(procedures)/$xfCounter 400x300 \
      "XF contents of: $xfCounter" {}
    set xfTextBox(toplevelName) .xfTextBox
  }
}

# eof

